1 /* Asynchronous subprocess control for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2012
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
27 #include <sys/types.h> /* Some typedefs are used in sys/file.h. */
37 /* Only MS-DOS does not define `subprocesses'. */
40 #include <sys/socket.h>
42 #include <netinet/in.h>
43 #include <arpa/inet.h>
45 /* Are local (unix) sockets supported? */
46 #if defined (HAVE_SYS_UN_H)
47 #if !defined (AF_LOCAL) && defined (AF_UNIX)
48 #define AF_LOCAL AF_UNIX
51 #define HAVE_LOCAL_SOCKETS
56 #include <sys/ioctl.h>
57 #if defined (HAVE_NET_IF_H)
59 #endif /* HAVE_NET_IF_H */
61 #if defined (HAVE_IFADDRS_H)
62 /* Must be after net/if.h */
65 /* We only use structs from this header when we use getifaddrs. */
66 #if defined (HAVE_NET_IF_DL_H)
67 #include <net/if_dl.h>
77 #include <netinet/in.h>
78 #include <arpa/nameser.h>
90 #endif /* subprocesses */
97 #include "character.h"
101 #include "termhooks.h"
102 #include "termopts.h"
103 #include "commands.h"
104 #include "keyboard.h"
105 #include "blockinput.h"
106 #include "dispextern.h"
107 #include "composite.h"
109 #include "sysselect.h"
110 #include "syssignal.h"
116 #if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
117 #include "xgselect.h"
123 /* Work around GCC 4.7.0 bug with strict overflow checking; see
124 <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
125 These lines can be removed once the GCC bug is fixed. */
126 #if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__
127 # pragma GCC diagnostic ignored "-Wstrict-overflow"
130 Lisp_Object Qeuid
, Qegid
, Qcomm
, Qstate
, Qppid
, Qpgrp
, Qsess
, Qttname
, Qtpgid
;
131 Lisp_Object Qminflt
, Qmajflt
, Qcminflt
, Qcmajflt
, Qutime
, Qstime
, Qcstime
;
132 Lisp_Object Qcutime
, Qpri
, Qnice
, Qthcount
, Qstart
, Qvsize
, Qrss
, Qargs
;
133 Lisp_Object Quser
, Qgroup
, Qetime
, Qpcpu
, Qpmem
, Qtime
, Qctime
;
134 Lisp_Object QCname
, QCtype
;
136 /* Non-zero if keyboard input is on hold, zero otherwise. */
138 static int kbd_is_on_hold
;
140 /* Nonzero means don't run process sentinels. This is used
142 int inhibit_sentinels
;
146 Lisp_Object Qprocessp
;
147 static Lisp_Object Qrun
, Qstop
, Qsignal
;
148 static Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
150 static Lisp_Object Qipv4
, Qdatagram
, Qseqpacket
;
151 static Lisp_Object Qreal
, Qnetwork
, Qserial
;
153 static Lisp_Object Qipv6
;
155 static Lisp_Object QCport
, QCprocess
;
157 Lisp_Object QCbytesize
, QCstopbits
, QCparity
, Qodd
, Qeven
;
158 Lisp_Object QCflowcontrol
, Qhw
, Qsw
, QCsummary
;
159 static Lisp_Object QCbuffer
, QChost
, QCservice
;
160 static Lisp_Object QClocal
, QCremote
, QCcoding
;
161 static Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
162 static Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
163 static Lisp_Object Qlast_nonmenu_event
;
164 /* QCfamily is declared and initialized in xfaces.c,
165 QCfilter in keyboard.c. */
166 extern Lisp_Object QCfamily
, QCfilter
;
168 /* Qexit is declared and initialized in eval.c. */
170 /* QCfamily is defined in xfaces.c. */
171 extern Lisp_Object QCfamily
;
172 /* QCfilter is defined in keyboard.c. */
173 extern Lisp_Object QCfilter
;
175 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
176 #define NETCONN1_P(p) (EQ ((p)->type, Qnetwork))
177 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
178 #define SERIALCONN1_P(p) (EQ ((p)->type, Qserial))
184 /* Number of events of change of status of a process. */
185 static int process_tick
;
186 /* Number of events for which the user or sentinel has been notified. */
187 static int update_tick
;
189 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
191 /* Only W32 has this, it really means that select can't take write mask. */
192 #ifdef BROKEN_NON_BLOCKING_CONNECT
193 #undef NON_BLOCKING_CONNECT
194 #define SELECT_CANT_DO_WRITE_MASK
196 #ifndef NON_BLOCKING_CONNECT
198 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
199 #if defined (O_NONBLOCK) || defined (O_NDELAY)
200 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
201 #define NON_BLOCKING_CONNECT
202 #endif /* EWOULDBLOCK || EINPROGRESS */
203 #endif /* O_NONBLOCK || O_NDELAY */
204 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
205 #endif /* HAVE_SELECT */
206 #endif /* NON_BLOCKING_CONNECT */
207 #endif /* BROKEN_NON_BLOCKING_CONNECT */
209 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
210 this system. We need to read full packets, so we need a
211 "non-destructive" select. So we require either native select,
212 or emulation of select using FIONREAD. */
214 #ifdef BROKEN_DATAGRAM_SOCKETS
215 #undef DATAGRAM_SOCKETS
217 #ifndef DATAGRAM_SOCKETS
218 #if defined (HAVE_SELECT) || defined (FIONREAD)
219 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
220 #define DATAGRAM_SOCKETS
221 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
222 #endif /* HAVE_SELECT || FIONREAD */
223 #endif /* DATAGRAM_SOCKETS */
224 #endif /* BROKEN_DATAGRAM_SOCKETS */
226 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
227 # define HAVE_SEQPACKET
230 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
231 #ifdef EMACS_HAS_USECS
232 #define ADAPTIVE_READ_BUFFERING
236 #ifdef ADAPTIVE_READ_BUFFERING
237 #define READ_OUTPUT_DELAY_INCREMENT 10000
238 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
239 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
241 /* Number of processes which have a non-zero read_output_delay,
242 and therefore might be delayed for adaptive read buffering. */
244 static int process_output_delay_count
;
246 /* Non-zero if any process has non-nil read_output_skip. */
248 static int process_output_skip
;
251 #define process_output_delay_count 0
254 static Lisp_Object
Fget_process (Lisp_Object
);
255 static void create_process (Lisp_Object
, char **, Lisp_Object
);
257 static int keyboard_bit_set (SELECT_TYPE
*);
259 static void deactivate_process (Lisp_Object
);
260 static void status_notify (struct Lisp_Process
*);
261 static int read_process_output (Lisp_Object
, int);
262 static void create_pty (Lisp_Object
);
264 /* If we support a window system, turn on the code to poll periodically
265 to detect C-g. It isn't actually used when doing interrupt input. */
266 #if defined (HAVE_WINDOW_SYSTEM) && !defined (USE_ASYNC_EVENTS)
267 #define POLL_FOR_INPUT
270 static Lisp_Object
get_process (register Lisp_Object name
);
271 static void exec_sentinel (Lisp_Object proc
, Lisp_Object reason
);
273 /* Mask of bits indicating the descriptors that we wait for input on. */
275 static SELECT_TYPE input_wait_mask
;
277 /* Mask that excludes keyboard input descriptor(s). */
279 static SELECT_TYPE non_keyboard_wait_mask
;
281 /* Mask that excludes process input descriptor(s). */
283 static SELECT_TYPE non_process_wait_mask
;
285 /* Mask for selecting for write. */
287 static SELECT_TYPE write_mask
;
289 #ifdef NON_BLOCKING_CONNECT
290 /* Mask of bits indicating the descriptors that we wait for connect to
291 complete on. Once they complete, they are removed from this mask
292 and added to the input_wait_mask and non_keyboard_wait_mask. */
294 static SELECT_TYPE connect_wait_mask
;
296 /* Number of bits set in connect_wait_mask. */
297 static int num_pending_connects
;
298 #endif /* NON_BLOCKING_CONNECT */
300 /* The largest descriptor currently in use for a process object. */
301 static int max_process_desc
;
303 /* The largest descriptor currently in use for input. */
304 static int max_input_desc
;
306 /* Indexed by descriptor, gives the process (if any) for that descriptor */
307 static Lisp_Object chan_process
[MAXDESC
];
309 /* Alist of elements (NAME . PROCESS) */
310 static Lisp_Object Vprocess_alist
;
312 /* Buffered-ahead input char from process, indexed by channel.
313 -1 means empty (no char is buffered).
314 Used on sys V where the only way to tell if there is any
315 output from the process is to read at least one char.
316 Always -1 on systems that support FIONREAD. */
318 static int proc_buffered_char
[MAXDESC
];
320 /* Table of `struct coding-system' for each process. */
321 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
322 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
324 #ifdef DATAGRAM_SOCKETS
325 /* Table of `partner address' for datagram sockets. */
326 static struct sockaddr_and_len
{
329 } datagram_address
[MAXDESC
];
330 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
331 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
333 #define DATAGRAM_CHAN_P(chan) (0)
334 #define DATAGRAM_CONN_P(proc) (0)
337 /* Maximum number of bytes to send to a pty without an eof. */
338 static int pty_max_bytes
;
342 static struct fd_callback_data
348 int condition
; /* mask of the defines above. */
349 } fd_callback_info
[MAXDESC
];
352 /* Add a file descriptor FD to be monitored for when read is possible.
353 When read is possible, call FUNC with argument DATA. */
356 add_read_fd (int fd
, fd_callback func
, void *data
)
358 xassert (fd
< MAXDESC
);
359 add_keyboard_wait_descriptor (fd
);
361 fd_callback_info
[fd
].func
= func
;
362 fd_callback_info
[fd
].data
= data
;
363 fd_callback_info
[fd
].condition
|= FOR_READ
;
366 /* Stop monitoring file descriptor FD for when read is possible. */
369 delete_read_fd (int fd
)
371 xassert (fd
< MAXDESC
);
372 delete_keyboard_wait_descriptor (fd
);
374 fd_callback_info
[fd
].condition
&= ~FOR_READ
;
375 if (fd_callback_info
[fd
].condition
== 0)
377 fd_callback_info
[fd
].func
= 0;
378 fd_callback_info
[fd
].data
= 0;
382 /* Add a file descriptor FD to be monitored for when write is possible.
383 When write is possible, call FUNC with argument DATA. */
386 add_write_fd (int fd
, fd_callback func
, void *data
)
388 xassert (fd
< MAXDESC
);
389 FD_SET (fd
, &write_mask
);
390 if (fd
> max_input_desc
)
393 fd_callback_info
[fd
].func
= func
;
394 fd_callback_info
[fd
].data
= data
;
395 fd_callback_info
[fd
].condition
|= FOR_WRITE
;
398 /* Stop monitoring file descriptor FD for when write is possible. */
401 delete_write_fd (int fd
)
403 int lim
= max_input_desc
;
405 xassert (fd
< MAXDESC
);
406 FD_CLR (fd
, &write_mask
);
407 fd_callback_info
[fd
].condition
&= ~FOR_WRITE
;
408 if (fd_callback_info
[fd
].condition
== 0)
410 fd_callback_info
[fd
].func
= 0;
411 fd_callback_info
[fd
].data
= 0;
413 if (fd
== max_input_desc
)
414 for (fd
= lim
; fd
>= 0; fd
--)
415 if (FD_ISSET (fd
, &input_wait_mask
) || FD_ISSET (fd
, &write_mask
))
425 /* Compute the Lisp form of the process status, p->status, from
426 the numeric status that was returned by `wait'. */
428 static Lisp_Object
status_convert (int);
431 update_status (struct Lisp_Process
*p
)
433 eassert (p
->raw_status_new
);
434 p
->status
= status_convert (p
->raw_status
);
435 p
->raw_status_new
= 0;
438 /* Convert a process status word in Unix format to
439 the list that we use internally. */
442 status_convert (int w
)
445 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
446 else if (WIFEXITED (w
))
447 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
448 WCOREDUMP (w
) ? Qt
: Qnil
));
449 else if (WIFSIGNALED (w
))
450 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
451 WCOREDUMP (w
) ? Qt
: Qnil
));
456 /* Given a status-list, extract the three pieces of information
457 and store them individually through the three pointers. */
460 decode_status (Lisp_Object l
, Lisp_Object
*symbol
, int *code
, int *coredump
)
474 *code
= XFASTINT (XCAR (tem
));
476 *coredump
= !NILP (tem
);
480 /* Return a string describing a process status list. */
483 status_message (struct Lisp_Process
*p
)
485 Lisp_Object status
= p
->status
;
488 Lisp_Object string
, string2
;
490 decode_status (status
, &symbol
, &code
, &coredump
);
492 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
495 synchronize_system_messages_locale ();
496 signame
= strsignal (code
);
498 string
= build_string ("unknown");
503 string
= make_unibyte_string (signame
, strlen (signame
));
504 if (! NILP (Vlocale_coding_system
))
505 string
= (code_convert_string_norecord
506 (string
, Vlocale_coding_system
, 0));
507 c1
= STRING_CHAR (SDATA (string
));
510 Faset (string
, make_number (0), make_number (c2
));
512 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
513 return concat2 (string
, string2
);
515 else if (EQ (symbol
, Qexit
))
518 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
520 return build_string ("finished\n");
521 string
= Fnumber_to_string (make_number (code
));
522 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
523 return concat3 (build_string ("exited abnormally with code "),
526 else if (EQ (symbol
, Qfailed
))
528 string
= Fnumber_to_string (make_number (code
));
529 string2
= build_string ("\n");
530 return concat3 (build_string ("failed with code "),
534 return Fcopy_sequence (Fsymbol_name (symbol
));
539 /* The file name of the pty opened by allocate_pty. */
540 static char pty_name
[24];
542 /* Open an available pty, returning a file descriptor.
543 Return -1 on failure.
544 The file name of the terminal corresponding to the pty
545 is left in the variable pty_name. */
556 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
557 for (i
= 0; i
< 16; i
++)
560 #ifdef PTY_NAME_SPRINTF
563 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
564 #endif /* no PTY_NAME_SPRINTF */
568 #else /* no PTY_OPEN */
570 { /* Some systems name their pseudoterminals so that there are gaps in
571 the usual sequence - for example, on HP9000/S700 systems, there
572 are no pseudoterminals with names ending in 'f'. So we wait for
573 three failures in a row before deciding that we've reached the
575 int failed_count
= 0;
578 if (stat (pty_name
, &stb
) < 0)
581 if (failed_count
>= 3)
588 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
590 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
593 #endif /* no PTY_OPEN */
597 /* check to make certain that both sides are available
598 this avoids a nasty yet stupid bug in rlogins */
599 #ifdef PTY_TTY_NAME_SPRINTF
602 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
603 #endif /* no PTY_TTY_NAME_SPRINTF */
604 if (access (pty_name
, 6) != 0)
619 #endif /* HAVE_PTYS */
622 make_process (Lisp_Object name
)
624 register Lisp_Object val
, tem
, name1
;
625 register struct Lisp_Process
*p
;
626 char suffix
[sizeof "<>" + INT_STRLEN_BOUND (printmax_t
)];
629 p
= allocate_process ();
637 p
->raw_status_new
= 0;
639 p
->mark
= Fmake_marker ();
640 p
->kill_without_query
= 0;
642 #ifdef ADAPTIVE_READ_BUFFERING
643 p
->adaptive_read_buffering
= 0;
644 p
->read_output_delay
= 0;
645 p
->read_output_skip
= 0;
649 p
->gnutls_initstage
= GNUTLS_STAGE_EMPTY
;
650 /* Default log level. */
651 p
->gnutls_log_level
= 0;
652 /* GnuTLS handshakes attempted for this connection. */
653 p
->gnutls_handshakes_tried
= 0;
655 p
->gnutls_state
= NULL
;
656 p
->gnutls_x509_cred
= NULL
;
657 p
->gnutls_anon_cred
= NULL
;
660 /* If name is already in use, modify it until it is unused. */
665 tem
= Fget_process (name1
);
666 if (NILP (tem
)) break;
667 sprintf (suffix
, "<%"pMd
">", i
);
668 name1
= concat2 (name
, build_string (suffix
));
672 XSETPROCESS (val
, p
);
673 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
678 remove_process (register Lisp_Object proc
)
680 register Lisp_Object pair
;
682 pair
= Frassq (proc
, Vprocess_alist
);
683 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
685 deactivate_process (proc
);
689 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
690 doc
: /* Return t if OBJECT is a process. */)
693 return PROCESSP (object
) ? Qt
: Qnil
;
696 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
697 doc
: /* Return the process named NAME, or nil if there is none. */)
698 (register Lisp_Object name
)
703 return Fcdr (Fassoc (name
, Vprocess_alist
));
706 /* This is how commands for the user decode process arguments. It
707 accepts a process, a process name, a buffer, a buffer name, or nil.
708 Buffers denote the first process in the buffer, and nil denotes the
712 get_process (register Lisp_Object name
)
714 register Lisp_Object proc
, obj
;
717 obj
= Fget_process (name
);
719 obj
= Fget_buffer (name
);
721 error ("Process %s does not exist", SDATA (name
));
723 else if (NILP (name
))
724 obj
= Fcurrent_buffer ();
728 /* Now obj should be either a buffer object or a process object.
732 proc
= Fget_buffer_process (obj
);
734 error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj
), name
)));
746 /* Fdelete_process promises to immediately forget about the process, but in
747 reality, Emacs needs to remember those processes until they have been
748 treated by sigchld_handler; otherwise this handler would consider the
749 process as being synchronous and say that the synchronous process is
751 static Lisp_Object deleted_pid_list
;
754 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
755 doc
: /* Delete PROCESS: kill it and forget about it immediately.
756 PROCESS may be a process, a buffer, the name of a process or buffer, or
757 nil, indicating the current buffer's process. */)
758 (register Lisp_Object process
)
760 register struct Lisp_Process
*p
;
762 process
= get_process (process
);
763 p
= XPROCESS (process
);
765 p
->raw_status_new
= 0;
766 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
768 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
769 p
->tick
= ++process_tick
;
771 redisplay_preserve_echo_area (13);
773 else if (p
->infd
>= 0)
777 /* Assignment to EMACS_INT stops GCC whining about limited range
779 EMACS_INT pid
= p
->pid
;
781 /* No problem storing the pid here, as it is still in Vprocess_alist. */
782 deleted_pid_list
= Fcons (make_fixnum_or_float (pid
),
783 /* GC treated elements set to nil. */
784 Fdelq (Qnil
, deleted_pid_list
));
785 /* If the process has already signaled, remove it from the list. */
786 if (p
->raw_status_new
)
789 if (CONSP (p
->status
))
790 symbol
= XCAR (p
->status
);
791 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
793 = Fdelete (make_fixnum_or_float (pid
), deleted_pid_list
);
797 Fkill_process (process
, Qnil
);
798 /* Do this now, since remove_process will make sigchld_handler do nothing. */
800 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
801 p
->tick
= ++process_tick
;
803 redisplay_preserve_echo_area (13);
806 remove_process (process
);
810 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
811 doc
: /* Return the status of PROCESS.
812 The returned value is one of the following symbols:
813 run -- for a process that is running.
814 stop -- for a process stopped but continuable.
815 exit -- for a process that has exited.
816 signal -- for a process that has got a fatal signal.
817 open -- for a network stream connection that is open.
818 listen -- for a network stream server that is listening.
819 closed -- for a network stream connection that is closed.
820 connect -- when waiting for a non-blocking connection to complete.
821 failed -- when a non-blocking connection has failed.
822 nil -- if arg is a process name and no such process exists.
823 PROCESS may be a process, a buffer, the name of a process, or
824 nil, indicating the current buffer's process. */)
825 (register Lisp_Object process
)
827 register struct Lisp_Process
*p
;
828 register Lisp_Object status
;
830 if (STRINGP (process
))
831 process
= Fget_process (process
);
833 process
= get_process (process
);
838 p
= XPROCESS (process
);
839 if (p
->raw_status_new
)
843 status
= XCAR (status
);
844 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
846 if (EQ (status
, Qexit
))
848 else if (EQ (p
->command
, Qt
))
850 else if (EQ (status
, Qrun
))
856 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
858 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
859 If PROCESS has not yet exited or died, return 0. */)
860 (register Lisp_Object process
)
862 CHECK_PROCESS (process
);
863 if (XPROCESS (process
)->raw_status_new
)
864 update_status (XPROCESS (process
));
865 if (CONSP (XPROCESS (process
)->status
))
866 return XCAR (XCDR (XPROCESS (process
)->status
));
867 return make_number (0);
870 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
871 doc
: /* Return the process id of PROCESS.
872 This is the pid of the external process which PROCESS uses or talks to.
873 For a network connection, this value is nil. */)
874 (register Lisp_Object process
)
876 /* Assignment to EMACS_INT stops GCC whining about limited range of
880 CHECK_PROCESS (process
);
881 pid
= XPROCESS (process
)->pid
;
882 return (pid
? make_fixnum_or_float (pid
) : Qnil
);
885 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
886 doc
: /* Return the name of PROCESS, as a string.
887 This is the name of the program invoked in PROCESS,
888 possibly modified to make it unique among process names. */)
889 (register Lisp_Object process
)
891 CHECK_PROCESS (process
);
892 return XPROCESS (process
)->name
;
895 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
896 doc
: /* Return the command that was executed to start PROCESS.
897 This is a list of strings, the first string being the program executed
898 and the rest of the strings being the arguments given to it.
899 For a network or serial process, this is nil (process is running) or t
900 \(process is stopped). */)
901 (register Lisp_Object process
)
903 CHECK_PROCESS (process
);
904 return XPROCESS (process
)->command
;
907 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
908 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
909 This is the terminal that the process itself reads and writes on,
910 not the name of the pty that Emacs uses to talk with that terminal. */)
911 (register Lisp_Object process
)
913 CHECK_PROCESS (process
);
914 return XPROCESS (process
)->tty_name
;
917 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
919 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
921 (register Lisp_Object process
, Lisp_Object buffer
)
923 struct Lisp_Process
*p
;
925 CHECK_PROCESS (process
);
927 CHECK_BUFFER (buffer
);
928 p
= XPROCESS (process
);
930 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
931 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
932 setup_process_coding_systems (process
);
936 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
938 doc
: /* Return the buffer PROCESS is associated with.
939 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
940 (register Lisp_Object process
)
942 CHECK_PROCESS (process
);
943 return XPROCESS (process
)->buffer
;
946 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
948 doc
: /* Return the marker for the end of the last output from PROCESS. */)
949 (register Lisp_Object process
)
951 CHECK_PROCESS (process
);
952 return XPROCESS (process
)->mark
;
955 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
957 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
958 A value of t means stop accepting output from the process.
960 When a process has a filter, its buffer is not used for output.
961 Instead, each time it does output, the entire string of output is
962 passed to the filter.
964 The filter gets two arguments: the process and the string of output.
965 The string argument is normally a multibyte string, except:
966 - if the process' input coding system is no-conversion or raw-text,
967 it is a unibyte string (the non-converted input), or else
968 - if `default-enable-multibyte-characters' is nil, it is a unibyte
969 string (the result of converting the decoded input multibyte
970 string to unibyte with `string-make-unibyte'). */)
971 (register Lisp_Object process
, Lisp_Object filter
)
973 struct Lisp_Process
*p
;
975 CHECK_PROCESS (process
);
976 p
= XPROCESS (process
);
978 /* Don't signal an error if the process' input file descriptor
979 is closed. This could make debugging Lisp more difficult,
980 for example when doing something like
982 (setq process (start-process ...))
984 (set-process-filter process ...) */
988 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
990 FD_CLR (p
->infd
, &input_wait_mask
);
991 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
993 else if (EQ (p
->filter
, Qt
)
994 /* Network or serial process not stopped: */
995 && !EQ (p
->command
, Qt
))
997 FD_SET (p
->infd
, &input_wait_mask
);
998 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
1003 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1004 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
1005 setup_process_coding_systems (process
);
1009 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1011 doc
: /* Returns the filter function of PROCESS; nil if none.
1012 See `set-process-filter' for more info on filter functions. */)
1013 (register Lisp_Object process
)
1015 CHECK_PROCESS (process
);
1016 return XPROCESS (process
)->filter
;
1019 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1021 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1022 The sentinel is called as a function when the process changes state.
1023 It gets two arguments: the process, and a string describing the change. */)
1024 (register Lisp_Object process
, Lisp_Object sentinel
)
1026 struct Lisp_Process
*p
;
1028 CHECK_PROCESS (process
);
1029 p
= XPROCESS (process
);
1031 p
->sentinel
= sentinel
;
1032 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1033 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1037 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1039 doc
: /* Return the sentinel of PROCESS; nil if none.
1040 See `set-process-sentinel' for more info on sentinels. */)
1041 (register Lisp_Object process
)
1043 CHECK_PROCESS (process
);
1044 return XPROCESS (process
)->sentinel
;
1047 DEFUN ("set-process-window-size", Fset_process_window_size
,
1048 Sset_process_window_size
, 3, 3, 0,
1049 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1050 (register Lisp_Object process
, Lisp_Object height
, Lisp_Object width
)
1052 CHECK_PROCESS (process
);
1053 CHECK_NATNUM (height
);
1054 CHECK_NATNUM (width
);
1056 if (XPROCESS (process
)->infd
< 0
1057 || set_window_size (XPROCESS (process
)->infd
,
1058 XINT (height
), XINT (width
)) <= 0)
1064 DEFUN ("set-process-inherit-coding-system-flag",
1065 Fset_process_inherit_coding_system_flag
,
1066 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1067 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1068 If the second argument FLAG is non-nil, then the variable
1069 `buffer-file-coding-system' of the buffer associated with PROCESS
1070 will be bound to the value of the coding system used to decode
1073 This is useful when the coding system specified for the process buffer
1074 leaves either the character code conversion or the end-of-line conversion
1075 unspecified, or if the coding system used to decode the process output
1076 is more appropriate for saving the process buffer.
1078 Binding the variable `inherit-process-coding-system' to non-nil before
1079 starting the process is an alternative way of setting the inherit flag
1080 for the process which will run.
1082 This function returns FLAG. */)
1083 (register Lisp_Object process
, Lisp_Object flag
)
1085 CHECK_PROCESS (process
);
1086 XPROCESS (process
)->inherit_coding_system_flag
= !NILP (flag
);
1090 DEFUN ("set-process-query-on-exit-flag",
1091 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1093 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1094 If the second argument FLAG is non-nil, Emacs will query the user before
1095 exiting or killing a buffer if PROCESS is running. This function
1097 (register Lisp_Object process
, Lisp_Object flag
)
1099 CHECK_PROCESS (process
);
1100 XPROCESS (process
)->kill_without_query
= NILP (flag
);
1104 DEFUN ("process-query-on-exit-flag",
1105 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1107 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1108 (register Lisp_Object process
)
1110 CHECK_PROCESS (process
);
1111 return (XPROCESS (process
)->kill_without_query
? Qnil
: Qt
);
1114 #ifdef DATAGRAM_SOCKETS
1115 static Lisp_Object
Fprocess_datagram_address (Lisp_Object
);
1118 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1120 doc
: /* Return the contact info of PROCESS; t for a real child.
1121 For a network or serial connection, the value depends on the optional
1122 KEY arg. If KEY is nil, value is a cons cell of the form (HOST
1123 SERVICE) for a network connection or (PORT SPEED) for a serial
1124 connection. If KEY is t, the complete contact information for the
1125 connection is returned, else the specific value for the keyword KEY is
1126 returned. See `make-network-process' or `make-serial-process' for a
1127 list of keywords. */)
1128 (register Lisp_Object process
, Lisp_Object key
)
1130 Lisp_Object contact
;
1132 CHECK_PROCESS (process
);
1133 contact
= XPROCESS (process
)->childp
;
1135 #ifdef DATAGRAM_SOCKETS
1136 if (DATAGRAM_CONN_P (process
)
1137 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1138 contact
= Fplist_put (contact
, QCremote
,
1139 Fprocess_datagram_address (process
));
1142 if ((!NETCONN_P (process
) && !SERIALCONN_P (process
)) || EQ (key
, Qt
))
1144 if (NILP (key
) && NETCONN_P (process
))
1145 return Fcons (Fplist_get (contact
, QChost
),
1146 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1147 if (NILP (key
) && SERIALCONN_P (process
))
1148 return Fcons (Fplist_get (contact
, QCport
),
1149 Fcons (Fplist_get (contact
, QCspeed
), Qnil
));
1150 return Fplist_get (contact
, key
);
1153 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1155 doc
: /* Return the plist of PROCESS. */)
1156 (register Lisp_Object process
)
1158 CHECK_PROCESS (process
);
1159 return XPROCESS (process
)->plist
;
1162 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1164 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1165 (register Lisp_Object process
, Lisp_Object plist
)
1167 CHECK_PROCESS (process
);
1170 XPROCESS (process
)->plist
= plist
;
1174 #if 0 /* Turned off because we don't currently record this info
1175 in the process. Perhaps add it. */
1176 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1177 doc
: /* Return the connection type of PROCESS.
1178 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1179 a socket connection. */)
1180 (Lisp_Object process
)
1182 return XPROCESS (process
)->type
;
1186 DEFUN ("process-type", Fprocess_type
, Sprocess_type
, 1, 1, 0,
1187 doc
: /* Return the connection type of PROCESS.
1188 The value is either the symbol `real', `network', or `serial'.
1189 PROCESS may be a process, a buffer, the name of a process or buffer, or
1190 nil, indicating the current buffer's process. */)
1191 (Lisp_Object process
)
1194 proc
= get_process (process
);
1195 return XPROCESS (proc
)->type
;
1198 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1200 doc
: /* Convert network ADDRESS from internal format to a string.
1201 A 4 or 5 element vector represents an IPv4 address (with port number).
1202 An 8 or 9 element vector represents an IPv6 address (with port number).
1203 If optional second argument OMIT-PORT is non-nil, don't include a port
1204 number in the string, even when present in ADDRESS.
1205 Returns nil if format of ADDRESS is invalid. */)
1206 (Lisp_Object address
, Lisp_Object omit_port
)
1211 if (STRINGP (address
)) /* AF_LOCAL */
1214 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1216 register struct Lisp_Vector
*p
= XVECTOR (address
);
1217 EMACS_INT size
= p
->header
.size
;
1218 Lisp_Object args
[10];
1221 if (size
== 4 || (size
== 5 && !NILP (omit_port
)))
1223 args
[0] = build_string ("%d.%d.%d.%d");
1228 args
[0] = build_string ("%d.%d.%d.%d:%d");
1231 else if (size
== 8 || (size
== 9 && !NILP (omit_port
)))
1233 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1238 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1244 for (i
= 0; i
< nargs
; i
++)
1246 EMACS_INT element
= XINT (p
->contents
[i
]);
1248 if (element
< 0 || element
> 65535)
1251 if (nargs
<= 5 /* IPv4 */
1252 && i
< 4 /* host, not port */
1256 args
[i
+1] = p
->contents
[i
];
1259 return Fformat (nargs
+1, args
);
1262 if (CONSP (address
))
1264 Lisp_Object args
[2];
1265 args
[0] = build_string ("<Family %d>");
1266 args
[1] = Fcar (address
);
1267 return Fformat (2, args
);
1273 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1274 doc
: /* Return a list of all processes. */)
1277 return Fmapcar (Qcdr
, Vprocess_alist
);
1280 /* Starting asynchronous inferior processes. */
1282 static Lisp_Object
start_process_unwind (Lisp_Object proc
);
1284 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1285 doc
: /* Start a program in a subprocess. Return the process object for it.
1286 NAME is name for process. It is modified if necessary to make it unique.
1287 BUFFER is the buffer (or buffer name) to associate with the process.
1289 Process output (both standard output and standard error streams) goes
1290 at end of BUFFER, unless you specify an output stream or filter
1291 function to handle the output. BUFFER may also be nil, meaning that
1292 this process is not associated with any buffer.
1294 PROGRAM is the program file name. It is searched for in `exec-path'
1295 (which see). If nil, just associate a pty with the buffer. Remaining
1296 arguments are strings to give program as arguments.
1298 If you want to separate standard output from standard error, invoke
1299 the command through a shell and redirect one of them using the shell
1302 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1303 (ptrdiff_t nargs
, Lisp_Object
*args
)
1305 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1306 register unsigned char **new_argv
;
1308 int count
= SPECPDL_INDEX ();
1312 buffer
= Fget_buffer_create (buffer
);
1314 /* Make sure that the child will be able to chdir to the current
1315 buffer's current directory, or its unhandled equivalent. We
1316 can't just have the child check for an error when it does the
1317 chdir, since it's in a vfork.
1319 We have to GCPRO around this because Fexpand_file_name and
1320 Funhandled_file_name_directory might call a file name handling
1321 function. The argument list is protected by the caller, so all
1322 we really have to worry about is buffer. */
1324 struct gcpro gcpro1
, gcpro2
;
1326 current_dir
= BVAR (current_buffer
, directory
);
1328 GCPRO2 (buffer
, current_dir
);
1330 current_dir
= Funhandled_file_name_directory (current_dir
);
1331 if (NILP (current_dir
))
1332 /* If the file name handler says that current_dir is unreachable, use
1333 a sensible default. */
1334 current_dir
= build_string ("~/");
1335 current_dir
= expand_and_dir_to_file (current_dir
, Qnil
);
1336 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1337 report_file_error ("Setting current directory",
1338 Fcons (BVAR (current_buffer
, directory
), Qnil
));
1344 CHECK_STRING (name
);
1348 if (!NILP (program
))
1349 CHECK_STRING (program
);
1351 proc
= make_process (name
);
1352 /* If an error occurs and we can't start the process, we want to
1353 remove it from the process list. This means that each error
1354 check in create_process doesn't need to call remove_process
1355 itself; it's all taken care of here. */
1356 record_unwind_protect (start_process_unwind
, proc
);
1358 XPROCESS (proc
)->childp
= Qt
;
1359 XPROCESS (proc
)->plist
= Qnil
;
1360 XPROCESS (proc
)->type
= Qreal
;
1361 XPROCESS (proc
)->buffer
= buffer
;
1362 XPROCESS (proc
)->sentinel
= Qnil
;
1363 XPROCESS (proc
)->filter
= Qnil
;
1364 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1367 /* AKA GNUTLS_INITSTAGE(proc). */
1368 XPROCESS (proc
)->gnutls_initstage
= GNUTLS_STAGE_EMPTY
;
1369 XPROCESS (proc
)->gnutls_cred_type
= Qnil
;
1372 #ifdef ADAPTIVE_READ_BUFFERING
1373 XPROCESS (proc
)->adaptive_read_buffering
1374 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
1375 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
1378 /* Make the process marker point into the process buffer (if any). */
1379 if (BUFFERP (buffer
))
1380 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1381 BUF_ZV (XBUFFER (buffer
)),
1382 BUF_ZV_BYTE (XBUFFER (buffer
)));
1385 /* Decide coding systems for communicating with the process. Here
1386 we don't setup the structure coding_system nor pay attention to
1387 unibyte mode. They are done in create_process. */
1389 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1390 Lisp_Object coding_systems
= Qt
;
1391 Lisp_Object val
, *args2
;
1392 struct gcpro gcpro1
, gcpro2
;
1394 val
= Vcoding_system_for_read
;
1397 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1398 args2
[0] = Qstart_process
;
1399 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1400 GCPRO2 (proc
, current_dir
);
1401 if (!NILP (program
))
1402 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1404 if (CONSP (coding_systems
))
1405 val
= XCAR (coding_systems
);
1406 else if (CONSP (Vdefault_process_coding_system
))
1407 val
= XCAR (Vdefault_process_coding_system
);
1409 XPROCESS (proc
)->decode_coding_system
= val
;
1411 val
= Vcoding_system_for_write
;
1414 if (EQ (coding_systems
, Qt
))
1416 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1417 args2
[0] = Qstart_process
;
1418 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1419 GCPRO2 (proc
, current_dir
);
1420 if (!NILP (program
))
1421 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1424 if (CONSP (coding_systems
))
1425 val
= XCDR (coding_systems
);
1426 else if (CONSP (Vdefault_process_coding_system
))
1427 val
= XCDR (Vdefault_process_coding_system
);
1429 XPROCESS (proc
)->encode_coding_system
= val
;
1430 /* Note: At this moment, the above coding system may leave
1431 text-conversion or eol-conversion unspecified. They will be
1432 decided after we read output from the process and decode it by
1433 some coding system, or just before we actually send a text to
1438 XPROCESS (proc
)->decoding_buf
= empty_unibyte_string
;
1439 XPROCESS (proc
)->decoding_carryover
= 0;
1440 XPROCESS (proc
)->encoding_buf
= empty_unibyte_string
;
1442 XPROCESS (proc
)->inherit_coding_system_flag
1443 = !(NILP (buffer
) || !inherit_process_coding_system
);
1445 if (!NILP (program
))
1447 /* If program file name is not absolute, search our path for it.
1448 Put the name we will really use in TEM. */
1449 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1450 && !(SCHARS (program
) > 1
1451 && IS_DEVICE_SEP (SREF (program
, 1))))
1453 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1456 GCPRO4 (name
, program
, buffer
, current_dir
);
1457 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1460 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1461 tem
= Fexpand_file_name (tem
, Qnil
);
1465 if (!NILP (Ffile_directory_p (program
)))
1466 error ("Specified program for new process is a directory");
1470 /* If program file name starts with /: for quoting a magic name,
1472 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1473 && SREF (tem
, 1) == ':')
1474 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1477 Lisp_Object arg_encoding
= Qnil
;
1478 struct gcpro gcpro1
;
1481 /* Encode the file name and put it in NEW_ARGV.
1482 That's where the child will use it to execute the program. */
1483 tem
= Fcons (ENCODE_FILE (tem
), Qnil
);
1485 /* Here we encode arguments by the coding system used for sending
1486 data to the process. We don't support using different coding
1487 systems for encoding arguments and for encoding data sent to the
1490 for (i
= 3; i
< nargs
; i
++)
1492 tem
= Fcons (args
[i
], tem
);
1493 CHECK_STRING (XCAR (tem
));
1494 if (STRING_MULTIBYTE (XCAR (tem
)))
1496 if (NILP (arg_encoding
))
1497 arg_encoding
= (complement_process_encoding_system
1498 (XPROCESS (proc
)->encode_coding_system
));
1500 code_convert_string_norecord
1501 (XCAR (tem
), arg_encoding
, 1));
1508 /* Now that everything is encoded we can collect the strings into
1510 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1511 new_argv
[nargs
- 2] = 0;
1513 for (i
= nargs
- 2; i
-- != 0; )
1515 new_argv
[i
] = SDATA (XCAR (tem
));
1519 create_process (proc
, (char **) new_argv
, current_dir
);
1524 return unbind_to (count
, proc
);
1527 /* This function is the unwind_protect form for Fstart_process. If
1528 PROC doesn't have its pid set, then we know someone has signaled
1529 an error and the process wasn't started successfully, so we should
1530 remove it from the process list. */
1532 start_process_unwind (Lisp_Object proc
)
1534 if (!PROCESSP (proc
))
1537 /* Was PROC started successfully?
1538 -2 is used for a pty with no process, eg for gdb. */
1539 if (XPROCESS (proc
)->pid
<= 0 && XPROCESS (proc
)->pid
!= -2)
1540 remove_process (proc
);
1546 create_process_1 (struct atimer
*timer
)
1548 /* Nothing to do. */
1553 create_process (Lisp_Object process
, char **new_argv
, Lisp_Object current_dir
)
1555 int inchannel
, outchannel
;
1558 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1559 int wait_child_setup
[2];
1563 struct sigaction sigint_action
;
1564 struct sigaction sigquit_action
;
1565 struct sigaction sigpipe_action
;
1567 struct sigaction sighup_action
;
1569 /* Use volatile to protect variables from being clobbered by longjmp. */
1570 volatile int forkin
, forkout
;
1571 volatile int pty_flag
= 0;
1573 extern char **environ
;
1576 inchannel
= outchannel
= -1;
1579 if (!NILP (Vprocess_connection_type
))
1580 outchannel
= inchannel
= allocate_pty ();
1584 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1585 /* On most USG systems it does not work to open the pty's tty here,
1586 then close it and reopen it in the child. */
1588 /* Don't let this terminal become our controlling terminal
1589 (in case we don't have one). */
1590 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1592 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1595 report_file_error ("Opening pty", Qnil
);
1597 forkin
= forkout
= -1;
1598 #endif /* not USG, or USG_SUBTTY_WORKS */
1602 #endif /* HAVE_PTYS */
1607 report_file_error ("Creating pipe", Qnil
);
1613 emacs_close (inchannel
);
1614 emacs_close (forkout
);
1615 report_file_error ("Creating pipe", Qnil
);
1621 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1625 tem
= pipe (wait_child_setup
);
1627 report_file_error ("Creating pipe", Qnil
);
1628 tem
= fcntl (wait_child_setup
[1], F_GETFD
, 0);
1630 tem
= fcntl (wait_child_setup
[1], F_SETFD
, tem
| FD_CLOEXEC
);
1633 emacs_close (wait_child_setup
[0]);
1634 emacs_close (wait_child_setup
[1]);
1635 report_file_error ("Setting file descriptor flags", Qnil
);
1641 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1642 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1645 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1646 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1650 /* Record this as an active process, with its channels.
1651 As a result, child_setup will close Emacs's side of the pipes. */
1652 chan_process
[inchannel
] = process
;
1653 XPROCESS (process
)->infd
= inchannel
;
1654 XPROCESS (process
)->outfd
= outchannel
;
1656 /* Previously we recorded the tty descriptor used in the subprocess.
1657 It was only used for getting the foreground tty process, so now
1658 we just reopen the device (see emacs_get_tty_pgrp) as this is
1659 more portable (see USG_SUBTTY_WORKS above). */
1661 XPROCESS (process
)->pty_flag
= pty_flag
;
1662 XPROCESS (process
)->status
= Qrun
;
1664 /* Delay interrupts until we have a chance to store
1665 the new fork's pid in its process structure */
1666 sigemptyset (&blocked
);
1668 sigaddset (&blocked
, SIGCHLD
);
1670 #ifdef HAVE_WORKING_VFORK
1671 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1672 this sets the parent's signal handlers as well as the child's.
1673 So delay all interrupts whose handlers the child might munge,
1674 and record the current handlers so they can be restored later. */
1675 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1676 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1677 sigaddset (&blocked
, SIGPIPE
); sigaction (SIGPIPE
, 0, &sigpipe_action
);
1679 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1681 #endif /* HAVE_WORKING_VFORK */
1682 pthread_sigmask (SIG_BLOCK
, &blocked
, &procmask
);
1684 FD_SET (inchannel
, &input_wait_mask
);
1685 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1686 if (inchannel
> max_process_desc
)
1687 max_process_desc
= inchannel
;
1689 /* Until we store the proper pid, enable sigchld_handler
1690 to recognize an unknown pid as standing for this process.
1691 It is very important not to let this `marker' value stay
1692 in the table after this function has returned; if it does
1693 it might cause call-process to hang and subsequent asynchronous
1694 processes to get their return values scrambled. */
1695 XPROCESS (process
)->pid
= -1;
1697 /* This must be called after the above line because it may signal an
1699 setup_process_coding_systems (process
);
1704 /* child_setup must clobber environ on systems with true vfork.
1705 Protect it from permanent change. */
1706 char **save_environ
= environ
;
1707 volatile Lisp_Object encoded_current_dir
= ENCODE_FILE (current_dir
);
1712 #endif /* not WINDOWSNT */
1714 int xforkin
= forkin
;
1715 int xforkout
= forkout
;
1717 #if 0 /* This was probably a mistake--it duplicates code later on,
1718 but fails to handle all the cases. */
1719 /* Make sure SIGCHLD is not blocked in the child. */
1720 sigsetmask (SIGEMPTYMASK
);
1723 /* Make the pty be the controlling terminal of the process. */
1725 /* First, disconnect its current controlling terminal. */
1727 /* We tried doing setsid only if pty_flag, but it caused
1728 process_set_signal to fail on SGI when using a pipe. */
1730 /* Make the pty's terminal the controlling terminal. */
1731 if (pty_flag
&& xforkin
>= 0)
1734 /* We ignore the return value
1735 because faith@cs.unc.edu says that is necessary on Linux. */
1736 ioctl (xforkin
, TIOCSCTTY
, 0);
1739 #else /* not HAVE_SETSID */
1741 /* It's very important to call setpgrp here and no time
1742 afterwards. Otherwise, we lose our controlling tty which
1743 is set when we open the pty. */
1746 #endif /* not HAVE_SETSID */
1747 #if defined (LDISC1)
1748 if (pty_flag
&& xforkin
>= 0)
1751 tcgetattr (xforkin
, &t
);
1753 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1754 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1757 #if defined (NTTYDISC) && defined (TIOCSETD)
1758 if (pty_flag
&& xforkin
>= 0)
1760 /* Use new line discipline. */
1761 int ldisc
= NTTYDISC
;
1762 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1767 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1768 can do TIOCSPGRP only to the process's controlling tty. */
1771 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1772 I can't test it since I don't have 4.3. */
1773 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1776 ioctl (j
, TIOCNOTTY
, 0);
1780 /* In order to get a controlling terminal on some versions
1781 of BSD, it is necessary to put the process in pgrp 0
1782 before it opens the terminal. */
1790 #endif /* TIOCNOTTY */
1792 #if !defined (DONT_REOPEN_PTY)
1793 /*** There is a suggestion that this ought to be a
1794 conditional on TIOCSPGRP,
1795 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1796 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1797 that system does seem to need this code, even though
1798 both HAVE_SETSID and TIOCSCTTY are defined. */
1799 /* Now close the pty (if we had it open) and reopen it.
1800 This makes the pty the controlling terminal of the subprocess. */
1804 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1807 emacs_close (xforkin
);
1808 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
1812 emacs_write (1, "Couldn't open the pty terminal ", 31);
1813 emacs_write (1, pty_name
, strlen (pty_name
));
1814 emacs_write (1, "\n", 1);
1819 #endif /* not DONT_REOPEN_PTY */
1821 #ifdef SETUP_SLAVE_PTY
1826 #endif /* SETUP_SLAVE_PTY */
1828 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1829 Now reenable it in the child, so it will die when we want it to. */
1831 signal (SIGHUP
, SIG_DFL
);
1833 #endif /* HAVE_PTYS */
1835 signal (SIGINT
, SIG_DFL
);
1836 signal (SIGQUIT
, SIG_DFL
);
1837 /* GConf causes us to ignore SIGPIPE, make sure it is restored
1839 signal (SIGPIPE
, SIG_DFL
);
1841 /* Stop blocking signals in the child. */
1842 pthread_sigmask (SIG_SETMASK
, &procmask
, 0);
1845 child_setup_tty (xforkout
);
1847 pid
= child_setup (xforkin
, xforkout
, xforkout
,
1848 new_argv
, 1, encoded_current_dir
);
1849 #else /* not WINDOWSNT */
1851 emacs_close (wait_child_setup
[0]);
1853 child_setup (xforkin
, xforkout
, xforkout
,
1854 new_argv
, 1, encoded_current_dir
);
1855 #endif /* not WINDOWSNT */
1857 environ
= save_environ
;
1862 /* This runs in the Emacs process. */
1866 emacs_close (forkin
);
1867 if (forkin
!= forkout
&& forkout
>= 0)
1868 emacs_close (forkout
);
1872 /* vfork succeeded. */
1873 XPROCESS (process
)->pid
= pid
;
1876 register_child (pid
, inchannel
);
1877 #endif /* WINDOWSNT */
1879 /* If the subfork execv fails, and it exits,
1880 this close hangs. I don't know why.
1881 So have an interrupt jar it loose. */
1883 struct atimer
*timer
;
1887 EMACS_SET_SECS_USECS (offset
, 1, 0);
1888 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
1891 emacs_close (forkin
);
1893 cancel_atimer (timer
);
1897 if (forkin
!= forkout
&& forkout
>= 0)
1898 emacs_close (forkout
);
1902 XPROCESS (process
)->tty_name
= build_string (pty_name
);
1905 XPROCESS (process
)->tty_name
= Qnil
;
1907 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1908 /* Wait for child_setup to complete in case that vfork is
1909 actually defined as fork. The descriptor wait_child_setup[1]
1910 of a pipe is closed at the child side either by close-on-exec
1911 on successful execvp or the _exit call in child_setup. */
1915 emacs_close (wait_child_setup
[1]);
1916 emacs_read (wait_child_setup
[0], &dummy
, 1);
1917 emacs_close (wait_child_setup
[0]);
1922 /* Restore the signal state whether vfork succeeded or not.
1923 (We will signal an error, below, if it failed.) */
1924 #ifdef HAVE_WORKING_VFORK
1925 /* Restore the parent's signal handlers. */
1926 sigaction (SIGINT
, &sigint_action
, 0);
1927 sigaction (SIGQUIT
, &sigquit_action
, 0);
1928 sigaction (SIGPIPE
, &sigpipe_action
, 0);
1930 sigaction (SIGHUP
, &sighup_action
, 0);
1932 #endif /* HAVE_WORKING_VFORK */
1933 /* Stop blocking signals in the parent. */
1934 pthread_sigmask (SIG_SETMASK
, &procmask
, 0);
1936 /* Now generate the error if vfork failed. */
1938 report_file_error ("Doing vfork", Qnil
);
1942 create_pty (Lisp_Object process
)
1944 int inchannel
, outchannel
;
1947 inchannel
= outchannel
= -1;
1950 if (!NILP (Vprocess_connection_type
))
1951 outchannel
= inchannel
= allocate_pty ();
1955 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1956 /* On most USG systems it does not work to open the pty's tty here,
1957 then close it and reopen it in the child. */
1959 /* Don't let this terminal become our controlling terminal
1960 (in case we don't have one). */
1961 int forkout
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1963 int forkout
= emacs_open (pty_name
, O_RDWR
, 0);
1966 report_file_error ("Opening pty", Qnil
);
1967 #if defined (DONT_REOPEN_PTY)
1968 /* In the case that vfork is defined as fork, the parent process
1969 (Emacs) may send some data before the child process completes
1970 tty options setup. So we setup tty before forking. */
1971 child_setup_tty (forkout
);
1972 #endif /* DONT_REOPEN_PTY */
1973 #endif /* not USG, or USG_SUBTTY_WORKS */
1976 #endif /* HAVE_PTYS */
1979 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1980 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1983 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1984 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1988 /* Record this as an active process, with its channels.
1989 As a result, child_setup will close Emacs's side of the pipes. */
1990 chan_process
[inchannel
] = process
;
1991 XPROCESS (process
)->infd
= inchannel
;
1992 XPROCESS (process
)->outfd
= outchannel
;
1994 /* Previously we recorded the tty descriptor used in the subprocess.
1995 It was only used for getting the foreground tty process, so now
1996 we just reopen the device (see emacs_get_tty_pgrp) as this is
1997 more portable (see USG_SUBTTY_WORKS above). */
1999 XPROCESS (process
)->pty_flag
= pty_flag
;
2000 XPROCESS (process
)->status
= Qrun
;
2001 setup_process_coding_systems (process
);
2003 FD_SET (inchannel
, &input_wait_mask
);
2004 FD_SET (inchannel
, &non_keyboard_wait_mask
);
2005 if (inchannel
> max_process_desc
)
2006 max_process_desc
= inchannel
;
2008 XPROCESS (process
)->pid
= -2;
2011 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2014 XPROCESS (process
)->tty_name
= Qnil
;
2018 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2019 The address family of sa is not included in the result. */
2022 conv_sockaddr_to_lisp (struct sockaddr
*sa
, int len
)
2024 Lisp_Object address
;
2027 register struct Lisp_Vector
*p
;
2029 /* Workaround for a bug in getsockname on BSD: Names bound to
2030 sockets in the UNIX domain are inaccessible; getsockname returns
2031 a zero length name. */
2032 if (len
< offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
))
2033 return empty_unibyte_string
;
2035 switch (sa
->sa_family
)
2039 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2040 len
= sizeof (sin
->sin_addr
) + 1;
2041 address
= Fmake_vector (make_number (len
), Qnil
);
2042 p
= XVECTOR (address
);
2043 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2044 cp
= (unsigned char *) &sin
->sin_addr
;
2050 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2051 uint16_t *ip6
= (uint16_t *) &sin6
->sin6_addr
;
2052 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2053 address
= Fmake_vector (make_number (len
), Qnil
);
2054 p
= XVECTOR (address
);
2055 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2056 for (i
= 0; i
< len
; i
++)
2057 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2061 #ifdef HAVE_LOCAL_SOCKETS
2064 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2065 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2066 if (sockun
->sun_path
[i
] == 0)
2068 return make_unibyte_string (sockun
->sun_path
, i
);
2072 len
-= offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
);
2073 address
= Fcons (make_number (sa
->sa_family
),
2074 Fmake_vector (make_number (len
), Qnil
));
2075 p
= XVECTOR (XCDR (address
));
2076 cp
= (unsigned char *) &sa
->sa_family
+ sizeof (sa
->sa_family
);
2082 p
->contents
[i
++] = make_number (*cp
++);
2088 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2091 get_lisp_to_sockaddr_size (Lisp_Object address
, int *familyp
)
2093 register struct Lisp_Vector
*p
;
2095 if (VECTORP (address
))
2097 p
= XVECTOR (address
);
2098 if (p
->header
.size
== 5)
2101 return sizeof (struct sockaddr_in
);
2104 else if (p
->header
.size
== 9)
2106 *familyp
= AF_INET6
;
2107 return sizeof (struct sockaddr_in6
);
2111 #ifdef HAVE_LOCAL_SOCKETS
2112 else if (STRINGP (address
))
2114 *familyp
= AF_LOCAL
;
2115 return sizeof (struct sockaddr_un
);
2118 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2120 struct sockaddr
*sa
;
2121 *familyp
= XINT (XCAR (address
));
2122 p
= XVECTOR (XCDR (address
));
2123 return p
->header
.size
+ sizeof (sa
->sa_family
);
2128 /* Convert an address object (vector or string) to an internal sockaddr.
2130 The address format has been basically validated by
2131 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2132 it could have come from user data. So if FAMILY is not valid,
2133 we return after zeroing *SA. */
2136 conv_lisp_to_sockaddr (int family
, Lisp_Object address
, struct sockaddr
*sa
, int len
)
2138 register struct Lisp_Vector
*p
;
2139 register unsigned char *cp
= NULL
;
2142 memset (sa
, 0, len
);
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
;
2154 sa
->sa_family
= family
;
2157 else if (family
== AF_INET6
)
2159 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2160 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2161 len
= sizeof (sin6
->sin6_addr
) + 1;
2162 i
= XINT (p
->contents
[--len
]);
2163 sin6
->sin6_port
= htons (i
);
2164 for (i
= 0; i
< len
; i
++)
2165 if (INTEGERP (p
->contents
[i
]))
2167 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2170 sa
->sa_family
= family
;
2177 else if (STRINGP (address
))
2179 #ifdef HAVE_LOCAL_SOCKETS
2180 if (family
== AF_LOCAL
)
2182 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2183 cp
= SDATA (address
);
2184 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2185 sockun
->sun_path
[i
] = *cp
++;
2186 sa
->sa_family
= family
;
2193 p
= XVECTOR (XCDR (address
));
2194 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2197 for (i
= 0; i
< len
; i
++)
2198 if (INTEGERP (p
->contents
[i
]))
2199 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2202 #ifdef DATAGRAM_SOCKETS
2203 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2205 doc
: /* Get the current datagram address associated with PROCESS. */)
2206 (Lisp_Object process
)
2210 CHECK_PROCESS (process
);
2212 if (!DATAGRAM_CONN_P (process
))
2215 channel
= XPROCESS (process
)->infd
;
2216 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2217 datagram_address
[channel
].len
);
2220 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2222 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2223 Returns nil upon error setting address, ADDRESS otherwise. */)
2224 (Lisp_Object process
, Lisp_Object address
)
2229 CHECK_PROCESS (process
);
2231 if (!DATAGRAM_CONN_P (process
))
2234 channel
= XPROCESS (process
)->infd
;
2236 len
= get_lisp_to_sockaddr_size (address
, &family
);
2237 if (datagram_address
[channel
].len
!= len
)
2239 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2245 static const struct socket_options
{
2246 /* The name of this option. Should be lowercase version of option
2247 name without SO_ prefix. */
2249 /* Option level SOL_... */
2251 /* Option number SO_... */
2253 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2254 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2255 } socket_options
[] =
2257 #ifdef SO_BINDTODEVICE
2258 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2261 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2264 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2267 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2270 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2273 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2276 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2279 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2281 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2284 /* Set option OPT to value VAL on socket S.
2286 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2287 Signals an error if setting a known option fails.
2291 set_socket_option (int s
, Lisp_Object opt
, Lisp_Object val
)
2294 const struct socket_options
*sopt
;
2299 name
= SSDATA (SYMBOL_NAME (opt
));
2300 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2301 if (strcmp (name
, sopt
->name
) == 0)
2304 switch (sopt
->opttype
)
2309 optval
= NILP (val
) ? 0 : 1;
2310 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2311 &optval
, sizeof (optval
));
2319 optval
= XINT (val
);
2321 error ("Bad option value for %s", name
);
2322 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2323 &optval
, sizeof (optval
));
2327 #ifdef SO_BINDTODEVICE
2330 char devname
[IFNAMSIZ
+1];
2332 /* This is broken, at least in the Linux 2.4 kernel.
2333 To unbind, the arg must be a zero integer, not the empty string.
2334 This should work on all systems. KFS. 2003-09-23. */
2335 memset (devname
, 0, sizeof devname
);
2338 char *arg
= SSDATA (val
);
2339 int len
= min (strlen (arg
), IFNAMSIZ
);
2340 memcpy (devname
, arg
, len
);
2342 else if (!NILP (val
))
2343 error ("Bad option value for %s", name
);
2344 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2353 struct linger linger
;
2356 linger
.l_linger
= 0;
2358 linger
.l_linger
= XINT (val
);
2360 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2361 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2362 &linger
, sizeof (linger
));
2372 report_file_error ("Cannot set network option",
2373 Fcons (opt
, Fcons (val
, Qnil
)));
2374 return (1 << sopt
->optbit
);
2378 DEFUN ("set-network-process-option",
2379 Fset_network_process_option
, Sset_network_process_option
,
2381 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2382 See `make-network-process' for a list of options and values.
2383 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2384 OPTION is not a supported option, return nil instead; otherwise return t. */)
2385 (Lisp_Object process
, Lisp_Object option
, Lisp_Object value
, Lisp_Object no_error
)
2388 struct Lisp_Process
*p
;
2390 CHECK_PROCESS (process
);
2391 p
= XPROCESS (process
);
2392 if (!NETCONN1_P (p
))
2393 error ("Process is not a network process");
2397 error ("Process is not running");
2399 if (set_socket_option (s
, option
, value
))
2401 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2405 if (NILP (no_error
))
2406 error ("Unknown or unsupported option");
2412 DEFUN ("serial-process-configure",
2413 Fserial_process_configure
,
2414 Sserial_process_configure
,
2416 doc
: /* Configure speed, bytesize, etc. of a serial process.
2418 Arguments are specified as keyword/argument pairs. Attributes that
2419 are not given are re-initialized from the process's current
2420 configuration (available via the function `process-contact') or set to
2421 reasonable default values. The following arguments are defined:
2427 -- Any of these arguments can be given to identify the process that is
2428 to be configured. If none of these arguments is given, the current
2429 buffer's process is used.
2431 :speed SPEED -- SPEED is the speed of the serial port in bits per
2432 second, also called baud rate. Any value can be given for SPEED, but
2433 most serial ports work only at a few defined values between 1200 and
2434 115200, with 9600 being the most common value. If SPEED is nil, the
2435 serial port is not configured any further, i.e., all other arguments
2436 are ignored. This may be useful for special serial ports such as
2437 Bluetooth-to-serial converters which can only be configured through AT
2438 commands. A value of nil for SPEED can be used only when passed
2439 through `make-serial-process' or `serial-term'.
2441 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2442 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2444 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2445 `odd' (use odd parity), or the symbol `even' (use even parity). If
2446 PARITY is not given, no parity is used.
2448 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2449 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2450 is not given or nil, 1 stopbit is used.
2452 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2453 flowcontrol to be used, which is either nil (don't use flowcontrol),
2454 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2455 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2456 flowcontrol is used.
2458 `serial-process-configure' is called by `make-serial-process' for the
2459 initial configuration of the serial port.
2463 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2465 \(serial-process-configure
2466 :buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)
2468 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2470 usage: (serial-process-configure &rest ARGS) */)
2471 (ptrdiff_t nargs
, Lisp_Object
*args
)
2473 struct Lisp_Process
*p
;
2474 Lisp_Object contact
= Qnil
;
2475 Lisp_Object proc
= Qnil
;
2476 struct gcpro gcpro1
;
2478 contact
= Flist (nargs
, args
);
2481 proc
= Fplist_get (contact
, QCprocess
);
2483 proc
= Fplist_get (contact
, QCname
);
2485 proc
= Fplist_get (contact
, QCbuffer
);
2487 proc
= Fplist_get (contact
, QCport
);
2488 proc
= get_process (proc
);
2489 p
= XPROCESS (proc
);
2490 if (!EQ (p
->type
, Qserial
))
2491 error ("Not a serial process");
2493 if (NILP (Fplist_get (p
->childp
, QCspeed
)))
2499 serial_configure (p
, contact
);
2505 /* Used by make-serial-process to recover from errors. */
2507 make_serial_process_unwind (Lisp_Object proc
)
2509 if (!PROCESSP (proc
))
2511 remove_process (proc
);
2515 DEFUN ("make-serial-process", Fmake_serial_process
, Smake_serial_process
,
2517 doc
: /* Create and return a serial port process.
2519 In Emacs, serial port connections are represented by process objects,
2520 so input and output work as for subprocesses, and `delete-process'
2521 closes a serial port connection. However, a serial process has no
2522 process id, it cannot be signaled, and the status codes are different
2523 from normal processes.
2525 `make-serial-process' creates a process and a buffer, on which you
2526 probably want to use `process-send-string'. Try \\[serial-term] for
2527 an interactive terminal. See below for examples.
2529 Arguments are specified as keyword/argument pairs. The following
2530 arguments are defined:
2532 :port PORT -- (mandatory) PORT is the path or name of the serial port.
2533 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
2534 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
2535 the backslashes in strings).
2537 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
2538 which this function calls.
2540 :name NAME -- NAME is the name of the process. If NAME is not given,
2541 the value of PORT is used.
2543 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2544 with the process. Process output goes at the end of that buffer,
2545 unless you specify an output stream or filter function to handle the
2546 output. If BUFFER is not given, the value of NAME is used.
2548 :coding CODING -- If CODING is a symbol, it specifies the coding
2549 system used for both reading and writing for this process. If CODING
2550 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2551 ENCODING is used for writing.
2553 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2554 the process is running. If BOOL is not given, query before exiting.
2556 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
2557 In the stopped state, a serial process does not accept incoming data,
2558 but you can send outgoing data. The stopped state is cleared by
2559 `continue-process' and set by `stop-process'.
2561 :filter FILTER -- Install FILTER as the process filter.
2563 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2565 :plist PLIST -- Install PLIST as the initial plist of the process.
2571 -- This function calls `serial-process-configure' to handle these
2574 The original argument list, possibly modified by later configuration,
2575 is available via the function `process-contact'.
2579 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
2581 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
2583 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity 'odd)
2585 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
2587 usage: (make-serial-process &rest ARGS) */)
2588 (ptrdiff_t nargs
, Lisp_Object
*args
)
2591 Lisp_Object proc
, contact
, port
;
2592 struct Lisp_Process
*p
;
2593 struct gcpro gcpro1
;
2594 Lisp_Object name
, buffer
;
2595 Lisp_Object tem
, val
;
2596 int specpdl_count
= -1;
2601 contact
= Flist (nargs
, args
);
2604 port
= Fplist_get (contact
, QCport
);
2606 error ("No port specified");
2607 CHECK_STRING (port
);
2609 if (NILP (Fplist_member (contact
, QCspeed
)))
2610 error (":speed not specified");
2611 if (!NILP (Fplist_get (contact
, QCspeed
)))
2612 CHECK_NUMBER (Fplist_get (contact
, QCspeed
));
2614 name
= Fplist_get (contact
, QCname
);
2617 CHECK_STRING (name
);
2618 proc
= make_process (name
);
2619 specpdl_count
= SPECPDL_INDEX ();
2620 record_unwind_protect (make_serial_process_unwind
, proc
);
2621 p
= XPROCESS (proc
);
2623 fd
= serial_open (SSDATA (port
));
2626 if (fd
> max_process_desc
)
2627 max_process_desc
= fd
;
2628 chan_process
[fd
] = proc
;
2630 buffer
= Fplist_get (contact
, QCbuffer
);
2633 buffer
= Fget_buffer_create (buffer
);
2636 p
->childp
= contact
;
2637 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
2639 p
->sentinel
= Fplist_get (contact
, QCsentinel
);
2640 p
->filter
= Fplist_get (contact
, QCfilter
);
2642 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
2643 p
->kill_without_query
= 1;
2644 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
2648 if (!EQ (p
->command
, Qt
))
2650 FD_SET (fd
, &input_wait_mask
);
2651 FD_SET (fd
, &non_keyboard_wait_mask
);
2654 if (BUFFERP (buffer
))
2656 set_marker_both (p
->mark
, buffer
,
2657 BUF_ZV (XBUFFER (buffer
)),
2658 BUF_ZV_BYTE (XBUFFER (buffer
)));
2661 tem
= Fplist_member (contact
, QCcoding
);
2662 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
2668 val
= XCAR (XCDR (tem
));
2672 else if (!NILP (Vcoding_system_for_read
))
2673 val
= Vcoding_system_for_read
;
2674 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2675 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2677 p
->decode_coding_system
= val
;
2682 val
= XCAR (XCDR (tem
));
2686 else if (!NILP (Vcoding_system_for_write
))
2687 val
= Vcoding_system_for_write
;
2688 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2689 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2691 p
->encode_coding_system
= val
;
2693 setup_process_coding_systems (proc
);
2694 p
->decoding_buf
= empty_unibyte_string
;
2695 p
->decoding_carryover
= 0;
2696 p
->encoding_buf
= empty_unibyte_string
;
2697 p
->inherit_coding_system_flag
2698 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
2700 Fserial_process_configure (nargs
, args
);
2702 specpdl_ptr
= specpdl
+ specpdl_count
;
2708 /* Create a network stream/datagram client/server process. Treated
2709 exactly like a normal process when reading and writing. Primary
2710 differences are in status display and process deletion. A network
2711 connection has no PID; you cannot signal it. All you can do is
2712 stop/continue it and deactivate/close it via delete-process */
2714 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2716 doc
: /* Create and return a network server or client process.
2718 In Emacs, network connections are represented by process objects, so
2719 input and output work as for subprocesses and `delete-process' closes
2720 a network connection. However, a network process has no process id,
2721 it cannot be signaled, and the status codes are different from normal
2724 Arguments are specified as keyword/argument pairs. The following
2725 arguments are defined:
2727 :name NAME -- NAME is name for process. It is modified if necessary
2730 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2731 with the process. Process output goes at end of that buffer, unless
2732 you specify an output stream or filter function to handle the output.
2733 BUFFER may be also nil, meaning that this process is not associated
2736 :host HOST -- HOST is name of the host to connect to, or its IP
2737 address. The symbol `local' specifies the local host. If specified
2738 for a server process, it must be a valid name or address for the local
2739 host, and only clients connecting to that address will be accepted.
2741 :service SERVICE -- SERVICE is name of the service desired, or an
2742 integer specifying a port number to connect to. If SERVICE is t,
2743 a random port number is selected for the server. (If Emacs was
2744 compiled with getaddrinfo, a port number can also be specified as a
2745 string, e.g. "80", as well as an integer. This is not portable.)
2747 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2748 stream type connection, `datagram' creates a datagram type connection,
2749 `seqpacket' creates a reliable datagram connection.
2751 :family FAMILY -- FAMILY is the address (and protocol) family for the
2752 service specified by HOST and SERVICE. The default (nil) is to use
2753 whatever address family (IPv4 or IPv6) that is defined for the host
2754 and port number specified by HOST and SERVICE. Other address families
2756 local -- for a local (i.e. UNIX) address specified by SERVICE.
2757 ipv4 -- use IPv4 address family only.
2758 ipv6 -- use IPv6 address family only.
2760 :local ADDRESS -- ADDRESS is the local address used for the connection.
2761 This parameter is ignored when opening a client process. When specified
2762 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2764 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2765 connection. This parameter is ignored when opening a stream server
2766 process. For a datagram server process, it specifies the initial
2767 setting of the remote datagram address. When specified for a client
2768 process, the FAMILY, HOST, and SERVICE args are ignored.
2770 The format of ADDRESS depends on the address family:
2771 - An IPv4 address is represented as an vector of integers [A B C D P]
2772 corresponding to numeric IP address A.B.C.D and port number P.
2773 - A local address is represented as a string with the address in the
2774 local address space.
2775 - An "unsupported family" address is represented by a cons (F . AV)
2776 where F is the family number and AV is a vector containing the socket
2777 address data with one element per address data byte. Do not rely on
2778 this format in portable code, as it may depend on implementation
2779 defined constants, data sizes, and data structure alignment.
2781 :coding CODING -- If CODING is a symbol, it specifies the coding
2782 system used for both reading and writing for this process. If CODING
2783 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2784 ENCODING is used for writing.
2786 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2787 return without waiting for the connection to complete; instead, the
2788 sentinel function will be called with second arg matching "open" (if
2789 successful) or "failed" when the connect completes. Default is to use
2790 a blocking connect (i.e. wait) for stream type connections.
2792 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2793 running when Emacs is exited.
2795 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2796 In the stopped state, a server process does not accept new
2797 connections, and a client process does not handle incoming traffic.
2798 The stopped state is cleared by `continue-process' and set by
2801 :filter FILTER -- Install FILTER as the process filter.
2803 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2804 process filter are multibyte, otherwise they are unibyte.
2805 If this keyword is not specified, the strings are multibyte if
2806 the default value of `enable-multibyte-characters' is non-nil.
2808 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2810 :log LOG -- Install LOG as the server process log function. This
2811 function is called when the server accepts a network connection from a
2812 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2813 is the server process, CLIENT is the new process for the connection,
2814 and MESSAGE is a string.
2816 :plist PLIST -- Install PLIST as the new process' initial plist.
2818 :server QLEN -- if QLEN is non-nil, create a server process for the
2819 specified FAMILY, SERVICE, and connection type (stream or datagram).
2820 If QLEN is an integer, it is used as the max. length of the server's
2821 pending connection queue (also known as the backlog); the default
2822 queue length is 5. Default is to create a client process.
2824 The following network options can be specified for this connection:
2826 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2827 :dontroute BOOL -- Only send to directly connected hosts.
2828 :keepalive BOOL -- Send keep-alive messages on network stream.
2829 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2830 :oobinline BOOL -- Place out-of-band data in receive data stream.
2831 :priority INT -- Set protocol defined priority for sent packets.
2832 :reuseaddr BOOL -- Allow reusing a recently used local address
2833 (this is allowed by default for a server process).
2834 :bindtodevice NAME -- bind to interface NAME. Using this may require
2835 special privileges on some systems.
2837 Consult the relevant system programmer's manual pages for more
2838 information on using these options.
2841 A server process will listen for and accept connections from clients.
2842 When a client connection is accepted, a new network process is created
2843 for the connection with the following parameters:
2845 - The client's process name is constructed by concatenating the server
2846 process' NAME and a client identification string.
2847 - If the FILTER argument is non-nil, the client process will not get a
2848 separate process buffer; otherwise, the client's process buffer is a newly
2849 created buffer named after the server process' BUFFER name or process
2850 NAME concatenated with the client identification string.
2851 - The connection type and the process filter and sentinel parameters are
2852 inherited from the server process' TYPE, FILTER and SENTINEL.
2853 - The client process' contact info is set according to the client's
2854 addressing information (typically an IP address and a port number).
2855 - The client process' plist is initialized from the server's plist.
2857 Notice that the FILTER and SENTINEL args are never used directly by
2858 the server process. Also, the BUFFER argument is not used directly by
2859 the server process, but via the optional :log function, accepted (and
2860 failed) connections may be logged in the server process' buffer.
2862 The original argument list, modified with the actual connection
2863 information, is available via the `process-contact' function.
2865 usage: (make-network-process &rest ARGS) */)
2866 (ptrdiff_t nargs
, Lisp_Object
*args
)
2869 Lisp_Object contact
;
2870 struct Lisp_Process
*p
;
2871 #ifdef HAVE_GETADDRINFO
2872 struct addrinfo ai
, *res
, *lres
;
2873 struct addrinfo hints
;
2874 const char *portstring
;
2876 #else /* HAVE_GETADDRINFO */
2877 struct _emacs_addrinfo
2883 struct sockaddr
*ai_addr
;
2884 struct _emacs_addrinfo
*ai_next
;
2886 #endif /* HAVE_GETADDRINFO */
2887 struct sockaddr_in address_in
;
2888 #ifdef HAVE_LOCAL_SOCKETS
2889 struct sockaddr_un address_un
;
2894 int s
= -1, outch
, inch
;
2895 struct gcpro gcpro1
;
2896 int count
= SPECPDL_INDEX ();
2898 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2900 Lisp_Object name
, buffer
, host
, service
, address
;
2901 Lisp_Object filter
, sentinel
;
2902 int is_non_blocking_client
= 0;
2903 int is_server
= 0, backlog
= 5;
2910 /* Save arguments for process-contact and clone-process. */
2911 contact
= Flist (nargs
, args
);
2915 /* Ensure socket support is loaded if available. */
2916 init_winsock (TRUE
);
2919 /* :type TYPE (nil: stream, datagram */
2920 tem
= Fplist_get (contact
, QCtype
);
2922 socktype
= SOCK_STREAM
;
2923 #ifdef DATAGRAM_SOCKETS
2924 else if (EQ (tem
, Qdatagram
))
2925 socktype
= SOCK_DGRAM
;
2927 #ifdef HAVE_SEQPACKET
2928 else if (EQ (tem
, Qseqpacket
))
2929 socktype
= SOCK_SEQPACKET
;
2932 error ("Unsupported connection type");
2935 tem
= Fplist_get (contact
, QCserver
);
2938 /* Don't support network sockets when non-blocking mode is
2939 not available, since a blocked Emacs is not useful. */
2940 #if !defined (O_NONBLOCK) && !defined (O_NDELAY)
2941 error ("Network servers not supported");
2945 backlog
= XINT (tem
);
2949 /* Make QCaddress an alias for :local (server) or :remote (client). */
2950 QCaddress
= is_server
? QClocal
: QCremote
;
2953 if (!is_server
&& socktype
!= SOCK_DGRAM
2954 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2956 #ifndef NON_BLOCKING_CONNECT
2957 error ("Non-blocking connect not supported");
2959 is_non_blocking_client
= 1;
2963 name
= Fplist_get (contact
, QCname
);
2964 buffer
= Fplist_get (contact
, QCbuffer
);
2965 filter
= Fplist_get (contact
, QCfilter
);
2966 sentinel
= Fplist_get (contact
, QCsentinel
);
2968 CHECK_STRING (name
);
2970 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2971 ai
.ai_socktype
= socktype
;
2976 /* :local ADDRESS or :remote ADDRESS */
2977 address
= Fplist_get (contact
, QCaddress
);
2978 if (!NILP (address
))
2980 host
= service
= Qnil
;
2982 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2983 error ("Malformed :address");
2984 ai
.ai_family
= family
;
2985 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2986 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2990 /* :family FAMILY -- nil (for Inet), local, or integer. */
2991 tem
= Fplist_get (contact
, QCfamily
);
2994 #if defined (HAVE_GETADDRINFO) && defined (AF_INET6)
3000 #ifdef HAVE_LOCAL_SOCKETS
3001 else if (EQ (tem
, Qlocal
))
3005 else if (EQ (tem
, Qipv6
))
3008 else if (EQ (tem
, Qipv4
))
3010 else if (INTEGERP (tem
))
3011 family
= XINT (tem
);
3013 error ("Unknown address family");
3015 ai
.ai_family
= family
;
3017 /* :service SERVICE -- string, integer (port number), or t (random port). */
3018 service
= Fplist_get (contact
, QCservice
);
3020 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3021 host
= Fplist_get (contact
, QChost
);
3024 if (EQ (host
, Qlocal
))
3025 /* Depending on setup, "localhost" may map to different IPv4 and/or
3026 IPv6 addresses, so it's better to be explicit. (Bug#6781) */
3027 host
= build_string ("127.0.0.1");
3028 CHECK_STRING (host
);
3031 #ifdef HAVE_LOCAL_SOCKETS
3032 if (family
== AF_LOCAL
)
3036 message (":family local ignores the :host \"%s\" property",
3038 contact
= Fplist_put (contact
, QChost
, Qnil
);
3041 CHECK_STRING (service
);
3042 memset (&address_un
, 0, sizeof address_un
);
3043 address_un
.sun_family
= AF_LOCAL
;
3044 strncpy (address_un
.sun_path
, SSDATA (service
), sizeof address_un
.sun_path
);
3045 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
3046 ai
.ai_addrlen
= sizeof address_un
;
3051 /* Slow down polling to every ten seconds.
3052 Some kernels have a bug which causes retrying connect to fail
3053 after a connect. Polling can interfere with gethostbyname too. */
3054 #ifdef POLL_FOR_INPUT
3055 if (socktype
!= SOCK_DGRAM
)
3057 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
3058 bind_polling_period (10);
3062 #ifdef HAVE_GETADDRINFO
3063 /* If we have a host, use getaddrinfo to resolve both host and service.
3064 Otherwise, use getservbyname to lookup the service. */
3068 /* SERVICE can either be a string or int.
3069 Convert to a C string for later use by getaddrinfo. */
3070 if (EQ (service
, Qt
))
3072 else if (INTEGERP (service
))
3074 sprintf (portbuf
, "%"pI
"d", XINT (service
));
3075 portstring
= portbuf
;
3079 CHECK_STRING (service
);
3080 portstring
= SSDATA (service
);
3085 memset (&hints
, 0, sizeof (hints
));
3087 hints
.ai_family
= family
;
3088 hints
.ai_socktype
= socktype
;
3089 hints
.ai_protocol
= 0;
3091 #ifdef HAVE_RES_INIT
3095 ret
= getaddrinfo (SSDATA (host
), portstring
, &hints
, &res
);
3097 #ifdef HAVE_GAI_STRERROR
3098 error ("%s/%s %s", SSDATA (host
), portstring
, gai_strerror (ret
));
3100 error ("%s/%s getaddrinfo error %d", SSDATA (host
), portstring
, ret
);
3106 #endif /* HAVE_GETADDRINFO */
3108 /* We end up here if getaddrinfo is not defined, or in case no hostname
3109 has been specified (e.g. for a local server process). */
3111 if (EQ (service
, Qt
))
3113 else if (INTEGERP (service
))
3114 port
= htons ((unsigned short) XINT (service
));
3117 struct servent
*svc_info
;
3118 CHECK_STRING (service
);
3119 svc_info
= getservbyname (SSDATA (service
),
3120 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3122 error ("Unknown service: %s", SDATA (service
));
3123 port
= svc_info
->s_port
;
3126 memset (&address_in
, 0, sizeof address_in
);
3127 address_in
.sin_family
= family
;
3128 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3129 address_in
.sin_port
= port
;
3131 #ifndef HAVE_GETADDRINFO
3134 struct hostent
*host_info_ptr
;
3136 /* gethostbyname may fail with TRY_AGAIN, but we don't honor that,
3137 as it may `hang' Emacs for a very long time. */
3141 #ifdef HAVE_RES_INIT
3145 host_info_ptr
= gethostbyname (SDATA (host
));
3150 memcpy (&address_in
.sin_addr
, host_info_ptr
->h_addr
,
3151 host_info_ptr
->h_length
);
3152 family
= host_info_ptr
->h_addrtype
;
3153 address_in
.sin_family
= family
;
3156 /* Attempt to interpret host as numeric inet address */
3158 unsigned long numeric_addr
;
3159 numeric_addr
= inet_addr (SSDATA (host
));
3160 if (numeric_addr
== -1)
3161 error ("Unknown host \"%s\"", SDATA (host
));
3163 memcpy (&address_in
.sin_addr
, &numeric_addr
,
3164 sizeof (address_in
.sin_addr
));
3168 #endif /* not HAVE_GETADDRINFO */
3170 ai
.ai_family
= family
;
3171 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3172 ai
.ai_addrlen
= sizeof address_in
;
3176 /* Do this in case we never enter the for-loop below. */
3177 count1
= SPECPDL_INDEX ();
3180 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3189 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3196 #ifdef DATAGRAM_SOCKETS
3197 if (!is_server
&& socktype
== SOCK_DGRAM
)
3199 #endif /* DATAGRAM_SOCKETS */
3201 #ifdef NON_BLOCKING_CONNECT
3202 if (is_non_blocking_client
)
3205 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3207 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3219 /* Make us close S if quit. */
3220 record_unwind_protect (close_file_unwind
, make_number (s
));
3222 /* Parse network options in the arg list.
3223 We simply ignore anything which isn't a known option (including other keywords).
3224 An error is signaled if setting a known option fails. */
3225 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3226 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3230 /* Configure as a server socket. */
3232 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3233 explicit :reuseaddr key to override this. */
3234 #ifdef HAVE_LOCAL_SOCKETS
3235 if (family
!= AF_LOCAL
)
3237 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3240 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3241 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3244 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3245 report_file_error ("Cannot bind server socket", Qnil
);
3247 #ifdef HAVE_GETSOCKNAME
3248 if (EQ (service
, Qt
))
3250 struct sockaddr_in sa1
;
3251 socklen_t len1
= sizeof (sa1
);
3252 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3254 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3255 service
= make_number (ntohs (sa1
.sin_port
));
3256 contact
= Fplist_put (contact
, QCservice
, service
);
3261 if (socktype
!= SOCK_DGRAM
&& listen (s
, backlog
))
3262 report_file_error ("Cannot listen on server socket", Qnil
);
3270 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3273 if (ret
== 0 || xerrno
== EISCONN
)
3275 /* The unwind-protect will be discarded afterwards.
3276 Likewise for immediate_quit. */
3280 #ifdef NON_BLOCKING_CONNECT
3282 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3286 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3293 if (xerrno
== EINTR
)
3295 /* Unlike most other syscalls connect() cannot be called
3296 again. (That would return EALREADY.) The proper way to
3297 wait for completion is select(). */
3305 sc
= select (s
+ 1, (SELECT_TYPE
*)0, &fdset
, (SELECT_TYPE
*)0,
3312 report_file_error ("select failed", Qnil
);
3316 len
= sizeof xerrno
;
3317 eassert (FD_ISSET (s
, &fdset
));
3318 if (getsockopt (s
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &len
) == -1)
3319 report_file_error ("getsockopt failed", Qnil
);
3321 errno
= xerrno
, report_file_error ("error during connect", Qnil
);
3325 #endif /* !WINDOWSNT */
3329 /* Discard the unwind protect closing S. */
3330 specpdl_ptr
= specpdl
+ count1
;
3335 if (xerrno
== EINTR
)
3342 #ifdef DATAGRAM_SOCKETS
3343 if (socktype
== SOCK_DGRAM
)
3345 if (datagram_address
[s
].sa
)
3347 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3348 datagram_address
[s
].len
= lres
->ai_addrlen
;
3352 memset (datagram_address
[s
].sa
, 0, lres
->ai_addrlen
);
3353 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3356 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3357 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3358 conv_lisp_to_sockaddr (rfamily
, remote
,
3359 datagram_address
[s
].sa
, rlen
);
3363 memcpy (datagram_address
[s
].sa
, lres
->ai_addr
, lres
->ai_addrlen
);
3366 contact
= Fplist_put (contact
, QCaddress
,
3367 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3368 #ifdef HAVE_GETSOCKNAME
3371 struct sockaddr_in sa1
;
3372 socklen_t len1
= sizeof (sa1
);
3373 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3374 contact
= Fplist_put (contact
, QClocal
,
3375 conv_sockaddr_to_lisp ((struct sockaddr
*)&sa1
, len1
));
3382 #ifdef HAVE_GETADDRINFO
3391 /* Discard the unwind protect for closing S, if any. */
3392 specpdl_ptr
= specpdl
+ count1
;
3394 /* Unwind bind_polling_period and request_sigio. */
3395 unbind_to (count
, Qnil
);
3399 /* If non-blocking got this far - and failed - assume non-blocking is
3400 not supported after all. This is probably a wrong assumption, but
3401 the normal blocking calls to open-network-stream handles this error
3403 if (is_non_blocking_client
)
3408 report_file_error ("make server process failed", contact
);
3410 report_file_error ("make client process failed", contact
);
3417 buffer
= Fget_buffer_create (buffer
);
3418 proc
= make_process (name
);
3420 chan_process
[inch
] = proc
;
3423 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3426 fcntl (inch
, F_SETFL
, O_NDELAY
);
3430 p
= XPROCESS (proc
);
3432 p
->childp
= contact
;
3433 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3437 p
->sentinel
= sentinel
;
3439 p
->log
= Fplist_get (contact
, QClog
);
3440 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3441 p
->kill_without_query
= 1;
3442 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3447 if (is_server
&& socktype
!= SOCK_DGRAM
)
3448 p
->status
= Qlisten
;
3450 /* Make the process marker point into the process buffer (if any). */
3451 if (BUFFERP (buffer
))
3452 set_marker_both (p
->mark
, buffer
,
3453 BUF_ZV (XBUFFER (buffer
)),
3454 BUF_ZV_BYTE (XBUFFER (buffer
)));
3456 #ifdef NON_BLOCKING_CONNECT
3457 if (is_non_blocking_client
)
3459 /* We may get here if connect did succeed immediately. However,
3460 in that case, we still need to signal this like a non-blocking
3462 p
->status
= Qconnect
;
3463 if (!FD_ISSET (inch
, &connect_wait_mask
))
3465 FD_SET (inch
, &connect_wait_mask
);
3466 FD_SET (inch
, &write_mask
);
3467 num_pending_connects
++;
3472 /* A server may have a client filter setting of Qt, but it must
3473 still listen for incoming connects unless it is stopped. */
3474 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3475 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3477 FD_SET (inch
, &input_wait_mask
);
3478 FD_SET (inch
, &non_keyboard_wait_mask
);
3481 if (inch
> max_process_desc
)
3482 max_process_desc
= inch
;
3484 tem
= Fplist_member (contact
, QCcoding
);
3485 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3486 tem
= Qnil
; /* No error message (too late!). */
3489 /* Setup coding systems for communicating with the network stream. */
3490 struct gcpro gcpro1
;
3491 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3492 Lisp_Object coding_systems
= Qt
;
3493 Lisp_Object fargs
[5], val
;
3497 val
= XCAR (XCDR (tem
));
3501 else if (!NILP (Vcoding_system_for_read
))
3502 val
= Vcoding_system_for_read
;
3503 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
3504 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
3505 /* We dare not decode end-of-line format by setting VAL to
3506 Qraw_text, because the existing Emacs Lisp libraries
3507 assume that they receive bare code including a sequence of
3512 if (NILP (host
) || NILP (service
))
3513 coding_systems
= Qnil
;
3516 fargs
[0] = Qopen_network_stream
, fargs
[1] = name
,
3517 fargs
[2] = buffer
, fargs
[3] = host
, fargs
[4] = service
;
3519 coding_systems
= Ffind_operation_coding_system (5, fargs
);
3522 if (CONSP (coding_systems
))
3523 val
= XCAR (coding_systems
);
3524 else if (CONSP (Vdefault_process_coding_system
))
3525 val
= XCAR (Vdefault_process_coding_system
);
3529 p
->decode_coding_system
= val
;
3533 val
= XCAR (XCDR (tem
));
3537 else if (!NILP (Vcoding_system_for_write
))
3538 val
= Vcoding_system_for_write
;
3539 else if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3543 if (EQ (coding_systems
, Qt
))
3545 if (NILP (host
) || NILP (service
))
3546 coding_systems
= Qnil
;
3549 fargs
[0] = Qopen_network_stream
, fargs
[1] = name
,
3550 fargs
[2] = buffer
, fargs
[3] = host
, fargs
[4] = service
;
3552 coding_systems
= Ffind_operation_coding_system (5, fargs
);
3556 if (CONSP (coding_systems
))
3557 val
= XCDR (coding_systems
);
3558 else if (CONSP (Vdefault_process_coding_system
))
3559 val
= XCDR (Vdefault_process_coding_system
);
3563 p
->encode_coding_system
= val
;
3565 setup_process_coding_systems (proc
);
3567 p
->decoding_buf
= empty_unibyte_string
;
3568 p
->decoding_carryover
= 0;
3569 p
->encoding_buf
= empty_unibyte_string
;
3571 p
->inherit_coding_system_flag
3572 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
3579 #if defined (HAVE_NET_IF_H)
3582 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3583 doc
: /* Return an alist of all network interfaces and their network address.
3584 Each element is a cons, the car of which is a string containing the
3585 interface name, and the cdr is the network address in internal
3586 format; see the description of ADDRESS in `make-network-process'. */)
3589 struct ifconf ifconf
;
3590 struct ifreq
*ifreq
;
3592 ptrdiff_t buf_size
= 512;
3596 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3602 buf
= xpalloc (buf
, &buf_size
, 1, INT_MAX
, 1);
3603 ifconf
.ifc_buf
= buf
;
3604 ifconf
.ifc_len
= buf_size
;
3605 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3612 while (ifconf
.ifc_len
== buf_size
);
3617 ifreq
= ifconf
.ifc_req
;
3618 while ((char *) ifreq
< (char *) ifconf
.ifc_req
+ ifconf
.ifc_len
)
3620 struct ifreq
*ifq
= ifreq
;
3621 #ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
3622 #define SIZEOF_IFREQ(sif) \
3623 ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \
3624 ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len)
3626 int len
= SIZEOF_IFREQ (ifq
);
3628 int len
= sizeof (*ifreq
);
3630 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3632 ifreq
= (struct ifreq
*) ((char *) ifreq
+ len
);
3634 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3637 memcpy (namebuf
, ifq
->ifr_name
, sizeof (ifq
->ifr_name
));
3638 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3639 res
= Fcons (Fcons (build_string (namebuf
),
3640 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3641 sizeof (struct sockaddr
))),
3648 #endif /* SIOCGIFCONF */
3650 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
3654 const char *flag_sym
;
3657 static const struct ifflag_def ifflag_table
[] = {
3661 #ifdef IFF_BROADCAST
3662 { IFF_BROADCAST
, "broadcast" },
3665 { IFF_DEBUG
, "debug" },
3668 { IFF_LOOPBACK
, "loopback" },
3670 #ifdef IFF_POINTOPOINT
3671 { IFF_POINTOPOINT
, "pointopoint" },
3674 { IFF_RUNNING
, "running" },
3677 { IFF_NOARP
, "noarp" },
3680 { IFF_PROMISC
, "promisc" },
3682 #ifdef IFF_NOTRAILERS
3683 #ifdef NS_IMPL_COCOA
3684 /* Really means smart, notrailers is obsolete */
3685 { IFF_NOTRAILERS
, "smart" },
3687 { IFF_NOTRAILERS
, "notrailers" },
3691 { IFF_ALLMULTI
, "allmulti" },
3694 { IFF_MASTER
, "master" },
3697 { IFF_SLAVE
, "slave" },
3699 #ifdef IFF_MULTICAST
3700 { IFF_MULTICAST
, "multicast" },
3703 { IFF_PORTSEL
, "portsel" },
3705 #ifdef IFF_AUTOMEDIA
3706 { IFF_AUTOMEDIA
, "automedia" },
3709 { IFF_DYNAMIC
, "dynamic" },
3712 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3715 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3718 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3721 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3724 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3729 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3730 doc
: /* Return information about network interface named IFNAME.
3731 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3732 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3733 NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
3734 FLAGS is the current flags of the interface. */)
3735 (Lisp_Object ifname
)
3738 Lisp_Object res
= Qnil
;
3742 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
3743 && defined HAVE_GETIFADDRS && defined LLADDR)
3744 struct ifaddrs
*ifap
;
3747 CHECK_STRING (ifname
);
3749 memset (rq
.ifr_name
, 0, sizeof rq
.ifr_name
);
3750 strncpy (rq
.ifr_name
, SSDATA (ifname
), sizeof (rq
.ifr_name
));
3752 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3757 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
3758 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3760 int flags
= rq
.ifr_flags
;
3761 const struct ifflag_def
*fp
;
3764 /* If flags is smaller than int (i.e. short) it may have the high bit set
3765 due to IFF_MULTICAST. In that case, sign extending it into
3767 if (flags
< 0 && sizeof (rq
.ifr_flags
) < sizeof (flags
))
3768 flags
= (unsigned short) rq
.ifr_flags
;
3771 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3773 if (flags
& fp
->flag_bit
)
3775 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3776 flags
-= fp
->flag_bit
;
3779 for (fnum
= 0; flags
&& fnum
< 32; flags
>>= 1, fnum
++)
3783 elt
= Fcons (make_number (fnum
), elt
);
3788 res
= Fcons (elt
, res
);
3791 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
3792 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3794 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3795 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3799 for (n
= 0; n
< 6; n
++)
3800 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3801 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3803 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
3804 if (getifaddrs (&ifap
) != -1)
3806 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3807 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3810 for (it
= ifap
; it
!= NULL
; it
= it
->ifa_next
)
3812 struct sockaddr_dl
*sdl
= (struct sockaddr_dl
*) it
->ifa_addr
;
3813 unsigned char linkaddr
[6];
3816 if (it
->ifa_addr
->sa_family
!= AF_LINK
3817 || strcmp (it
->ifa_name
, SSDATA (ifname
)) != 0
3818 || sdl
->sdl_alen
!= 6)
3821 memcpy (linkaddr
, LLADDR (sdl
), sdl
->sdl_alen
);
3822 for (n
= 0; n
< 6; n
++)
3823 p
->contents
[n
] = make_number (linkaddr
[n
]);
3825 elt
= Fcons (make_number (it
->ifa_addr
->sa_family
), hwaddr
);
3829 #ifdef HAVE_FREEIFADDRS
3833 #endif /* HAVE_GETIFADDRS && LLADDR */
3835 res
= Fcons (elt
, res
);
3838 #if defined (SIOCGIFNETMASK) && (defined (HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined (HAVE_STRUCT_IFREQ_IFR_ADDR))
3839 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3842 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3843 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3845 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3849 res
= Fcons (elt
, res
);
3852 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3853 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3856 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3859 res
= Fcons (elt
, res
);
3862 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
3863 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3866 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3869 res
= Fcons (elt
, res
);
3873 return any
? res
: Qnil
;
3876 #endif /* defined (HAVE_NET_IF_H) */
3878 /* Turn off input and output for process PROC. */
3881 deactivate_process (Lisp_Object proc
)
3883 register int inchannel
, outchannel
;
3884 register struct Lisp_Process
*p
= XPROCESS (proc
);
3887 /* Delete GnuTLS structures in PROC, if any. */
3888 emacs_gnutls_deinit (proc
);
3889 #endif /* HAVE_GNUTLS */
3891 inchannel
= p
->infd
;
3892 outchannel
= p
->outfd
;
3894 #ifdef ADAPTIVE_READ_BUFFERING
3895 if (p
->read_output_delay
> 0)
3897 if (--process_output_delay_count
< 0)
3898 process_output_delay_count
= 0;
3899 p
->read_output_delay
= 0;
3900 p
->read_output_skip
= 0;
3906 /* Beware SIGCHLD hereabouts. */
3907 flush_pending_output (inchannel
);
3908 emacs_close (inchannel
);
3909 if (outchannel
>= 0 && outchannel
!= inchannel
)
3910 emacs_close (outchannel
);
3914 #ifdef DATAGRAM_SOCKETS
3915 if (DATAGRAM_CHAN_P (inchannel
))
3917 xfree (datagram_address
[inchannel
].sa
);
3918 datagram_address
[inchannel
].sa
= 0;
3919 datagram_address
[inchannel
].len
= 0;
3922 chan_process
[inchannel
] = Qnil
;
3923 FD_CLR (inchannel
, &input_wait_mask
);
3924 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3925 #ifdef NON_BLOCKING_CONNECT
3926 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3928 FD_CLR (inchannel
, &connect_wait_mask
);
3929 FD_CLR (inchannel
, &write_mask
);
3930 if (--num_pending_connects
< 0)
3934 if (inchannel
== max_process_desc
)
3937 /* We just closed the highest-numbered process input descriptor,
3938 so recompute the highest-numbered one now. */
3939 max_process_desc
= 0;
3940 for (i
= 0; i
< MAXDESC
; i
++)
3941 if (!NILP (chan_process
[i
]))
3942 max_process_desc
= i
;
3948 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3950 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3951 It is read into the process' buffers or given to their filter functions.
3952 Non-nil arg PROCESS means do not return until some output has been received
3955 Non-nil second arg SECONDS and third arg MILLISEC are number of seconds
3956 and milliseconds to wait; return after that much time whether or not
3957 there is any subprocess output. If SECONDS is a floating point number,
3958 it specifies a fractional number of seconds to wait.
3959 The MILLISEC argument is obsolete and should be avoided.
3961 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3962 from PROCESS, suspending reading output from other processes.
3963 If JUST-THIS-ONE is an integer, don't run any timers either.
3964 Return non-nil if we received any output before the timeout expired. */)
3965 (register Lisp_Object process
, Lisp_Object seconds
, Lisp_Object millisec
, Lisp_Object just_this_one
)
3967 int secs
, usecs
= 0;
3969 if (! NILP (process
))
3970 CHECK_PROCESS (process
);
3972 just_this_one
= Qnil
;
3974 if (!NILP (millisec
))
3975 { /* Obsolete calling convention using integers rather than floats. */
3976 CHECK_NUMBER (millisec
);
3978 seconds
= make_float (XINT (millisec
) / 1000.0);
3981 CHECK_NUMBER (seconds
);
3982 seconds
= make_float (XINT (millisec
) / 1000.0 + XINT (seconds
));
3986 if (!NILP (seconds
))
3988 if (INTEGERP (seconds
))
3989 secs
= XINT (seconds
);
3990 else if (FLOATP (seconds
))
3992 double timeout
= XFLOAT_DATA (seconds
);
3993 secs
= (int) timeout
;
3994 usecs
= (int) ((timeout
- (double) secs
) * 1000000);
3997 wrong_type_argument (Qnumberp
, seconds
);
3999 if (secs
< 0 || (secs
== 0 && usecs
== 0))
4000 secs
= -1, usecs
= 0;
4003 secs
= NILP (process
) ? -1 : 0;
4006 (wait_reading_process_output (secs
, usecs
, 0, 0,
4008 !NILP (process
) ? XPROCESS (process
) : NULL
,
4009 NILP (just_this_one
) ? 0 :
4010 !INTEGERP (just_this_one
) ? 1 : -1)
4014 /* Accept a connection for server process SERVER on CHANNEL. */
4016 static int connect_counter
= 0;
4019 server_accept_connection (Lisp_Object server
, int channel
)
4021 Lisp_Object proc
, caller
, name
, buffer
;
4022 Lisp_Object contact
, host
, service
;
4023 struct Lisp_Process
*ps
= XPROCESS (server
);
4024 struct Lisp_Process
*p
;
4028 struct sockaddr_in in
;
4030 struct sockaddr_in6 in6
;
4032 #ifdef HAVE_LOCAL_SOCKETS
4033 struct sockaddr_un un
;
4036 socklen_t len
= sizeof saddr
;
4038 s
= accept (channel
, &saddr
.sa
, &len
);
4047 if (code
== EWOULDBLOCK
)
4051 if (!NILP (ps
->log
))
4052 call3 (ps
->log
, server
, Qnil
,
4053 concat3 (build_string ("accept failed with code"),
4054 Fnumber_to_string (make_number (code
)),
4055 build_string ("\n")));
4061 /* Setup a new process to handle the connection. */
4063 /* Generate a unique identification of the caller, and build contact
4064 information for this process. */
4067 switch (saddr
.sa
.sa_family
)
4071 Lisp_Object args
[5];
4072 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4073 args
[0] = build_string ("%d.%d.%d.%d");
4074 args
[1] = make_number (*ip
++);
4075 args
[2] = make_number (*ip
++);
4076 args
[3] = make_number (*ip
++);
4077 args
[4] = make_number (*ip
++);
4078 host
= Fformat (5, args
);
4079 service
= make_number (ntohs (saddr
.in
.sin_port
));
4081 args
[0] = build_string (" <%s:%d>");
4084 caller
= Fformat (3, args
);
4091 Lisp_Object args
[9];
4092 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4094 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4095 for (i
= 0; i
< 8; i
++)
4096 args
[i
+1] = make_number (ntohs (ip6
[i
]));
4097 host
= Fformat (9, args
);
4098 service
= make_number (ntohs (saddr
.in
.sin_port
));
4100 args
[0] = build_string (" <[%s]:%d>");
4103 caller
= Fformat (3, args
);
4108 #ifdef HAVE_LOCAL_SOCKETS
4112 caller
= Fnumber_to_string (make_number (connect_counter
));
4113 caller
= concat3 (build_string (" <"), caller
, build_string (">"));
4117 /* Create a new buffer name for this process if it doesn't have a
4118 filter. The new buffer name is based on the buffer name or
4119 process name of the server process concatenated with the caller
4122 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4126 buffer
= ps
->buffer
;
4128 buffer
= Fbuffer_name (buffer
);
4133 buffer
= concat2 (buffer
, caller
);
4134 buffer
= Fget_buffer_create (buffer
);
4138 /* Generate a unique name for the new server process. Combine the
4139 server process name with the caller identification. */
4141 name
= concat2 (ps
->name
, caller
);
4142 proc
= make_process (name
);
4144 chan_process
[s
] = proc
;
4147 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4150 fcntl (s
, F_SETFL
, O_NDELAY
);
4154 p
= XPROCESS (proc
);
4156 /* Build new contact information for this setup. */
4157 contact
= Fcopy_sequence (ps
->childp
);
4158 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4159 contact
= Fplist_put (contact
, QChost
, host
);
4160 if (!NILP (service
))
4161 contact
= Fplist_put (contact
, QCservice
, service
);
4162 contact
= Fplist_put (contact
, QCremote
,
4163 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4164 #ifdef HAVE_GETSOCKNAME
4166 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4167 contact
= Fplist_put (contact
, QClocal
,
4168 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4171 p
->childp
= contact
;
4172 p
->plist
= Fcopy_sequence (ps
->plist
);
4176 p
->sentinel
= ps
->sentinel
;
4177 p
->filter
= ps
->filter
;
4184 /* Client processes for accepted connections are not stopped initially. */
4185 if (!EQ (p
->filter
, Qt
))
4187 FD_SET (s
, &input_wait_mask
);
4188 FD_SET (s
, &non_keyboard_wait_mask
);
4191 if (s
> max_process_desc
)
4192 max_process_desc
= s
;
4194 /* Setup coding system for new process based on server process.
4195 This seems to be the proper thing to do, as the coding system
4196 of the new process should reflect the settings at the time the
4197 server socket was opened; not the current settings. */
4199 p
->decode_coding_system
= ps
->decode_coding_system
;
4200 p
->encode_coding_system
= ps
->encode_coding_system
;
4201 setup_process_coding_systems (proc
);
4203 p
->decoding_buf
= empty_unibyte_string
;
4204 p
->decoding_carryover
= 0;
4205 p
->encoding_buf
= empty_unibyte_string
;
4207 p
->inherit_coding_system_flag
4208 = (NILP (buffer
) ? 0 : ps
->inherit_coding_system_flag
);
4210 if (!NILP (ps
->log
))
4211 call3 (ps
->log
, server
, proc
,
4212 concat3 (build_string ("accept from "),
4213 (STRINGP (host
) ? host
: build_string ("-")),
4214 build_string ("\n")));
4216 if (!NILP (p
->sentinel
))
4217 exec_sentinel (proc
,
4218 concat3 (build_string ("open from "),
4219 (STRINGP (host
) ? host
: build_string ("-")),
4220 build_string ("\n")));
4223 /* This variable is different from waiting_for_input in keyboard.c.
4224 It is used to communicate to a lisp process-filter/sentinel (via the
4225 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4226 for user-input when that process-filter was called.
4227 waiting_for_input cannot be used as that is by definition 0 when
4228 lisp code is being evalled.
4229 This is also used in record_asynch_buffer_change.
4230 For that purpose, this must be 0
4231 when not inside wait_reading_process_output. */
4232 static int waiting_for_user_input_p
;
4235 wait_reading_process_output_unwind (Lisp_Object data
)
4237 waiting_for_user_input_p
= XINT (data
);
4241 /* This is here so breakpoints can be put on it. */
4243 wait_reading_process_output_1 (void)
4247 /* Use a wrapper around select to work around a bug in gdb 5.3.
4248 Normally, the wrapper is optimized away by inlining.
4250 If emacs is stopped inside select, the gdb backtrace doesn't
4251 show the function which called select, so it is practically
4252 impossible to step through wait_reading_process_output. */
4256 select_wrapper (int n
, fd_set
*rfd
, fd_set
*wfd
, fd_set
*xfd
, struct timeval
*tmo
)
4258 return select (n
, rfd
, wfd
, xfd
, tmo
);
4260 #define select select_wrapper
4263 /* Read and dispose of subprocess output while waiting for timeout to
4264 elapse and/or keyboard input to be available.
4267 timeout in seconds, or
4268 zero for no limit, or
4269 -1 means gobble data immediately available but don't wait for any.
4272 an additional duration to wait, measured in microseconds.
4273 If this is nonzero and time_limit is 0, then the timeout
4274 consists of MICROSECS only.
4276 READ_KBD is a lisp value:
4277 0 to ignore keyboard input, or
4278 1 to return when input is available, or
4279 -1 meaning caller will actually read the input, so don't throw to
4280 the quit handler, or
4282 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4283 output that arrives.
4285 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4286 (and gobble terminal input into the buffer if any arrives).
4288 If WAIT_PROC is specified, wait until something arrives from that
4289 process. The return value is true if we read some input from
4292 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4293 (suspending output from other processes). A negative value
4294 means don't run any timers either.
4296 If WAIT_PROC is specified, then the function returns true if we
4297 received input from that process before the timeout elapsed.
4298 Otherwise, return true if we received input from any process. */
4301 wait_reading_process_output (int time_limit
, int microsecs
, int read_kbd
,
4303 Lisp_Object wait_for_cell
,
4304 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
4306 register int channel
, nfds
;
4307 SELECT_TYPE Available
;
4308 SELECT_TYPE Writeok
;
4310 int check_delay
, no_avail
;
4313 EMACS_TIME timeout
, end_time
;
4314 int wait_channel
= -1;
4315 int got_some_input
= 0;
4316 int count
= SPECPDL_INDEX ();
4318 FD_ZERO (&Available
);
4321 if (time_limit
== 0 && microsecs
== 0 && wait_proc
&& !NILP (Vinhibit_quit
)
4322 && !(CONSP (wait_proc
->status
) && EQ (XCAR (wait_proc
->status
), Qexit
)))
4323 message ("Blocking call to accept-process-output with quit inhibited!!");
4325 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4326 if (wait_proc
!= NULL
)
4327 wait_channel
= wait_proc
->infd
;
4329 record_unwind_protect (wait_reading_process_output_unwind
,
4330 make_number (waiting_for_user_input_p
));
4331 waiting_for_user_input_p
= read_kbd
;
4333 /* Since we may need to wait several times,
4334 compute the absolute time to return at. */
4335 if (time_limit
|| microsecs
)
4337 EMACS_GET_TIME (end_time
);
4338 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4339 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4344 int timeout_reduced_for_timers
= 0;
4346 /* If calling from keyboard input, do not quit
4347 since we want to return C-g as an input character.
4348 Otherwise, do pending quit if requested. */
4353 process_pending_signals ();
4356 /* Exit now if the cell we're waiting for became non-nil. */
4357 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4360 /* Compute time from now till when time limit is up */
4361 /* Exit if already run out */
4362 if (time_limit
== -1)
4364 /* -1 specified for timeout means
4365 gobble output available now
4366 but don't wait at all. */
4368 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4370 else if (time_limit
|| microsecs
)
4372 EMACS_GET_TIME (timeout
);
4373 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4374 if (EMACS_TIME_NEG_P (timeout
))
4379 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4382 /* Normally we run timers here.
4383 But not if wait_for_cell; in those cases,
4384 the wait is supposed to be short,
4385 and those callers cannot handle running arbitrary Lisp code here. */
4386 if (NILP (wait_for_cell
)
4387 && just_wait_proc
>= 0)
4389 EMACS_TIME timer_delay
;
4393 int old_timers_run
= timers_run
;
4394 struct buffer
*old_buffer
= current_buffer
;
4395 Lisp_Object old_window
= selected_window
;
4397 timer_delay
= timer_check ();
4399 /* If a timer has run, this might have changed buffers
4400 an alike. Make read_key_sequence aware of that. */
4401 if (timers_run
!= old_timers_run
4402 && (old_buffer
!= current_buffer
4403 || !EQ (old_window
, selected_window
))
4404 && waiting_for_user_input_p
== -1)
4405 record_asynch_buffer_change ();
4407 if (timers_run
!= old_timers_run
&& do_display
)
4408 /* We must retry, since a timer may have requeued itself
4409 and that could alter the time_delay. */
4410 redisplay_preserve_echo_area (9);
4414 while (!detect_input_pending ());
4416 /* If there is unread keyboard input, also return. */
4418 && requeued_events_pending_p ())
4421 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4423 EMACS_TIME difference
;
4424 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4425 if (EMACS_TIME_NEG_P (difference
))
4427 timeout
= timer_delay
;
4428 timeout_reduced_for_timers
= 1;
4431 /* If time_limit is -1, we are not going to wait at all. */
4432 else if (time_limit
!= -1)
4434 /* This is so a breakpoint can be put here. */
4435 wait_reading_process_output_1 ();
4439 /* Cause C-g and alarm signals to take immediate action,
4440 and cause input available signals to zero out timeout.
4442 It is important that we do this before checking for process
4443 activity. If we get a SIGCHLD after the explicit checks for
4444 process activity, timeout is the only way we will know. */
4446 set_waiting_for_input (&timeout
);
4448 /* If status of something has changed, and no input is
4449 available, notify the user of the change right away. After
4450 this explicit check, we'll let the SIGCHLD handler zap
4451 timeout to get our attention. */
4452 if (update_tick
!= process_tick
)
4457 if (kbd_on_hold_p ())
4460 Atemp
= input_wait_mask
;
4463 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4464 if ((select (max (max_process_desc
, max_input_desc
) + 1,
4466 #ifdef NON_BLOCKING_CONNECT
4467 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4471 (SELECT_TYPE
*)0, &timeout
)
4474 /* It's okay for us to do this and then continue with
4475 the loop, since timeout has already been zeroed out. */
4476 clear_waiting_for_input ();
4477 status_notify (NULL
);
4478 if (do_display
) redisplay_preserve_echo_area (13);
4482 /* Don't wait for output from a non-running process. Just
4483 read whatever data has already been received. */
4484 if (wait_proc
&& wait_proc
->raw_status_new
)
4485 update_status (wait_proc
);
4487 && ! EQ (wait_proc
->status
, Qrun
)
4488 && ! EQ (wait_proc
->status
, Qconnect
))
4490 int nread
, total_nread
= 0;
4492 clear_waiting_for_input ();
4493 XSETPROCESS (proc
, wait_proc
);
4495 /* Read data from the process, until we exhaust it. */
4496 while (wait_proc
->infd
>= 0)
4498 nread
= read_process_output (proc
, wait_proc
->infd
);
4505 total_nread
+= nread
;
4509 else if (nread
== -1 && EIO
== errno
)
4513 else if (nread
== -1 && EAGAIN
== errno
)
4517 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4521 if (total_nread
> 0 && do_display
)
4522 redisplay_preserve_echo_area (10);
4527 /* Wait till there is something to do */
4529 if (wait_proc
&& just_wait_proc
)
4531 if (wait_proc
->infd
< 0) /* Terminated */
4533 FD_SET (wait_proc
->infd
, &Available
);
4537 else if (!NILP (wait_for_cell
))
4539 Available
= non_process_wait_mask
;
4546 Available
= non_keyboard_wait_mask
;
4548 Available
= input_wait_mask
;
4549 Writeok
= write_mask
;
4550 #ifdef SELECT_CANT_DO_WRITE_MASK
4555 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4558 /* If frame size has changed or the window is newly mapped,
4559 redisplay now, before we start to wait. There is a race
4560 condition here; if a SIGIO arrives between now and the select
4561 and indicates that a frame is trashed, the select may block
4562 displaying a trashed screen. */
4563 if (frame_garbaged
&& do_display
)
4565 clear_waiting_for_input ();
4566 redisplay_preserve_echo_area (11);
4568 set_waiting_for_input (&timeout
);
4571 /* Skip the `select' call if input is available and we're
4572 waiting for keyboard input or a cell change (which can be
4573 triggered by processing X events). In the latter case, set
4574 nfds to 1 to avoid breaking the loop. */
4576 if ((read_kbd
|| !NILP (wait_for_cell
))
4577 && detect_input_pending ())
4579 nfds
= read_kbd
? 0 : 1;
4586 #ifdef ADAPTIVE_READ_BUFFERING
4587 /* Set the timeout for adaptive read buffering if any
4588 process has non-zero read_output_skip and non-zero
4589 read_output_delay, and we are not reading output for a
4590 specific wait_channel. It is not executed if
4591 Vprocess_adaptive_read_buffering is nil. */
4592 if (process_output_skip
&& check_delay
> 0)
4594 int usecs
= EMACS_USECS (timeout
);
4595 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4596 usecs
= READ_OUTPUT_DELAY_MAX
;
4597 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4599 proc
= chan_process
[channel
];
4602 /* Find minimum non-zero read_output_delay among the
4603 processes with non-zero read_output_skip. */
4604 if (XPROCESS (proc
)->read_output_delay
> 0)
4607 if (!XPROCESS (proc
)->read_output_skip
)
4609 FD_CLR (channel
, &Available
);
4610 XPROCESS (proc
)->read_output_skip
= 0;
4611 if (XPROCESS (proc
)->read_output_delay
< usecs
)
4612 usecs
= XPROCESS (proc
)->read_output_delay
;
4615 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4616 process_output_skip
= 0;
4619 #if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
4621 #elif defined (HAVE_NS)
4626 (max (max_process_desc
, max_input_desc
) + 1,
4628 (check_write
? &Writeok
: (SELECT_TYPE
*)0),
4629 (SELECT_TYPE
*)0, &timeout
);
4632 /* GnuTLS buffers data internally. In lowat mode it leaves
4633 some data in the TCP buffers so that select works, but
4634 with custom pull/push functions we need to check if some
4635 data is available in the buffers manually. */
4640 /* We're not waiting on a specific process, so loop
4641 through all the channels and check for data.
4642 This is a workaround needed for some versions of
4643 the gnutls library -- 2.12.14 has been confirmed
4645 http://comments.gmane.org/gmane.emacs.devel/145074 */
4646 for (channel
= 0; channel
< MAXDESC
; ++channel
)
4647 if (! NILP (chan_process
[channel
]))
4649 struct Lisp_Process
*p
=
4650 XPROCESS (chan_process
[channel
]);
4651 if (p
&& p
->gnutls_p
&& p
->infd
4652 && ((emacs_gnutls_record_check_pending
4657 FD_SET (p
->infd
, &Available
);
4663 /* Check this specific channel. */
4664 if (wait_proc
->gnutls_p
/* Check for valid process. */
4665 /* Do we have pending data? */
4666 && ((emacs_gnutls_record_check_pending
4667 (wait_proc
->gnutls_state
))
4671 /* Set to Available. */
4672 FD_SET (wait_proc
->infd
, &Available
);
4681 /* Make C-g and alarm signals set flags again */
4682 clear_waiting_for_input ();
4684 /* If we woke up due to SIGWINCH, actually change size now. */
4685 do_pending_window_change (0);
4687 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4688 /* We wanted the full specified time, so return now. */
4692 if (xerrno
== EINTR
)
4694 else if (xerrno
== EBADF
)
4697 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4698 the child's closure of the pts gives the parent a SIGHUP, and
4699 the ptc file descriptor is automatically closed,
4700 yielding EBADF here or at select() call above.
4701 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4702 in m/ibmrt-aix.h), and here we just ignore the select error.
4703 Cleanup occurs c/o status_notify after SIGCLD. */
4704 no_avail
= 1; /* Cannot depend on values returned */
4710 error ("select error: %s", emacs_strerror (xerrno
));
4715 FD_ZERO (&Available
);
4719 #if 0 /* When polling is used, interrupt_input is 0,
4720 so get_input_pending should read the input.
4721 So this should not be needed. */
4722 /* If we are using polling for input,
4723 and we see input available, make it get read now.
4724 Otherwise it might not actually get read for a second.
4725 And on hpux, since we turn off polling in wait_reading_process_output,
4726 it might never get read at all if we don't spend much time
4727 outside of wait_reading_process_output. */
4728 if (read_kbd
&& interrupt_input
4729 && keyboard_bit_set (&Available
)
4730 && input_polling_used ())
4731 kill (getpid (), SIGALRM
);
4734 /* Check for keyboard input */
4735 /* If there is any, return immediately
4736 to give it higher priority than subprocesses */
4740 int old_timers_run
= timers_run
;
4741 struct buffer
*old_buffer
= current_buffer
;
4742 Lisp_Object old_window
= selected_window
;
4745 if (detect_input_pending_run_timers (do_display
))
4747 swallow_events (do_display
);
4748 if (detect_input_pending_run_timers (do_display
))
4752 /* If a timer has run, this might have changed buffers
4753 an alike. Make read_key_sequence aware of that. */
4754 if (timers_run
!= old_timers_run
4755 && waiting_for_user_input_p
== -1
4756 && (old_buffer
!= current_buffer
4757 || !EQ (old_window
, selected_window
)))
4758 record_asynch_buffer_change ();
4764 /* If there is unread keyboard input, also return. */
4766 && requeued_events_pending_p ())
4769 /* If we are not checking for keyboard input now,
4770 do process events (but don't run any timers).
4771 This is so that X events will be processed.
4772 Otherwise they may have to wait until polling takes place.
4773 That would causes delays in pasting selections, for example.
4775 (We used to do this only if wait_for_cell.) */
4776 if (read_kbd
== 0 && detect_input_pending ())
4778 swallow_events (do_display
);
4779 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4780 if (detect_input_pending ())
4785 /* Exit now if the cell we're waiting for became non-nil. */
4786 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4790 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4791 go read it. This can happen with X on BSD after logging out.
4792 In that case, there really is no input and no SIGIO,
4793 but select says there is input. */
4795 if (read_kbd
&& interrupt_input
4796 && keyboard_bit_set (&Available
) && ! noninteractive
)
4797 kill (getpid (), SIGIO
);
4801 got_some_input
|= nfds
> 0;
4803 /* If checking input just got us a size-change event from X,
4804 obey it now if we should. */
4805 if (read_kbd
|| ! NILP (wait_for_cell
))
4806 do_pending_window_change (0);
4808 /* Check for data from a process. */
4809 if (no_avail
|| nfds
== 0)
4812 for (channel
= 0; channel
<= max_input_desc
; ++channel
)
4814 struct fd_callback_data
*d
= &fd_callback_info
[channel
];
4815 if (FD_ISSET (channel
, &Available
)
4817 && (d
->condition
& FOR_READ
) != 0)
4818 d
->func (channel
, d
->data
, 1);
4819 if (FD_ISSET (channel
, &write_mask
)
4821 && (d
->condition
& FOR_WRITE
) != 0)
4822 d
->func (channel
, d
->data
, 0);
4825 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4827 if (FD_ISSET (channel
, &Available
)
4828 && FD_ISSET (channel
, &non_keyboard_wait_mask
)
4829 && !FD_ISSET (channel
, &non_process_wait_mask
))
4833 /* If waiting for this channel, arrange to return as
4834 soon as no more input to be processed. No more
4836 if (wait_channel
== channel
)
4842 proc
= chan_process
[channel
];
4846 /* If this is a server stream socket, accept connection. */
4847 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4849 server_accept_connection (proc
, channel
);
4853 /* Read data from the process, starting with our
4854 buffered-ahead character if we have one. */
4856 nread
= read_process_output (proc
, channel
);
4859 /* Since read_process_output can run a filter,
4860 which can call accept-process-output,
4861 don't try to read from any other processes
4862 before doing the select again. */
4863 FD_ZERO (&Available
);
4866 redisplay_preserve_echo_area (12);
4869 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4872 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4873 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4875 else if (nread
== -1 && errno
== EAGAIN
)
4879 else if (nread
== -1 && errno
== EAGAIN
)
4881 /* Note that we cannot distinguish between no input
4882 available now and a closed pipe.
4883 With luck, a closed pipe will be accompanied by
4884 subprocess termination and SIGCHLD. */
4885 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
4887 #endif /* O_NDELAY */
4888 #endif /* O_NONBLOCK */
4890 /* On some OSs with ptys, when the process on one end of
4891 a pty exits, the other end gets an error reading with
4892 errno = EIO instead of getting an EOF (0 bytes read).
4893 Therefore, if we get an error reading and errno =
4894 EIO, just continue, because the child process has
4895 exited and should clean itself up soon (e.g. when we
4898 However, it has been known to happen that the SIGCHLD
4899 got lost. So raise the signal again just in case.
4901 else if (nread
== -1 && errno
== EIO
)
4903 struct Lisp_Process
*p
= XPROCESS (proc
);
4905 /* Clear the descriptor now, so we only raise the
4907 FD_CLR (channel
, &input_wait_mask
);
4908 FD_CLR (channel
, &non_keyboard_wait_mask
);
4912 /* If the EIO occurs on a pty, sigchld_handler's
4913 wait3() will not find the process object to
4914 delete. Do it here. */
4915 p
->tick
= ++process_tick
;
4916 p
->status
= Qfailed
;
4919 kill (getpid (), SIGCHLD
);
4921 #endif /* HAVE_PTYS */
4922 /* If we can detect process termination, don't consider the
4923 process gone just because its pipe is closed. */
4925 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
4930 /* Preserve status of processes already terminated. */
4931 XPROCESS (proc
)->tick
= ++process_tick
;
4932 deactivate_process (proc
);
4933 if (XPROCESS (proc
)->raw_status_new
)
4934 update_status (XPROCESS (proc
));
4935 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4936 XPROCESS (proc
)->status
4937 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4940 #ifdef NON_BLOCKING_CONNECT
4941 if (FD_ISSET (channel
, &Writeok
)
4942 && FD_ISSET (channel
, &connect_wait_mask
))
4944 struct Lisp_Process
*p
;
4946 FD_CLR (channel
, &connect_wait_mask
);
4947 FD_CLR (channel
, &write_mask
);
4948 if (--num_pending_connects
< 0)
4951 proc
= chan_process
[channel
];
4955 p
= XPROCESS (proc
);
4958 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4959 So only use it on systems where it is known to work. */
4961 socklen_t xlen
= sizeof (xerrno
);
4962 if (getsockopt (channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4967 struct sockaddr pname
;
4968 int pnamelen
= sizeof (pname
);
4970 /* If connection failed, getpeername will fail. */
4972 if (getpeername (channel
, &pname
, &pnamelen
) < 0)
4974 /* Obtain connect failure code through error slippage. */
4977 if (errno
== ENOTCONN
&& read (channel
, &dummy
, 1) < 0)
4984 p
->tick
= ++process_tick
;
4985 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4986 deactivate_process (proc
);
4991 /* Execute the sentinel here. If we had relied on
4992 status_notify to do it later, it will read input
4993 from the process before calling the sentinel. */
4994 exec_sentinel (proc
, build_string ("open\n"));
4995 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4997 FD_SET (p
->infd
, &input_wait_mask
);
4998 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
5002 #endif /* NON_BLOCKING_CONNECT */
5003 } /* end for each file descriptor */
5004 } /* end while exit conditions not met */
5006 unbind_to (count
, Qnil
);
5008 /* If calling from keyboard input, do not quit
5009 since we want to return C-g as an input character.
5010 Otherwise, do pending quit if requested. */
5013 /* Prevent input_pending from remaining set if we quit. */
5014 clear_input_pending ();
5018 return got_some_input
;
5021 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5024 read_process_output_call (Lisp_Object fun_and_args
)
5026 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
5030 read_process_output_error_handler (Lisp_Object error_val
)
5032 cmd_error_internal (error_val
, "error in process filter: ");
5034 update_echo_area ();
5035 Fsleep_for (make_number (2), Qnil
);
5039 /* Read pending output from the process channel,
5040 starting with our buffered-ahead character if we have one.
5041 Yield number of decoded characters read.
5043 This function reads at most 4096 characters.
5044 If you want to read all available subprocess output,
5045 you must call it repeatedly until it returns zero.
5047 The characters read are decoded according to PROC's coding-system
5051 read_process_output (Lisp_Object proc
, register int channel
)
5053 register ssize_t nbytes
;
5055 register Lisp_Object outstream
;
5056 register struct Lisp_Process
*p
= XPROCESS (proc
);
5057 register EMACS_INT opoint
;
5058 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
5059 int carryover
= p
->decoding_carryover
;
5061 int count
= SPECPDL_INDEX ();
5062 Lisp_Object odeactivate
;
5064 chars
= (char *) alloca (carryover
+ readmax
);
5066 /* See the comment above. */
5067 memcpy (chars
, SDATA (p
->decoding_buf
), carryover
);
5069 #ifdef DATAGRAM_SOCKETS
5070 /* We have a working select, so proc_buffered_char is always -1. */
5071 if (DATAGRAM_CHAN_P (channel
))
5073 socklen_t len
= datagram_address
[channel
].len
;
5074 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5075 0, datagram_address
[channel
].sa
, &len
);
5080 int buffered
= 0 <= proc_buffered_char
[channel
];
5083 chars
[carryover
] = proc_buffered_char
[channel
];
5084 proc_buffered_char
[channel
] = -1;
5088 nbytes
= emacs_gnutls_read (p
, chars
+ carryover
+ buffered
,
5089 readmax
- buffered
);
5092 nbytes
= emacs_read (channel
, chars
+ carryover
+ buffered
,
5093 readmax
- buffered
);
5094 #ifdef ADAPTIVE_READ_BUFFERING
5095 if (nbytes
> 0 && p
->adaptive_read_buffering
)
5097 int delay
= p
->read_output_delay
;
5100 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5103 process_output_delay_count
++;
5104 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5107 else if (delay
> 0 && nbytes
== readmax
- buffered
)
5109 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5111 process_output_delay_count
--;
5113 p
->read_output_delay
= delay
;
5116 p
->read_output_skip
= 1;
5117 process_output_skip
= 1;
5122 nbytes
+= buffered
&& nbytes
<= 0;
5125 p
->decoding_carryover
= 0;
5127 /* At this point, NBYTES holds number of bytes just received
5128 (including the one in proc_buffered_char[channel]). */
5131 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5133 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5136 /* Now set NBYTES how many bytes we must decode. */
5137 nbytes
+= carryover
;
5139 odeactivate
= Vdeactivate_mark
;
5140 /* There's no good reason to let process filters change the current
5141 buffer, and many callers of accept-process-output, sit-for, and
5142 friends don't expect current-buffer to be changed from under them. */
5143 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
5145 /* Read and dispose of the process output. */
5146 outstream
= p
->filter
;
5147 if (!NILP (outstream
))
5150 int outer_running_asynch_code
= running_asynch_code
;
5151 int waiting
= waiting_for_user_input_p
;
5153 /* No need to gcpro these, because all we do with them later
5154 is test them for EQness, and none of them should be a string. */
5156 Lisp_Object obuffer
, okeymap
;
5157 XSETBUFFER (obuffer
, current_buffer
);
5158 okeymap
= BVAR (current_buffer
, keymap
);
5161 /* We inhibit quit here instead of just catching it so that
5162 hitting ^G when a filter happens to be running won't screw
5164 specbind (Qinhibit_quit
, Qt
);
5165 specbind (Qlast_nonmenu_event
, Qt
);
5167 /* In case we get recursively called,
5168 and we already saved the match data nonrecursively,
5169 save the same match data in safely recursive fashion. */
5170 if (outer_running_asynch_code
)
5173 /* Don't clobber the CURRENT match data, either! */
5174 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5175 restore_search_regs ();
5176 record_unwind_save_match_data ();
5177 Fset_match_data (tem
, Qt
);
5180 /* For speed, if a search happens within this code,
5181 save the match data in a special nonrecursive fashion. */
5182 running_asynch_code
= 1;
5184 decode_coding_c_string (coding
, (unsigned char *) chars
, nbytes
, Qt
);
5185 text
= coding
->dst_object
;
5186 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5187 /* A new coding system might be found. */
5188 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5190 p
->decode_coding_system
= Vlast_coding_system_used
;
5192 /* Don't call setup_coding_system for
5193 proc_decode_coding_system[channel] here. It is done in
5194 detect_coding called via decode_coding above. */
5196 /* If a coding system for encoding is not yet decided, we set
5197 it as the same as coding-system for decoding.
5199 But, before doing that we must check if
5200 proc_encode_coding_system[p->outfd] surely points to a
5201 valid memory because p->outfd will be changed once EOF is
5202 sent to the process. */
5203 if (NILP (p
->encode_coding_system
)
5204 && proc_encode_coding_system
[p
->outfd
])
5206 p
->encode_coding_system
5207 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5208 setup_coding_system (p
->encode_coding_system
,
5209 proc_encode_coding_system
[p
->outfd
]);
5213 if (coding
->carryover_bytes
> 0)
5215 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5216 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5217 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5218 coding
->carryover_bytes
);
5219 p
->decoding_carryover
= coding
->carryover_bytes
;
5221 if (SBYTES (text
) > 0)
5222 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5223 sometimes it's simply wrong to wrap (e.g. when called from
5224 accept-process-output). */
5225 internal_condition_case_1 (read_process_output_call
,
5227 Fcons (proc
, Fcons (text
, Qnil
))),
5228 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5229 read_process_output_error_handler
);
5231 /* If we saved the match data nonrecursively, restore it now. */
5232 restore_search_regs ();
5233 running_asynch_code
= outer_running_asynch_code
;
5235 /* Restore waiting_for_user_input_p as it was
5236 when we were called, in case the filter clobbered it. */
5237 waiting_for_user_input_p
= waiting
;
5239 #if 0 /* Call record_asynch_buffer_change unconditionally,
5240 because we might have changed minor modes or other things
5241 that affect key bindings. */
5242 if (! EQ (Fcurrent_buffer (), obuffer
)
5243 || ! EQ (current_buffer
->keymap
, okeymap
))
5245 /* But do it only if the caller is actually going to read events.
5246 Otherwise there's no need to make him wake up, and it could
5247 cause trouble (for example it would make sit_for return). */
5248 if (waiting_for_user_input_p
== -1)
5249 record_asynch_buffer_change ();
5252 /* If no filter, write into buffer if it isn't dead. */
5253 else if (!NILP (p
->buffer
) && !NILP (BVAR (XBUFFER (p
->buffer
), name
)))
5255 Lisp_Object old_read_only
;
5256 EMACS_INT old_begv
, old_zv
;
5257 EMACS_INT old_begv_byte
, old_zv_byte
;
5258 EMACS_INT before
, before_byte
;
5259 EMACS_INT opoint_byte
;
5263 Fset_buffer (p
->buffer
);
5265 opoint_byte
= PT_BYTE
;
5266 old_read_only
= BVAR (current_buffer
, read_only
);
5269 old_begv_byte
= BEGV_BYTE
;
5270 old_zv_byte
= ZV_BYTE
;
5272 BVAR (current_buffer
, read_only
) = Qnil
;
5274 /* Insert new output into buffer
5275 at the current end-of-output marker,
5276 thus preserving logical ordering of input and output. */
5277 if (XMARKER (p
->mark
)->buffer
)
5278 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5279 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5282 SET_PT_BOTH (ZV
, ZV_BYTE
);
5284 before_byte
= PT_BYTE
;
5286 /* If the output marker is outside of the visible region, save
5287 the restriction and widen. */
5288 if (! (BEGV
<= PT
&& PT
<= ZV
))
5291 decode_coding_c_string (coding
, (unsigned char *) chars
, nbytes
, Qt
);
5292 text
= coding
->dst_object
;
5293 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5294 /* A new coding system might be found. See the comment in the
5295 similar code in the previous `if' block. */
5296 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5298 p
->decode_coding_system
= Vlast_coding_system_used
;
5299 if (NILP (p
->encode_coding_system
)
5300 && proc_encode_coding_system
[p
->outfd
])
5302 p
->encode_coding_system
5303 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5304 setup_coding_system (p
->encode_coding_system
,
5305 proc_encode_coding_system
[p
->outfd
]);
5308 if (coding
->carryover_bytes
> 0)
5310 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5311 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5312 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5313 coding
->carryover_bytes
);
5314 p
->decoding_carryover
= coding
->carryover_bytes
;
5316 /* Adjust the multibyteness of TEXT to that of the buffer. */
5317 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
5318 != ! STRING_MULTIBYTE (text
))
5319 text
= (STRING_MULTIBYTE (text
)
5320 ? Fstring_as_unibyte (text
)
5321 : Fstring_to_multibyte (text
));
5322 /* Insert before markers in case we are inserting where
5323 the buffer's mark is, and the user's next command is Meta-y. */
5324 insert_from_string_before_markers (text
, 0, 0,
5325 SCHARS (text
), SBYTES (text
), 0);
5327 /* Make sure the process marker's position is valid when the
5328 process buffer is changed in the signal_after_change above.
5329 W3 is known to do that. */
5330 if (BUFFERP (p
->buffer
)
5331 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5332 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5334 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5336 update_mode_lines
++;
5338 /* Make sure opoint and the old restrictions
5339 float ahead of any new text just as point would. */
5340 if (opoint
>= before
)
5342 opoint
+= PT
- before
;
5343 opoint_byte
+= PT_BYTE
- before_byte
;
5345 if (old_begv
> before
)
5347 old_begv
+= PT
- before
;
5348 old_begv_byte
+= PT_BYTE
- before_byte
;
5350 if (old_zv
>= before
)
5352 old_zv
+= PT
- before
;
5353 old_zv_byte
+= PT_BYTE
- before_byte
;
5356 /* If the restriction isn't what it should be, set it. */
5357 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5358 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5361 BVAR (current_buffer
, read_only
) = old_read_only
;
5362 SET_PT_BOTH (opoint
, opoint_byte
);
5364 /* Handling the process output should not deactivate the mark. */
5365 Vdeactivate_mark
= odeactivate
;
5367 unbind_to (count
, Qnil
);
5371 /* Sending data to subprocess */
5373 static jmp_buf send_process_frame
;
5374 static Lisp_Object process_sent_to
;
5376 #ifndef FORWARD_SIGNAL_TO_MAIN_THREAD
5377 static void send_process_trap (int) NO_RETURN
;
5381 send_process_trap (int ignore
)
5383 SIGNAL_THREAD_CHECK (SIGPIPE
);
5384 sigunblock (sigmask (SIGPIPE
));
5385 longjmp (send_process_frame
, 1);
5388 /* Send some data to process PROC.
5389 BUF is the beginning of the data; LEN is the number of characters.
5390 OBJECT is the Lisp object that the data comes from. If OBJECT is
5391 nil or t, it means that the data comes from C string.
5393 If OBJECT is not nil, the data is encoded by PROC's coding-system
5394 for encoding before it is sent.
5396 This function can evaluate Lisp code and can garbage collect. */
5399 send_process (volatile Lisp_Object proc
, const char *volatile buf
,
5400 volatile EMACS_INT len
, volatile Lisp_Object object
)
5402 /* Use volatile to protect variables from being clobbered by longjmp. */
5403 struct Lisp_Process
*p
= XPROCESS (proc
);
5405 struct coding_system
*coding
;
5406 struct gcpro gcpro1
;
5407 void (*volatile old_sigpipe
) (int);
5411 if (p
->raw_status_new
)
5413 if (! EQ (p
->status
, Qrun
))
5414 error ("Process %s not running", SDATA (p
->name
));
5416 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5418 coding
= proc_encode_coding_system
[p
->outfd
];
5419 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5421 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5422 || (BUFFERP (object
)
5423 && !NILP (BVAR (XBUFFER (object
), enable_multibyte_characters
)))
5426 p
->encode_coding_system
5427 = complement_process_encoding_system (p
->encode_coding_system
);
5428 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
5430 /* The coding system for encoding was changed to raw-text
5431 because we sent a unibyte text previously. Now we are
5432 sending a multibyte text, thus we must encode it by the
5433 original coding system specified for the current process.
5435 Another reason we come here is that the coding system
5436 was just complemented and a new one was returned by
5437 complement_process_encoding_system. */
5438 setup_coding_system (p
->encode_coding_system
, coding
);
5439 Vlast_coding_system_used
= p
->encode_coding_system
;
5441 coding
->src_multibyte
= 1;
5445 coding
->src_multibyte
= 0;
5446 /* For sending a unibyte text, character code conversion should
5447 not take place but EOL conversion should. So, setup raw-text
5448 or one of the subsidiary if we have not yet done it. */
5449 if (CODING_REQUIRE_ENCODING (coding
))
5451 if (CODING_REQUIRE_FLUSHING (coding
))
5453 /* But, before changing the coding, we must flush out data. */
5454 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5455 send_process (proc
, "", 0, Qt
);
5456 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
5458 setup_coding_system (raw_text_coding_system
5459 (Vlast_coding_system_used
),
5461 coding
->src_multibyte
= 0;
5464 coding
->dst_multibyte
= 0;
5466 if (CODING_REQUIRE_ENCODING (coding
))
5468 coding
->dst_object
= Qt
;
5469 if (BUFFERP (object
))
5471 EMACS_INT from_byte
, from
, to
;
5472 EMACS_INT save_pt
, save_pt_byte
;
5473 struct buffer
*cur
= current_buffer
;
5475 set_buffer_internal (XBUFFER (object
));
5476 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
5478 from_byte
= PTR_BYTE_POS ((unsigned char *) buf
);
5479 from
= BYTE_TO_CHAR (from_byte
);
5480 to
= BYTE_TO_CHAR (from_byte
+ len
);
5481 TEMP_SET_PT_BOTH (from
, from_byte
);
5482 encode_coding_object (coding
, object
, from
, from_byte
,
5483 to
, from_byte
+ len
, Qt
);
5484 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
5485 set_buffer_internal (cur
);
5487 else if (STRINGP (object
))
5489 encode_coding_object (coding
, object
, 0, 0, SCHARS (object
),
5490 SBYTES (object
), Qt
);
5494 coding
->dst_object
= make_unibyte_string (buf
, len
);
5495 coding
->produced
= len
;
5498 len
= coding
->produced
;
5499 object
= coding
->dst_object
;
5500 buf
= SSDATA (object
);
5503 if (pty_max_bytes
== 0)
5505 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5506 pty_max_bytes
= fpathconf (p
->outfd
, _PC_MAX_CANON
);
5507 if (pty_max_bytes
< 0)
5508 pty_max_bytes
= 250;
5510 pty_max_bytes
= 250;
5512 /* Deduct one, to leave space for the eof. */
5516 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5517 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5518 when returning with longjmp despite being declared volatile. */
5519 if (!setjmp (send_process_frame
))
5521 p
= XPROCESS (proc
); /* Repair any setjmp clobbering. */
5523 process_sent_to
= proc
;
5526 EMACS_INT
this = len
;
5528 /* Send this batch, using one or more write calls. */
5531 EMACS_INT written
= 0;
5532 int outfd
= p
->outfd
;
5533 old_sigpipe
= (void (*) (int)) signal (SIGPIPE
, send_process_trap
);
5534 #ifdef DATAGRAM_SOCKETS
5535 if (DATAGRAM_CHAN_P (outfd
))
5537 rv
= sendto (outfd
, buf
, this,
5538 0, datagram_address
[outfd
].sa
,
5539 datagram_address
[outfd
].len
);
5542 else if (errno
== EMSGSIZE
)
5544 signal (SIGPIPE
, old_sigpipe
);
5545 report_file_error ("sending datagram",
5546 Fcons (proc
, Qnil
));
5554 written
= emacs_gnutls_write (p
, buf
, this);
5557 written
= emacs_write (outfd
, buf
, this);
5558 rv
= (written
? 0 : -1);
5559 #ifdef ADAPTIVE_READ_BUFFERING
5560 if (p
->read_output_delay
> 0
5561 && p
->adaptive_read_buffering
== 1)
5563 p
->read_output_delay
= 0;
5564 process_output_delay_count
--;
5565 p
->read_output_skip
= 0;
5569 signal (SIGPIPE
, old_sigpipe
);
5575 || errno
== EWOULDBLOCK
5581 /* Buffer is full. Wait, accepting input;
5582 that may allow the program
5583 to finish doing output and read more. */
5585 EMACS_INT offset
= 0;
5587 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5588 /* A gross hack to work around a bug in FreeBSD.
5589 In the following sequence, read(2) returns
5593 write(2) 954 bytes, get EAGAIN
5594 read(2) 1024 bytes in process_read_output
5595 read(2) 11 bytes in process_read_output
5597 That is, read(2) returns more bytes than have
5598 ever been written successfully. The 1033 bytes
5599 read are the 1022 bytes written successfully
5600 after processing (for example with CRs added if
5601 the terminal is set up that way which it is
5602 here). The same bytes will be seen again in a
5603 later read(2), without the CRs. */
5605 if (errno
== EAGAIN
)
5608 ioctl (p
->outfd
, TIOCFLUSH
, &flags
);
5610 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5612 /* Running filters might relocate buffers or strings.
5613 Arrange to relocate BUF. */
5614 if (BUFFERP (object
))
5615 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
),
5616 (unsigned char *) buf
);
5617 else if (STRINGP (object
))
5618 offset
= buf
- SSDATA (object
);
5620 #ifdef EMACS_HAS_USECS
5621 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5623 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5626 if (BUFFERP (object
))
5627 buf
= (char *) BUF_BYTE_ADDRESS (XBUFFER (object
),
5629 else if (STRINGP (object
))
5630 buf
= offset
+ SSDATA (object
);
5633 /* This is a real error. */
5634 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5644 signal (SIGPIPE
, old_sigpipe
);
5645 proc
= process_sent_to
;
5646 p
= XPROCESS (proc
);
5647 p
->raw_status_new
= 0;
5648 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5649 p
->tick
= ++process_tick
;
5650 deactivate_process (proc
);
5651 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5657 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5659 doc
: /* Send current contents of region as input to PROCESS.
5660 PROCESS may be a process, a buffer, the name of a process or buffer, or
5661 nil, indicating the current buffer's process.
5662 Called from program, takes three arguments, PROCESS, START and END.
5663 If the region is more than 500 characters long,
5664 it is sent in several bunches. This may happen even for shorter regions.
5665 Output from processes can arrive in between bunches. */)
5666 (Lisp_Object process
, Lisp_Object start
, Lisp_Object end
)
5669 EMACS_INT start1
, end1
;
5671 proc
= get_process (process
);
5672 validate_region (&start
, &end
);
5674 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5675 move_gap (XINT (start
));
5677 start1
= CHAR_TO_BYTE (XINT (start
));
5678 end1
= CHAR_TO_BYTE (XINT (end
));
5679 send_process (proc
, (char *) BYTE_POS_ADDR (start1
), end1
- start1
,
5680 Fcurrent_buffer ());
5685 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5687 doc
: /* Send PROCESS the contents of STRING as input.
5688 PROCESS may be a process, a buffer, the name of a process or buffer, or
5689 nil, indicating the current buffer's process.
5690 If STRING is more than 500 characters long,
5691 it is sent in several bunches. This may happen even for shorter strings.
5692 Output from processes can arrive in between bunches. */)
5693 (Lisp_Object process
, Lisp_Object string
)
5696 CHECK_STRING (string
);
5697 proc
= get_process (process
);
5698 send_process (proc
, SSDATA (string
),
5699 SBYTES (string
), string
);
5703 /* Return the foreground process group for the tty/pty that
5704 the process P uses. */
5706 emacs_get_tty_pgrp (struct Lisp_Process
*p
)
5711 if (ioctl (p
->infd
, TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5714 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5715 master side. Try the slave side. */
5716 fd
= emacs_open (SSDATA (p
->tty_name
), O_RDONLY
, 0);
5720 ioctl (fd
, TIOCGPGRP
, &gid
);
5724 #endif /* defined (TIOCGPGRP ) */
5729 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5730 Sprocess_running_child_p
, 0, 1, 0,
5731 doc
: /* Return t if PROCESS has given the terminal to a child.
5732 If the operating system does not make it possible to find out,
5733 return t unconditionally. */)
5734 (Lisp_Object process
)
5736 /* Initialize in case ioctl doesn't exist or gives an error,
5737 in a way that will cause returning t. */
5740 struct Lisp_Process
*p
;
5742 proc
= get_process (process
);
5743 p
= XPROCESS (proc
);
5745 if (!EQ (p
->type
, Qreal
))
5746 error ("Process %s is not a subprocess",
5749 error ("Process %s is not active",
5752 gid
= emacs_get_tty_pgrp (p
);
5759 /* send a signal number SIGNO to PROCESS.
5760 If CURRENT_GROUP is t, that means send to the process group
5761 that currently owns the terminal being used to communicate with PROCESS.
5762 This is used for various commands in shell mode.
5763 If CURRENT_GROUP is lambda, that means send to the process group
5764 that currently owns the terminal, but only if it is NOT the shell itself.
5766 If NOMSG is zero, insert signal-announcements into process's buffers
5769 If we can, we try to signal PROCESS by sending control characters
5770 down the pty. This allows us to signal inferiors who have changed
5771 their uid, for which killpg would return an EPERM error. */
5774 process_send_signal (Lisp_Object process
, int signo
, Lisp_Object current_group
,
5778 register struct Lisp_Process
*p
;
5782 proc
= get_process (process
);
5783 p
= XPROCESS (proc
);
5785 if (!EQ (p
->type
, Qreal
))
5786 error ("Process %s is not a subprocess",
5789 error ("Process %s is not active",
5793 current_group
= Qnil
;
5795 /* If we are using pgrps, get a pgrp number and make it negative. */
5796 if (NILP (current_group
))
5797 /* Send the signal to the shell's process group. */
5801 #ifdef SIGNALS_VIA_CHARACTERS
5802 /* If possible, send signals to the entire pgrp
5803 by sending an input character to it. */
5806 cc_t
*sig_char
= NULL
;
5808 tcgetattr (p
->infd
, &t
);
5813 sig_char
= &t
.c_cc
[VINTR
];
5817 sig_char
= &t
.c_cc
[VQUIT
];
5821 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5822 sig_char
= &t
.c_cc
[VSWTCH
];
5824 sig_char
= &t
.c_cc
[VSUSP
];
5829 if (sig_char
&& *sig_char
!= CDISABLE
)
5831 send_process (proc
, (char *) sig_char
, 1, Qnil
);
5834 /* If we can't send the signal with a character,
5835 fall through and send it another way. */
5837 /* The code above may fall through if it can't
5838 handle the signal. */
5839 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5842 /* Get the current pgrp using the tty itself, if we have that.
5843 Otherwise, use the pty to get the pgrp.
5844 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5845 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5846 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5847 His patch indicates that if TIOCGPGRP returns an error, then
5848 we should just assume that p->pid is also the process group id. */
5850 gid
= emacs_get_tty_pgrp (p
);
5853 /* If we can't get the information, assume
5854 the shell owns the tty. */
5857 /* It is not clear whether anything really can set GID to -1.
5858 Perhaps on some system one of those ioctls can or could do so.
5859 Or perhaps this is vestigial. */
5862 #else /* ! defined (TIOCGPGRP ) */
5863 /* Can't select pgrps on this system, so we know that
5864 the child itself heads the pgrp. */
5866 #endif /* ! defined (TIOCGPGRP ) */
5868 /* If current_group is lambda, and the shell owns the terminal,
5869 don't send any signal. */
5870 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
5878 p
->raw_status_new
= 0;
5880 p
->tick
= ++process_tick
;
5883 status_notify (NULL
);
5884 redisplay_preserve_echo_area (13);
5887 #endif /* ! defined (SIGCONT) */
5891 flush_pending_output (p
->infd
);
5895 /* If we don't have process groups, send the signal to the immediate
5896 subprocess. That isn't really right, but it's better than any
5897 obvious alternative. */
5900 kill (p
->pid
, signo
);
5904 /* gid may be a pid, or minus a pgrp's number */
5906 if (!NILP (current_group
))
5908 if (ioctl (p
->infd
, TIOCSIGSEND
, signo
) == -1)
5909 EMACS_KILLPG (gid
, signo
);
5916 #else /* ! defined (TIOCSIGSEND) */
5917 EMACS_KILLPG (gid
, signo
);
5918 #endif /* ! defined (TIOCSIGSEND) */
5921 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5922 doc
: /* Interrupt process PROCESS.
5923 PROCESS may be a process, a buffer, or the name of a process or buffer.
5924 No arg or nil means current buffer's process.
5925 Second arg CURRENT-GROUP non-nil means send signal to
5926 the current process-group of the process's controlling terminal
5927 rather than to the process's own process group.
5928 If the process is a shell, this means interrupt current subjob
5929 rather than the shell.
5931 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5932 don't send the signal. */)
5933 (Lisp_Object process
, Lisp_Object current_group
)
5935 process_send_signal (process
, SIGINT
, current_group
, 0);
5939 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5940 doc
: /* Kill process PROCESS. May be process or name of one.
5941 See function `interrupt-process' for more details on usage. */)
5942 (Lisp_Object process
, Lisp_Object current_group
)
5944 process_send_signal (process
, SIGKILL
, current_group
, 0);
5948 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5949 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5950 See function `interrupt-process' for more details on usage. */)
5951 (Lisp_Object process
, Lisp_Object current_group
)
5953 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5957 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5958 doc
: /* Stop process PROCESS. May be process or name of one.
5959 See function `interrupt-process' for more details on usage.
5960 If PROCESS is a network or serial process, inhibit handling of incoming
5962 (Lisp_Object process
, Lisp_Object current_group
)
5964 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
5966 struct Lisp_Process
*p
;
5968 p
= XPROCESS (process
);
5969 if (NILP (p
->command
)
5972 FD_CLR (p
->infd
, &input_wait_mask
);
5973 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
5979 error ("No SIGTSTP support");
5981 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5986 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5987 doc
: /* Continue process PROCESS. May be process or name of one.
5988 See function `interrupt-process' for more details on usage.
5989 If PROCESS is a network or serial process, resume handling of incoming
5991 (Lisp_Object process
, Lisp_Object current_group
)
5993 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
5995 struct Lisp_Process
*p
;
5997 p
= XPROCESS (process
);
5998 if (EQ (p
->command
, Qt
)
6000 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6002 FD_SET (p
->infd
, &input_wait_mask
);
6003 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
6005 if (fd_info
[ p
->infd
].flags
& FILE_SERIAL
)
6006 PurgeComm (fd_info
[ p
->infd
].hnd
, PURGE_RXABORT
| PURGE_RXCLEAR
);
6007 #else /* not WINDOWSNT */
6008 tcflush (p
->infd
, TCIFLUSH
);
6009 #endif /* not WINDOWSNT */
6015 process_send_signal (process
, SIGCONT
, current_group
, 0);
6017 error ("No SIGCONT support");
6022 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6023 2, 2, "sProcess (name or number): \nnSignal code: ",
6024 doc
: /* Send PROCESS the signal with code SIGCODE.
6025 PROCESS may also be a number specifying the process id of the
6026 process to signal; in this case, the process need not be a child of
6028 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6029 (Lisp_Object process
, Lisp_Object sigcode
)
6033 if (INTEGERP (process
))
6035 pid
= XINT (process
);
6039 if (FLOATP (process
))
6041 pid
= (pid_t
) XFLOAT_DATA (process
);
6045 if (STRINGP (process
))
6048 if (tem
= Fget_process (process
), NILP (tem
))
6050 pid
= XINT (Fstring_to_number (process
, make_number (10)));
6057 process
= get_process (process
);
6062 CHECK_PROCESS (process
);
6063 pid
= XPROCESS (process
)->pid
;
6065 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6069 #define parse_signal(NAME, VALUE) \
6070 else if (!xstrcasecmp (name, NAME)) \
6071 XSETINT (sigcode, VALUE)
6073 if (INTEGERP (sigcode
))
6079 CHECK_SYMBOL (sigcode
);
6080 name
= SSDATA (SYMBOL_NAME (sigcode
));
6082 if (!strncmp (name
, "SIG", 3) || !strncmp (name
, "sig", 3))
6088 parse_signal ("usr1", SIGUSR1
);
6091 parse_signal ("usr2", SIGUSR2
);
6094 parse_signal ("term", SIGTERM
);
6097 parse_signal ("hup", SIGHUP
);
6100 parse_signal ("int", SIGINT
);
6103 parse_signal ("quit", SIGQUIT
);
6106 parse_signal ("ill", SIGILL
);
6109 parse_signal ("abrt", SIGABRT
);
6112 parse_signal ("emt", SIGEMT
);
6115 parse_signal ("kill", SIGKILL
);
6118 parse_signal ("fpe", SIGFPE
);
6121 parse_signal ("bus", SIGBUS
);
6124 parse_signal ("segv", SIGSEGV
);
6127 parse_signal ("sys", SIGSYS
);
6130 parse_signal ("pipe", SIGPIPE
);
6133 parse_signal ("alrm", SIGALRM
);
6136 parse_signal ("urg", SIGURG
);
6139 parse_signal ("stop", SIGSTOP
);
6142 parse_signal ("tstp", SIGTSTP
);
6145 parse_signal ("cont", SIGCONT
);
6148 parse_signal ("chld", SIGCHLD
);
6151 parse_signal ("ttin", SIGTTIN
);
6154 parse_signal ("ttou", SIGTTOU
);
6157 parse_signal ("io", SIGIO
);
6160 parse_signal ("xcpu", SIGXCPU
);
6163 parse_signal ("xfsz", SIGXFSZ
);
6166 parse_signal ("vtalrm", SIGVTALRM
);
6169 parse_signal ("prof", SIGPROF
);
6172 parse_signal ("winch", SIGWINCH
);
6175 parse_signal ("info", SIGINFO
);
6178 error ("Undefined signal name %s", name
);
6183 return make_number (kill (pid
, XINT (sigcode
)));
6186 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6187 doc
: /* Make PROCESS see end-of-file in its input.
6188 EOF comes after any text already sent to it.
6189 PROCESS may be a process, a buffer, the name of a process or buffer, or
6190 nil, indicating the current buffer's process.
6191 If PROCESS is a network connection, or is a process communicating
6192 through a pipe (as opposed to a pty), then you cannot send any more
6193 text to PROCESS after you call this function.
6194 If PROCESS is a serial process, wait until all output written to the
6195 process has been transmitted to the serial port. */)
6196 (Lisp_Object process
)
6199 struct coding_system
*coding
;
6201 if (DATAGRAM_CONN_P (process
))
6204 proc
= get_process (process
);
6205 coding
= proc_encode_coding_system
[XPROCESS (proc
)->outfd
];
6207 /* Make sure the process is really alive. */
6208 if (XPROCESS (proc
)->raw_status_new
)
6209 update_status (XPROCESS (proc
));
6210 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6211 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6213 if (CODING_REQUIRE_FLUSHING (coding
))
6215 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6216 send_process (proc
, "", 0, Qnil
);
6219 if (XPROCESS (proc
)->pty_flag
)
6220 send_process (proc
, "\004", 1, Qnil
);
6221 else if (EQ (XPROCESS (proc
)->type
, Qserial
))
6224 if (tcdrain (XPROCESS (proc
)->outfd
) != 0)
6225 error ("tcdrain() failed: %s", emacs_strerror (errno
));
6226 #endif /* not WINDOWSNT */
6227 /* Do nothing on Windows because writes are blocking. */
6231 int old_outfd
, new_outfd
;
6233 #ifdef HAVE_SHUTDOWN
6234 /* If this is a network connection, or socketpair is used
6235 for communication with the subprocess, call shutdown to cause EOF.
6236 (In some old system, shutdown to socketpair doesn't work.
6237 Then we just can't win.) */
6238 if (EQ (XPROCESS (proc
)->type
, Qnetwork
)
6239 || XPROCESS (proc
)->outfd
== XPROCESS (proc
)->infd
)
6240 shutdown (XPROCESS (proc
)->outfd
, 1);
6241 /* In case of socketpair, outfd == infd, so don't close it. */
6242 if (XPROCESS (proc
)->outfd
!= XPROCESS (proc
)->infd
)
6243 emacs_close (XPROCESS (proc
)->outfd
);
6244 #else /* not HAVE_SHUTDOWN */
6245 emacs_close (XPROCESS (proc
)->outfd
);
6246 #endif /* not HAVE_SHUTDOWN */
6247 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6250 old_outfd
= XPROCESS (proc
)->outfd
;
6252 if (!proc_encode_coding_system
[new_outfd
])
6253 proc_encode_coding_system
[new_outfd
]
6254 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6255 memcpy (proc_encode_coding_system
[new_outfd
],
6256 proc_encode_coding_system
[old_outfd
],
6257 sizeof (struct coding_system
));
6258 memset (proc_encode_coding_system
[old_outfd
], 0,
6259 sizeof (struct coding_system
));
6261 XPROCESS (proc
)->outfd
= new_outfd
;
6266 /* On receipt of a signal that a child status has changed, loop asking
6267 about children with changed statuses until the system says there
6270 All we do is change the status; we do not run sentinels or print
6271 notifications. That is saved for the next time keyboard input is
6272 done, in order to avoid timing errors.
6274 ** WARNING: this can be called during garbage collection.
6275 Therefore, it must not be fooled by the presence of mark bits in
6278 ** USG WARNING: Although it is not obvious from the documentation
6279 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6280 signal() before executing at least one wait(), otherwise the
6281 handler will be called again, resulting in an infinite loop. The
6282 relevant portion of the documentation reads "SIGCLD signals will be
6283 queued and the signal-catching function will be continually
6284 reentered until the queue is empty". Invoking signal() causes the
6285 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6288 ** Malloc WARNING: This should never call malloc either directly or
6289 indirectly; if it does, that is a bug */
6293 sigchld_handler (int signo
)
6295 int old_errno
= errno
;
6297 struct Lisp_Process
*p
;
6299 SIGNAL_THREAD_CHECK (signo
);
6310 #endif /* no WUNTRACED */
6311 /* Keep trying to get a status until we get a definitive result. */
6315 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6317 while (pid
< 0 && errno
== EINTR
);
6321 /* PID == 0 means no processes found, PID == -1 means a real
6322 failure. We have done all our job, so return. */
6329 #endif /* no WNOHANG */
6331 /* Find the process that signaled us, and record its status. */
6333 /* The process can have been deleted by Fdelete_process. */
6334 for (tail
= deleted_pid_list
; CONSP (tail
); tail
= XCDR (tail
))
6336 Lisp_Object xpid
= XCAR (tail
);
6337 if ((INTEGERP (xpid
) && pid
== (pid_t
) XINT (xpid
))
6338 || (FLOATP (xpid
) && pid
== (pid_t
) XFLOAT_DATA (xpid
)))
6340 XSETCAR (tail
, Qnil
);
6341 goto sigchld_end_of_loop
;
6345 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6347 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6349 proc
= XCDR (XCAR (tail
));
6350 p
= XPROCESS (proc
);
6351 if (EQ (p
->type
, Qreal
) && p
->pid
== pid
)
6356 /* Look for an asynchronous process whose pid hasn't been filled
6359 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6361 proc
= XCDR (XCAR (tail
));
6362 p
= XPROCESS (proc
);
6368 /* Change the status of the process that was found. */
6371 int clear_desc_flag
= 0;
6373 p
->tick
= ++process_tick
;
6375 p
->raw_status_new
= 1;
6377 /* If process has terminated, stop waiting for its output. */
6378 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6380 clear_desc_flag
= 1;
6382 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6383 if (clear_desc_flag
)
6385 FD_CLR (p
->infd
, &input_wait_mask
);
6386 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6389 /* Tell wait_reading_process_output that it needs to wake up and
6391 if (input_available_clear_time
)
6392 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6395 /* There was no asynchronous process found for that pid: we have
6396 a synchronous process. */
6399 synch_process_alive
= 0;
6401 /* Report the status of the synchronous process. */
6403 synch_process_retcode
= WRETCODE (w
);
6404 else if (WIFSIGNALED (w
))
6405 synch_process_termsig
= WTERMSIG (w
);
6407 /* Tell wait_reading_process_output that it needs to wake up and
6409 if (input_available_clear_time
)
6410 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6413 sigchld_end_of_loop
:
6416 /* On some systems, we must return right away.
6417 If any more processes want to signal us, we will
6419 Otherwise (on systems that have WNOHANG), loop around
6420 to use up all the processes that have something to tell us. */
6421 #if (defined WINDOWSNT \
6422 || (defined USG && !defined GNU_LINUX \
6423 && !(defined HPUX && defined WNOHANG)))
6426 #endif /* USG, but not HPUX with WNOHANG */
6429 #endif /* SIGCHLD */
6433 exec_sentinel_unwind (Lisp_Object data
)
6435 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6440 exec_sentinel_error_handler (Lisp_Object error_val
)
6442 cmd_error_internal (error_val
, "error in process sentinel: ");
6444 update_echo_area ();
6445 Fsleep_for (make_number (2), Qnil
);
6450 exec_sentinel (Lisp_Object proc
, Lisp_Object reason
)
6452 Lisp_Object sentinel
, odeactivate
;
6453 register struct Lisp_Process
*p
= XPROCESS (proc
);
6454 int count
= SPECPDL_INDEX ();
6455 int outer_running_asynch_code
= running_asynch_code
;
6456 int waiting
= waiting_for_user_input_p
;
6458 if (inhibit_sentinels
)
6461 /* No need to gcpro these, because all we do with them later
6462 is test them for EQness, and none of them should be a string. */
6463 odeactivate
= Vdeactivate_mark
;
6465 Lisp_Object obuffer
, okeymap
;
6466 XSETBUFFER (obuffer
, current_buffer
);
6467 okeymap
= BVAR (current_buffer
, keymap
);
6470 /* There's no good reason to let sentinels change the current
6471 buffer, and many callers of accept-process-output, sit-for, and
6472 friends don't expect current-buffer to be changed from under them. */
6473 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
6475 sentinel
= p
->sentinel
;
6476 if (NILP (sentinel
))
6479 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6480 assure that it gets restored no matter how the sentinel exits. */
6482 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6483 /* Inhibit quit so that random quits don't screw up a running filter. */
6484 specbind (Qinhibit_quit
, Qt
);
6485 specbind (Qlast_nonmenu_event
, Qt
); /* Why? --Stef */
6487 /* In case we get recursively called,
6488 and we already saved the match data nonrecursively,
6489 save the same match data in safely recursive fashion. */
6490 if (outer_running_asynch_code
)
6493 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6494 restore_search_regs ();
6495 record_unwind_save_match_data ();
6496 Fset_match_data (tem
, Qt
);
6499 /* For speed, if a search happens within this code,
6500 save the match data in a special nonrecursive fashion. */
6501 running_asynch_code
= 1;
6503 internal_condition_case_1 (read_process_output_call
,
6505 Fcons (proc
, Fcons (reason
, Qnil
))),
6506 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6507 exec_sentinel_error_handler
);
6509 /* If we saved the match data nonrecursively, restore it now. */
6510 restore_search_regs ();
6511 running_asynch_code
= outer_running_asynch_code
;
6513 Vdeactivate_mark
= odeactivate
;
6515 /* Restore waiting_for_user_input_p as it was
6516 when we were called, in case the filter clobbered it. */
6517 waiting_for_user_input_p
= waiting
;
6520 if (! EQ (Fcurrent_buffer (), obuffer
)
6521 || ! EQ (current_buffer
->keymap
, okeymap
))
6523 /* But do it only if the caller is actually going to read events.
6524 Otherwise there's no need to make him wake up, and it could
6525 cause trouble (for example it would make sit_for return). */
6526 if (waiting_for_user_input_p
== -1)
6527 record_asynch_buffer_change ();
6529 unbind_to (count
, Qnil
);
6532 /* Report all recent events of a change in process status
6533 (either run the sentinel or output a message).
6534 This is usually done while Emacs is waiting for keyboard input
6535 but can be done at other times. */
6538 status_notify (struct Lisp_Process
*deleting_process
)
6540 register Lisp_Object proc
, buffer
;
6541 Lisp_Object tail
, msg
;
6542 struct gcpro gcpro1
, gcpro2
;
6546 /* We need to gcpro tail; if read_process_output calls a filter
6547 which deletes a process and removes the cons to which tail points
6548 from Vprocess_alist, and then causes a GC, tail is an unprotected
6552 /* Set this now, so that if new processes are created by sentinels
6553 that we run, we get called again to handle their status changes. */
6554 update_tick
= process_tick
;
6556 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6559 register struct Lisp_Process
*p
;
6561 proc
= Fcdr (XCAR (tail
));
6562 p
= XPROCESS (proc
);
6564 if (p
->tick
!= p
->update_tick
)
6566 p
->update_tick
= p
->tick
;
6568 /* If process is still active, read any output that remains. */
6569 while (! EQ (p
->filter
, Qt
)
6570 && ! EQ (p
->status
, Qconnect
)
6571 && ! EQ (p
->status
, Qlisten
)
6572 /* Network or serial process not stopped: */
6573 && ! EQ (p
->command
, Qt
)
6575 && p
!= deleting_process
6576 && read_process_output (proc
, p
->infd
) > 0);
6580 /* Get the text to use for the message. */
6581 if (p
->raw_status_new
)
6583 msg
= status_message (p
);
6585 /* If process is terminated, deactivate it or delete it. */
6587 if (CONSP (p
->status
))
6588 symbol
= XCAR (p
->status
);
6590 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6591 || EQ (symbol
, Qclosed
))
6593 if (delete_exited_processes
)
6594 remove_process (proc
);
6596 deactivate_process (proc
);
6599 /* The actions above may have further incremented p->tick.
6600 So set p->update_tick again
6601 so that an error in the sentinel will not cause
6602 this code to be run again. */
6603 p
->update_tick
= p
->tick
;
6604 /* Now output the message suitably. */
6605 if (!NILP (p
->sentinel
))
6606 exec_sentinel (proc
, msg
);
6607 /* Don't bother with a message in the buffer
6608 when a process becomes runnable. */
6609 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6612 struct buffer
*old
= current_buffer
;
6613 EMACS_INT opoint
, opoint_byte
;
6614 EMACS_INT before
, before_byte
;
6616 /* Avoid error if buffer is deleted
6617 (probably that's why the process is dead, too) */
6618 if (NILP (BVAR (XBUFFER (buffer
), name
)))
6620 Fset_buffer (buffer
);
6623 opoint_byte
= PT_BYTE
;
6624 /* Insert new output into buffer
6625 at the current end-of-output marker,
6626 thus preserving logical ordering of input and output. */
6627 if (XMARKER (p
->mark
)->buffer
)
6628 Fgoto_char (p
->mark
);
6630 SET_PT_BOTH (ZV
, ZV_BYTE
);
6633 before_byte
= PT_BYTE
;
6635 tem
= BVAR (current_buffer
, read_only
);
6636 BVAR (current_buffer
, read_only
) = Qnil
;
6637 insert_string ("\nProcess ");
6638 Finsert (1, &p
->name
);
6639 insert_string (" ");
6641 BVAR (current_buffer
, read_only
) = tem
;
6642 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6644 if (opoint
>= before
)
6645 SET_PT_BOTH (opoint
+ (PT
- before
),
6646 opoint_byte
+ (PT_BYTE
- before_byte
));
6648 SET_PT_BOTH (opoint
, opoint_byte
);
6650 set_buffer_internal (old
);
6655 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6660 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6661 Sset_process_coding_system
, 1, 3, 0,
6662 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6663 DECODING will be used to decode subprocess output and ENCODING to
6664 encode subprocess input. */)
6665 (register Lisp_Object process
, Lisp_Object decoding
, Lisp_Object encoding
)
6667 register struct Lisp_Process
*p
;
6669 CHECK_PROCESS (process
);
6670 p
= XPROCESS (process
);
6672 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6674 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6675 Fcheck_coding_system (decoding
);
6676 Fcheck_coding_system (encoding
);
6677 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
6678 p
->decode_coding_system
= decoding
;
6679 p
->encode_coding_system
= encoding
;
6680 setup_process_coding_systems (process
);
6685 DEFUN ("process-coding-system",
6686 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6687 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6688 (register Lisp_Object process
)
6690 CHECK_PROCESS (process
);
6691 return Fcons (XPROCESS (process
)->decode_coding_system
,
6692 XPROCESS (process
)->encode_coding_system
);
6695 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6696 Sset_process_filter_multibyte
, 2, 2, 0,
6697 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6698 If FLAG is non-nil, the filter is given multibyte strings.
6699 If FLAG is nil, the filter is given unibyte strings. In this case,
6700 all character code conversion except for end-of-line conversion is
6702 (Lisp_Object process
, Lisp_Object flag
)
6704 register struct Lisp_Process
*p
;
6706 CHECK_PROCESS (process
);
6707 p
= XPROCESS (process
);
6709 p
->decode_coding_system
= raw_text_coding_system (p
->decode_coding_system
);
6710 setup_process_coding_systems (process
);
6715 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6716 Sprocess_filter_multibyte_p
, 1, 1, 0,
6717 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6718 (Lisp_Object process
)
6720 register struct Lisp_Process
*p
;
6721 struct coding_system
*coding
;
6723 CHECK_PROCESS (process
);
6724 p
= XPROCESS (process
);
6725 coding
= proc_decode_coding_system
[p
->infd
];
6726 return (CODING_FOR_UNIBYTE (coding
) ? Qnil
: Qt
);
6735 add_gpm_wait_descriptor (int desc
)
6737 add_keyboard_wait_descriptor (desc
);
6741 delete_gpm_wait_descriptor (int desc
)
6743 delete_keyboard_wait_descriptor (desc
);
6750 /* Return nonzero if *MASK has a bit set
6751 that corresponds to one of the keyboard input descriptors. */
6754 keyboard_bit_set (fd_set
*mask
)
6758 for (fd
= 0; fd
<= max_input_desc
; fd
++)
6759 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6760 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6767 #else /* not subprocesses */
6769 /* Defined on msdos.c. */
6770 extern int sys_select (int, SELECT_TYPE
*, SELECT_TYPE
*, SELECT_TYPE
*,
6773 /* Implementation of wait_reading_process_output, assuming that there
6774 are no subprocesses. Used only by the MS-DOS build.
6776 Wait for timeout to elapse and/or keyboard input to be available.
6779 timeout in seconds, or
6780 zero for no limit, or
6781 -1 means gobble data immediately available but don't wait for any.
6783 read_kbd is a Lisp_Object:
6784 0 to ignore keyboard input, or
6785 1 to return when input is available, or
6786 -1 means caller will actually read the input, so don't throw to
6789 see full version for other parameters. We know that wait_proc will
6790 always be NULL, since `subprocesses' isn't defined.
6792 do_display != 0 means redisplay should be done to show subprocess
6793 output that arrives.
6795 Return true if we received input from any process. */
6798 wait_reading_process_output (int time_limit
, int microsecs
, int read_kbd
,
6800 Lisp_Object wait_for_cell
,
6801 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
6804 EMACS_TIME end_time
, timeout
;
6805 SELECT_TYPE waitchannels
;
6808 /* What does time_limit really mean? */
6809 if (time_limit
|| microsecs
)
6811 EMACS_GET_TIME (end_time
);
6812 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
6813 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
6816 /* Turn off periodic alarms (in case they are in use)
6817 and then turn off any other atimers,
6818 because the select emulator uses alarms. */
6820 turn_on_atimers (0);
6824 int timeout_reduced_for_timers
= 0;
6826 /* If calling from keyboard input, do not quit
6827 since we want to return C-g as an input character.
6828 Otherwise, do pending quit if requested. */
6832 /* Exit now if the cell we're waiting for became non-nil. */
6833 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6836 /* Compute time from now till when time limit is up */
6837 /* Exit if already run out */
6838 if (time_limit
== -1)
6840 /* -1 specified for timeout means
6841 gobble output available now
6842 but don't wait at all. */
6844 EMACS_SET_SECS_USECS (timeout
, 0, 0);
6846 else if (time_limit
|| microsecs
)
6848 EMACS_GET_TIME (timeout
);
6849 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
6850 if (EMACS_TIME_NEG_P (timeout
))
6855 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
6858 /* If our caller will not immediately handle keyboard events,
6859 run timer events directly.
6860 (Callers that will immediately read keyboard events
6861 call timer_delay on their own.) */
6862 if (NILP (wait_for_cell
))
6864 EMACS_TIME timer_delay
;
6868 int old_timers_run
= timers_run
;
6869 timer_delay
= timer_check ();
6870 if (timers_run
!= old_timers_run
&& do_display
)
6871 /* We must retry, since a timer may have requeued itself
6872 and that could alter the time delay. */
6873 redisplay_preserve_echo_area (14);
6877 while (!detect_input_pending ());
6879 /* If there is unread keyboard input, also return. */
6881 && requeued_events_pending_p ())
6884 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
6886 EMACS_TIME difference
;
6887 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
6888 if (EMACS_TIME_NEG_P (difference
))
6890 timeout
= timer_delay
;
6891 timeout_reduced_for_timers
= 1;
6896 /* Cause C-g and alarm signals to take immediate action,
6897 and cause input available signals to zero out timeout. */
6899 set_waiting_for_input (&timeout
);
6901 /* Wait till there is something to do. */
6903 if (! read_kbd
&& NILP (wait_for_cell
))
6904 FD_ZERO (&waitchannels
);
6906 FD_SET (0, &waitchannels
);
6908 /* If a frame has been newly mapped and needs updating,
6909 reprocess its display stuff. */
6910 if (frame_garbaged
&& do_display
)
6912 clear_waiting_for_input ();
6913 redisplay_preserve_echo_area (15);
6915 set_waiting_for_input (&timeout
);
6918 if (read_kbd
&& detect_input_pending ())
6921 FD_ZERO (&waitchannels
);
6924 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
6929 /* Make C-g and alarm signals set flags again */
6930 clear_waiting_for_input ();
6932 /* If we woke up due to SIGWINCH, actually change size now. */
6933 do_pending_window_change (0);
6935 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
6936 /* We waited the full specified time, so return now. */
6941 /* If the system call was interrupted, then go around the
6943 if (xerrno
== EINTR
)
6944 FD_ZERO (&waitchannels
);
6946 error ("select error: %s", emacs_strerror (xerrno
));
6949 /* Check for keyboard input */
6952 && detect_input_pending_run_timers (do_display
))
6954 swallow_events (do_display
);
6955 if (detect_input_pending_run_timers (do_display
))
6959 /* If there is unread keyboard input, also return. */
6961 && requeued_events_pending_p ())
6964 /* If wait_for_cell. check for keyboard input
6965 but don't run any timers.
6966 ??? (It seems wrong to me to check for keyboard
6967 input at all when wait_for_cell, but the code
6968 has been this way since July 1994.
6969 Try changing this after version 19.31.) */
6970 if (! NILP (wait_for_cell
)
6971 && detect_input_pending ())
6973 swallow_events (do_display
);
6974 if (detect_input_pending ())
6978 /* Exit now if the cell we're waiting for became non-nil. */
6979 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6988 #endif /* not subprocesses */
6990 /* The following functions are needed even if async subprocesses are
6991 not supported. Some of them are no-op stubs in that case. */
6993 /* Add DESC to the set of keyboard input descriptors. */
6996 add_keyboard_wait_descriptor (int desc
)
6998 #ifdef subprocesses /* actually means "not MSDOS" */
6999 FD_SET (desc
, &input_wait_mask
);
7000 FD_SET (desc
, &non_process_wait_mask
);
7001 if (desc
> max_input_desc
)
7002 max_input_desc
= desc
;
7006 /* From now on, do not expect DESC to give keyboard input. */
7009 delete_keyboard_wait_descriptor (int desc
)
7013 int lim
= max_input_desc
;
7015 FD_CLR (desc
, &input_wait_mask
);
7016 FD_CLR (desc
, &non_process_wait_mask
);
7018 if (desc
== max_input_desc
)
7019 for (fd
= 0; fd
< lim
; fd
++)
7020 if (FD_ISSET (fd
, &input_wait_mask
) || FD_ISSET (fd
, &write_mask
))
7021 max_input_desc
= fd
;
7025 /* Setup coding systems of PROCESS. */
7028 setup_process_coding_systems (Lisp_Object process
)
7031 struct Lisp_Process
*p
= XPROCESS (process
);
7033 int outch
= p
->outfd
;
7034 Lisp_Object coding_system
;
7036 if (inch
< 0 || outch
< 0)
7039 if (!proc_decode_coding_system
[inch
])
7040 proc_decode_coding_system
[inch
]
7041 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
7042 coding_system
= p
->decode_coding_system
;
7043 if (! NILP (p
->filter
))
7045 else if (BUFFERP (p
->buffer
))
7047 if (NILP (BVAR (XBUFFER (p
->buffer
), enable_multibyte_characters
)))
7048 coding_system
= raw_text_coding_system (coding_system
);
7050 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
7052 if (!proc_encode_coding_system
[outch
])
7053 proc_encode_coding_system
[outch
]
7054 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
7055 setup_coding_system (p
->encode_coding_system
,
7056 proc_encode_coding_system
[outch
]);
7060 /* Close all descriptors currently in use for communication
7061 with subprocess. This is used in a newly-forked subprocess
7062 to get rid of irrelevant descriptors. */
7065 close_process_descs (void)
7069 for (i
= 0; i
< MAXDESC
; i
++)
7071 Lisp_Object process
;
7072 process
= chan_process
[i
];
7073 if (!NILP (process
))
7075 int in
= XPROCESS (process
)->infd
;
7076 int out
= XPROCESS (process
)->outfd
;
7079 if (out
>= 0 && in
!= out
)
7086 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7087 doc
: /* Return the (or a) process associated with BUFFER.
7088 BUFFER may be a buffer or the name of one. */)
7089 (register Lisp_Object buffer
)
7092 register Lisp_Object buf
, tail
, proc
;
7094 if (NILP (buffer
)) return Qnil
;
7095 buf
= Fget_buffer (buffer
);
7096 if (NILP (buf
)) return Qnil
;
7098 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
7100 proc
= Fcdr (XCAR (tail
));
7101 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
7104 #endif /* subprocesses */
7108 DEFUN ("process-inherit-coding-system-flag",
7109 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7111 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
7112 If this flag is t, `buffer-file-coding-system' of the buffer
7113 associated with PROCESS will inherit the coding system used to decode
7114 the process output. */)
7115 (register Lisp_Object process
)
7118 CHECK_PROCESS (process
);
7119 return XPROCESS (process
)->inherit_coding_system_flag
? Qt
: Qnil
;
7121 /* Ignore the argument and return the value of
7122 inherit-process-coding-system. */
7123 return inherit_process_coding_system
? Qt
: Qnil
;
7127 /* Kill all processes associated with `buffer'.
7128 If `buffer' is nil, kill all processes */
7131 kill_buffer_processes (Lisp_Object buffer
)
7134 Lisp_Object tail
, proc
;
7136 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
7138 proc
= XCDR (XCAR (tail
));
7140 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
7142 if (NETCONN_P (proc
) || SERIALCONN_P (proc
))
7143 Fdelete_process (proc
);
7144 else if (XPROCESS (proc
)->infd
>= 0)
7145 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
7148 #else /* subprocesses */
7149 /* Since we have no subprocesses, this does nothing. */
7150 #endif /* subprocesses */
7153 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
,
7154 Swaiting_for_user_input_p
, 0, 0, 0,
7155 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
7156 This is intended for use by asynchronous process output filters and sentinels. */)
7160 return (waiting_for_user_input_p
? Qt
: Qnil
);
7166 /* Stop reading input from keyboard sources. */
7169 hold_keyboard_input (void)
7174 /* Resume reading input from keyboard sources. */
7177 unhold_keyboard_input (void)
7182 /* Return non-zero if keyboard input is on hold, zero otherwise. */
7185 kbd_on_hold_p (void)
7187 return kbd_is_on_hold
;
7191 /* Enumeration of and access to system processes a-la ps(1). */
7193 DEFUN ("list-system-processes", Flist_system_processes
, Slist_system_processes
,
7195 doc
: /* Return a list of numerical process IDs of all running processes.
7196 If this functionality is unsupported, return nil.
7198 See `process-attributes' for getting attributes of a process given its ID. */)
7201 return list_system_processes ();
7204 DEFUN ("process-attributes", Fprocess_attributes
,
7205 Sprocess_attributes
, 1, 1, 0,
7206 doc
: /* Return attributes of the process given by its PID, a number.
7208 Value is an alist where each element is a cons cell of the form
7212 If this functionality is unsupported, the value is nil.
7214 See `list-system-processes' for getting a list of all process IDs.
7216 The KEYs of the attributes that this function may return are listed
7217 below, together with the type of the associated VALUE (in parentheses).
7218 Not all platforms support all of these attributes; unsupported
7219 attributes will not appear in the returned alist.
7220 Unless explicitly indicated otherwise, numbers can have either
7221 integer or floating point values.
7223 euid -- Effective user User ID of the process (number)
7224 user -- User name corresponding to euid (string)
7225 egid -- Effective user Group ID of the process (number)
7226 group -- Group name corresponding to egid (string)
7227 comm -- Command name (executable name only) (string)
7228 state -- Process state code, such as "S", "R", or "T" (string)
7229 ppid -- Parent process ID (number)
7230 pgrp -- Process group ID (number)
7231 sess -- Session ID, i.e. process ID of session leader (number)
7232 ttname -- Controlling tty name (string)
7233 tpgid -- ID of foreground process group on the process's tty (number)
7234 minflt -- number of minor page faults (number)
7235 majflt -- number of major page faults (number)
7236 cminflt -- cumulative number of minor page faults (number)
7237 cmajflt -- cumulative number of major page faults (number)
7238 utime -- user time used by the process, in the (HIGH LOW USEC) format
7239 stime -- system time used by the process, in the (HIGH LOW USEC) format
7240 time -- sum of utime and stime, in the (HIGH LOW USEC) format
7241 cutime -- user time used by the process and its children, (HIGH LOW USEC)
7242 cstime -- system time used by the process and its children, (HIGH LOW USEC)
7243 ctime -- sum of cutime and cstime, in the (HIGH LOW USEC) format
7244 pri -- priority of the process (number)
7245 nice -- nice value of the process (number)
7246 thcount -- process thread count (number)
7247 start -- time the process started, in the (HIGH LOW USEC) format
7248 vsize -- virtual memory size of the process in KB's (number)
7249 rss -- resident set size of the process in KB's (number)
7250 etime -- elapsed time the process is running, in (HIGH LOW USEC) format
7251 pcpu -- percents of CPU time used by the process (floating-point number)
7252 pmem -- percents of total physical memory used by process's resident set
7253 (floating-point number)
7254 args -- command line which invoked the process (string). */)
7257 return system_process_attributes (pid
);
7267 inhibit_sentinels
= 0;
7271 if (! noninteractive
|| initialized
)
7273 signal (SIGCHLD
, sigchld_handler
);
7276 FD_ZERO (&input_wait_mask
);
7277 FD_ZERO (&non_keyboard_wait_mask
);
7278 FD_ZERO (&non_process_wait_mask
);
7279 FD_ZERO (&write_mask
);
7280 max_process_desc
= 0;
7281 memset (fd_callback_info
, 0, sizeof (fd_callback_info
));
7283 #ifdef NON_BLOCKING_CONNECT
7284 FD_ZERO (&connect_wait_mask
);
7285 num_pending_connects
= 0;
7288 #ifdef ADAPTIVE_READ_BUFFERING
7289 process_output_delay_count
= 0;
7290 process_output_skip
= 0;
7293 /* Don't do this, it caused infinite select loops. The display
7294 method should call add_keyboard_wait_descriptor on stdin if it
7297 FD_SET (0, &input_wait_mask
);
7300 Vprocess_alist
= Qnil
;
7302 deleted_pid_list
= Qnil
;
7304 for (i
= 0; i
< MAXDESC
; i
++)
7306 chan_process
[i
] = Qnil
;
7307 proc_buffered_char
[i
] = -1;
7309 memset (proc_decode_coding_system
, 0, sizeof proc_decode_coding_system
);
7310 memset (proc_encode_coding_system
, 0, sizeof proc_encode_coding_system
);
7311 #ifdef DATAGRAM_SOCKETS
7312 memset (datagram_address
, 0, sizeof datagram_address
);
7316 Lisp_Object subfeatures
= Qnil
;
7317 const struct socket_options
*sopt
;
7319 #define ADD_SUBFEATURE(key, val) \
7320 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
7322 #ifdef NON_BLOCKING_CONNECT
7323 ADD_SUBFEATURE (QCnowait
, Qt
);
7325 #ifdef DATAGRAM_SOCKETS
7326 ADD_SUBFEATURE (QCtype
, Qdatagram
);
7328 #ifdef HAVE_SEQPACKET
7329 ADD_SUBFEATURE (QCtype
, Qseqpacket
);
7331 #ifdef HAVE_LOCAL_SOCKETS
7332 ADD_SUBFEATURE (QCfamily
, Qlocal
);
7334 ADD_SUBFEATURE (QCfamily
, Qipv4
);
7336 ADD_SUBFEATURE (QCfamily
, Qipv6
);
7338 #ifdef HAVE_GETSOCKNAME
7339 ADD_SUBFEATURE (QCservice
, Qt
);
7341 #if defined (O_NONBLOCK) || defined (O_NDELAY)
7342 ADD_SUBFEATURE (QCserver
, Qt
);
7345 for (sopt
= socket_options
; sopt
->name
; sopt
++)
7346 subfeatures
= pure_cons (intern_c_string (sopt
->name
), subfeatures
);
7348 Fprovide (intern_c_string ("make-network-process"), subfeatures
);
7351 #if defined (DARWIN_OS)
7352 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7353 processes. As such, we only change the default value. */
7356 char const *release
= (STRINGP (Voperating_system_release
)
7357 ? SSDATA (Voperating_system_release
)
7359 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
7360 && release
[1] == '.')) {
7361 Vprocess_connection_type
= Qnil
;
7365 #endif /* subprocesses */
7370 syms_of_process (void)
7374 DEFSYM (Qprocessp
, "processp");
7375 DEFSYM (Qrun
, "run");
7376 DEFSYM (Qstop
, "stop");
7377 DEFSYM (Qsignal
, "signal");
7379 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7382 Qexit = intern_c_string ("exit");
7383 staticpro (&Qexit); */
7385 DEFSYM (Qopen
, "open");
7386 DEFSYM (Qclosed
, "closed");
7387 DEFSYM (Qconnect
, "connect");
7388 DEFSYM (Qfailed
, "failed");
7389 DEFSYM (Qlisten
, "listen");
7390 DEFSYM (Qlocal
, "local");
7391 DEFSYM (Qipv4
, "ipv4");
7393 DEFSYM (Qipv6
, "ipv6");
7395 DEFSYM (Qdatagram
, "datagram");
7396 DEFSYM (Qseqpacket
, "seqpacket");
7398 DEFSYM (QCport
, ":port");
7399 DEFSYM (QCspeed
, ":speed");
7400 DEFSYM (QCprocess
, ":process");
7402 DEFSYM (QCbytesize
, ":bytesize");
7403 DEFSYM (QCstopbits
, ":stopbits");
7404 DEFSYM (QCparity
, ":parity");
7405 DEFSYM (Qodd
, "odd");
7406 DEFSYM (Qeven
, "even");
7407 DEFSYM (QCflowcontrol
, ":flowcontrol");
7410 DEFSYM (QCsummary
, ":summary");
7412 DEFSYM (Qreal
, "real");
7413 DEFSYM (Qnetwork
, "network");
7414 DEFSYM (Qserial
, "serial");
7415 DEFSYM (QCbuffer
, ":buffer");
7416 DEFSYM (QChost
, ":host");
7417 DEFSYM (QCservice
, ":service");
7418 DEFSYM (QClocal
, ":local");
7419 DEFSYM (QCremote
, ":remote");
7420 DEFSYM (QCcoding
, ":coding");
7421 DEFSYM (QCserver
, ":server");
7422 DEFSYM (QCnowait
, ":nowait");
7423 DEFSYM (QCsentinel
, ":sentinel");
7424 DEFSYM (QClog
, ":log");
7425 DEFSYM (QCnoquery
, ":noquery");
7426 DEFSYM (QCstop
, ":stop");
7427 DEFSYM (QCoptions
, ":options");
7428 DEFSYM (QCplist
, ":plist");
7430 DEFSYM (Qlast_nonmenu_event
, "last-nonmenu-event");
7432 staticpro (&Vprocess_alist
);
7434 staticpro (&deleted_pid_list
);
7437 #endif /* subprocesses */
7439 DEFSYM (QCname
, ":name");
7440 DEFSYM (QCtype
, ":type");
7442 DEFSYM (Qeuid
, "euid");
7443 DEFSYM (Qegid
, "egid");
7444 DEFSYM (Quser
, "user");
7445 DEFSYM (Qgroup
, "group");
7446 DEFSYM (Qcomm
, "comm");
7447 DEFSYM (Qstate
, "state");
7448 DEFSYM (Qppid
, "ppid");
7449 DEFSYM (Qpgrp
, "pgrp");
7450 DEFSYM (Qsess
, "sess");
7451 DEFSYM (Qttname
, "ttname");
7452 DEFSYM (Qtpgid
, "tpgid");
7453 DEFSYM (Qminflt
, "minflt");
7454 DEFSYM (Qmajflt
, "majflt");
7455 DEFSYM (Qcminflt
, "cminflt");
7456 DEFSYM (Qcmajflt
, "cmajflt");
7457 DEFSYM (Qutime
, "utime");
7458 DEFSYM (Qstime
, "stime");
7459 DEFSYM (Qtime
, "time");
7460 DEFSYM (Qcutime
, "cutime");
7461 DEFSYM (Qcstime
, "cstime");
7462 DEFSYM (Qctime
, "ctime");
7463 DEFSYM (Qpri
, "pri");
7464 DEFSYM (Qnice
, "nice");
7465 DEFSYM (Qthcount
, "thcount");
7466 DEFSYM (Qstart
, "start");
7467 DEFSYM (Qvsize
, "vsize");
7468 DEFSYM (Qrss
, "rss");
7469 DEFSYM (Qetime
, "etime");
7470 DEFSYM (Qpcpu
, "pcpu");
7471 DEFSYM (Qpmem
, "pmem");
7472 DEFSYM (Qargs
, "args");
7474 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes
,
7475 doc
: /* Non-nil means delete processes immediately when they exit.
7476 A value of nil means don't delete them until `list-processes' is run. */);
7478 delete_exited_processes
= 1;
7481 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type
,
7482 doc
: /* Control type of device used to communicate with subprocesses.
7483 Values are nil to use a pipe, or t or `pty' to use a pty.
7484 The value has no effect if the system has no ptys or if all ptys are busy:
7485 then a pipe is used in any case.
7486 The value takes effect when `start-process' is called. */);
7487 Vprocess_connection_type
= Qt
;
7489 #ifdef ADAPTIVE_READ_BUFFERING
7490 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering
,
7491 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7492 On some systems, when Emacs reads the output from a subprocess, the output data
7493 is read in very small blocks, potentially resulting in very poor performance.
7494 This behavior can be remedied to some extent by setting this variable to a
7495 non-nil value, as it will automatically delay reading from such processes, to
7496 allow them to produce more output before Emacs tries to read it.
7497 If the value is t, the delay is reset after each write to the process; any other
7498 non-nil value means that the delay is not reset on write.
7499 The variable takes effect when `start-process' is called. */);
7500 Vprocess_adaptive_read_buffering
= Qt
;
7503 defsubr (&Sprocessp
);
7504 defsubr (&Sget_process
);
7505 defsubr (&Sdelete_process
);
7506 defsubr (&Sprocess_status
);
7507 defsubr (&Sprocess_exit_status
);
7508 defsubr (&Sprocess_id
);
7509 defsubr (&Sprocess_name
);
7510 defsubr (&Sprocess_tty_name
);
7511 defsubr (&Sprocess_command
);
7512 defsubr (&Sset_process_buffer
);
7513 defsubr (&Sprocess_buffer
);
7514 defsubr (&Sprocess_mark
);
7515 defsubr (&Sset_process_filter
);
7516 defsubr (&Sprocess_filter
);
7517 defsubr (&Sset_process_sentinel
);
7518 defsubr (&Sprocess_sentinel
);
7519 defsubr (&Sset_process_window_size
);
7520 defsubr (&Sset_process_inherit_coding_system_flag
);
7521 defsubr (&Sset_process_query_on_exit_flag
);
7522 defsubr (&Sprocess_query_on_exit_flag
);
7523 defsubr (&Sprocess_contact
);
7524 defsubr (&Sprocess_plist
);
7525 defsubr (&Sset_process_plist
);
7526 defsubr (&Sprocess_list
);
7527 defsubr (&Sstart_process
);
7528 defsubr (&Sserial_process_configure
);
7529 defsubr (&Smake_serial_process
);
7530 defsubr (&Sset_network_process_option
);
7531 defsubr (&Smake_network_process
);
7532 defsubr (&Sformat_network_address
);
7533 #if defined (HAVE_NET_IF_H)
7535 defsubr (&Snetwork_interface_list
);
7537 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
7538 defsubr (&Snetwork_interface_info
);
7540 #endif /* defined (HAVE_NET_IF_H) */
7541 #ifdef DATAGRAM_SOCKETS
7542 defsubr (&Sprocess_datagram_address
);
7543 defsubr (&Sset_process_datagram_address
);
7545 defsubr (&Saccept_process_output
);
7546 defsubr (&Sprocess_send_region
);
7547 defsubr (&Sprocess_send_string
);
7548 defsubr (&Sinterrupt_process
);
7549 defsubr (&Skill_process
);
7550 defsubr (&Squit_process
);
7551 defsubr (&Sstop_process
);
7552 defsubr (&Scontinue_process
);
7553 defsubr (&Sprocess_running_child_p
);
7554 defsubr (&Sprocess_send_eof
);
7555 defsubr (&Ssignal_process
);
7556 defsubr (&Swaiting_for_user_input_p
);
7557 defsubr (&Sprocess_type
);
7558 defsubr (&Sset_process_coding_system
);
7559 defsubr (&Sprocess_coding_system
);
7560 defsubr (&Sset_process_filter_multibyte
);
7561 defsubr (&Sprocess_filter_multibyte_p
);
7563 #endif /* subprocesses */
7565 defsubr (&Sget_buffer_process
);
7566 defsubr (&Sprocess_inherit_coding_system_flag
);
7567 defsubr (&Slist_system_processes
);
7568 defsubr (&Sprocess_attributes
);