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/>. */
24 #define PROCESS_INLINE EXTERN_INLINE
28 #include <sys/types.h> /* Some typedefs are used in sys/file.h. */
36 /* Only MS-DOS does not define `subprocesses'. */
39 #include <sys/socket.h>
41 #include <netinet/in.h>
42 #include <arpa/inet.h>
44 /* Are local (unix) sockets supported? */
45 #if defined (HAVE_SYS_UN_H)
46 #if !defined (AF_LOCAL) && defined (AF_UNIX)
47 #define AF_LOCAL AF_UNIX
50 #define HAVE_LOCAL_SOCKETS
55 #include <sys/ioctl.h>
56 #if defined (HAVE_NET_IF_H)
58 #endif /* HAVE_NET_IF_H */
60 #if defined (HAVE_IFADDRS_H)
61 /* Must be after net/if.h */
64 /* We only use structs from this header when we use getifaddrs. */
65 #if defined (HAVE_NET_IF_DL_H)
66 #include <net/if_dl.h>
76 # include <sys/stream.h>
77 # include <sys/stropts.h>
81 #include <netinet/in.h>
82 #include <arpa/nameser.h>
94 #endif /* subprocesses */
100 #include "character.h"
105 #include "termhooks.h"
106 #include "termopts.h"
107 #include "commands.h"
108 #include "keyboard.h"
109 #include "blockinput.h"
110 #include "dispextern.h"
111 #include "composite.h"
113 #include "sysselect.h"
114 #include "syssignal.h"
120 #ifdef HAVE_WINDOW_SYSTEM
122 #endif /* HAVE_WINDOW_SYSTEM */
124 #if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
125 #include "xgselect.h"
129 extern int sys_select (int, SELECT_TYPE
*, SELECT_TYPE
*, SELECT_TYPE
*,
130 EMACS_TIME
*, void *);
133 /* Work around GCC 4.7.0 bug with strict overflow checking; see
134 <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
135 These lines can be removed once the GCC bug is fixed. */
136 #if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__
137 # pragma GCC diagnostic ignored "-Wstrict-overflow"
140 Lisp_Object Qeuid
, Qegid
, Qcomm
, Qstate
, Qppid
, Qpgrp
, Qsess
, Qttname
, Qtpgid
;
141 Lisp_Object Qminflt
, Qmajflt
, Qcminflt
, Qcmajflt
, Qutime
, Qstime
, Qcstime
;
142 Lisp_Object Qcutime
, Qpri
, Qnice
, Qthcount
, Qstart
, Qvsize
, Qrss
, Qargs
;
143 Lisp_Object Quser
, Qgroup
, Qetime
, Qpcpu
, Qpmem
, Qtime
, Qctime
;
144 Lisp_Object QCname
, QCtype
;
146 /* Non-zero if keyboard input is on hold, zero otherwise. */
148 static int kbd_is_on_hold
;
150 /* Nonzero means don't run process sentinels. This is used
152 int inhibit_sentinels
;
156 Lisp_Object Qprocessp
;
157 static Lisp_Object Qrun
, Qstop
, Qsignal
;
158 static Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
160 static Lisp_Object Qipv4
, Qdatagram
, Qseqpacket
;
161 static Lisp_Object Qreal
, Qnetwork
, Qserial
;
163 static Lisp_Object Qipv6
;
165 static Lisp_Object QCport
, QCprocess
;
167 Lisp_Object QCbytesize
, QCstopbits
, QCparity
, Qodd
, Qeven
;
168 Lisp_Object QCflowcontrol
, Qhw
, Qsw
, QCsummary
;
169 static Lisp_Object QCbuffer
, QChost
, QCservice
;
170 static Lisp_Object QClocal
, QCremote
, QCcoding
;
171 static Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
172 static Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
173 static Lisp_Object Qlast_nonmenu_event
;
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 EMACS_INT process_tick
;
186 /* Number of events for which the user or sentinel has been notified. */
187 static EMACS_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 #ifndef BROKEN_DATAGRAM_SOCKETS
215 # if defined HAVE_SELECT || defined USABLE_FIONREAD
216 # if defined HAVE_SENDTO && defined HAVE_RECVFROM && defined EMSGSIZE
217 # define DATAGRAM_SOCKETS
222 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
223 # define HAVE_SEQPACKET
226 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
227 #define ADAPTIVE_READ_BUFFERING
230 #ifdef ADAPTIVE_READ_BUFFERING
231 #define READ_OUTPUT_DELAY_INCREMENT (EMACS_TIME_RESOLUTION / 100)
232 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
233 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
235 /* Number of processes which have a non-zero read_output_delay,
236 and therefore might be delayed for adaptive read buffering. */
238 static int process_output_delay_count
;
240 /* Non-zero if any process has non-nil read_output_skip. */
242 static int process_output_skip
;
245 #define process_output_delay_count 0
248 static void create_process (Lisp_Object
, char **, Lisp_Object
);
250 static int keyboard_bit_set (SELECT_TYPE
*);
252 static void deactivate_process (Lisp_Object
);
253 static void status_notify (struct Lisp_Process
*);
254 static int read_process_output (Lisp_Object
, int);
255 static void handle_child_signal (int);
256 static void create_pty (Lisp_Object
);
258 /* If we support a window system, turn on the code to poll periodically
259 to detect C-g. It isn't actually used when doing interrupt input. */
260 #ifdef HAVE_WINDOW_SYSTEM
261 #define POLL_FOR_INPUT
264 static Lisp_Object
get_process (register Lisp_Object name
);
265 static void exec_sentinel (Lisp_Object proc
, Lisp_Object reason
);
267 /* Mask of bits indicating the descriptors that we wait for input on. */
269 static SELECT_TYPE input_wait_mask
;
271 /* Mask that excludes keyboard input descriptor(s). */
273 static SELECT_TYPE non_keyboard_wait_mask
;
275 /* Mask that excludes process input descriptor(s). */
277 static SELECT_TYPE non_process_wait_mask
;
279 /* Mask for selecting for write. */
281 static SELECT_TYPE write_mask
;
283 #ifdef NON_BLOCKING_CONNECT
284 /* Mask of bits indicating the descriptors that we wait for connect to
285 complete on. Once they complete, they are removed from this mask
286 and added to the input_wait_mask and non_keyboard_wait_mask. */
288 static SELECT_TYPE connect_wait_mask
;
290 /* Number of bits set in connect_wait_mask. */
291 static int num_pending_connects
;
292 #endif /* NON_BLOCKING_CONNECT */
294 /* The largest descriptor currently in use for a process object. */
295 static int max_process_desc
;
297 /* The largest descriptor currently in use for input. */
298 static int max_input_desc
;
300 /* Indexed by descriptor, gives the process (if any) for that descriptor */
301 static Lisp_Object chan_process
[MAXDESC
];
303 /* Alist of elements (NAME . PROCESS) */
304 static Lisp_Object Vprocess_alist
;
306 /* Buffered-ahead input char from process, indexed by channel.
307 -1 means empty (no char is buffered).
308 Used on sys V where the only way to tell if there is any
309 output from the process is to read at least one char.
310 Always -1 on systems that support FIONREAD. */
312 static int proc_buffered_char
[MAXDESC
];
314 /* Table of `struct coding-system' for each process. */
315 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
316 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
318 #ifdef DATAGRAM_SOCKETS
319 /* Table of `partner address' for datagram sockets. */
320 static struct sockaddr_and_len
{
323 } datagram_address
[MAXDESC
];
324 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
325 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
327 #define DATAGRAM_CHAN_P(chan) (0)
328 #define DATAGRAM_CONN_P(proc) (0)
331 /* Maximum number of bytes to send to a pty without an eof. */
332 static int pty_max_bytes
;
334 /* These setters are used only in this file, so they can be private. */
336 pset_buffer (struct Lisp_Process
*p
, Lisp_Object val
)
341 pset_command (struct Lisp_Process
*p
, Lisp_Object val
)
346 pset_decode_coding_system (struct Lisp_Process
*p
, Lisp_Object val
)
348 p
->decode_coding_system
= val
;
351 pset_decoding_buf (struct Lisp_Process
*p
, Lisp_Object val
)
353 p
->decoding_buf
= val
;
356 pset_encode_coding_system (struct Lisp_Process
*p
, Lisp_Object val
)
358 p
->encode_coding_system
= val
;
361 pset_encoding_buf (struct Lisp_Process
*p
, Lisp_Object val
)
363 p
->encoding_buf
= val
;
366 pset_filter (struct Lisp_Process
*p
, Lisp_Object val
)
371 pset_log (struct Lisp_Process
*p
, Lisp_Object val
)
376 pset_mark (struct Lisp_Process
*p
, Lisp_Object val
)
381 pset_name (struct Lisp_Process
*p
, Lisp_Object val
)
386 pset_plist (struct Lisp_Process
*p
, Lisp_Object val
)
391 pset_sentinel (struct Lisp_Process
*p
, Lisp_Object val
)
396 pset_status (struct Lisp_Process
*p
, Lisp_Object val
)
401 pset_tty_name (struct Lisp_Process
*p
, Lisp_Object val
)
406 pset_type (struct Lisp_Process
*p
, Lisp_Object val
)
411 pset_write_queue (struct Lisp_Process
*p
, Lisp_Object val
)
413 p
->write_queue
= val
;
418 static struct fd_callback_data
424 int condition
; /* mask of the defines above. */
425 } fd_callback_info
[MAXDESC
];
428 /* Add a file descriptor FD to be monitored for when read is possible.
429 When read is possible, call FUNC with argument DATA. */
432 add_read_fd (int fd
, fd_callback func
, void *data
)
434 eassert (fd
< MAXDESC
);
435 add_keyboard_wait_descriptor (fd
);
437 fd_callback_info
[fd
].func
= func
;
438 fd_callback_info
[fd
].data
= data
;
439 fd_callback_info
[fd
].condition
|= FOR_READ
;
442 /* Stop monitoring file descriptor FD for when read is possible. */
445 delete_read_fd (int fd
)
447 eassert (fd
< MAXDESC
);
448 delete_keyboard_wait_descriptor (fd
);
450 fd_callback_info
[fd
].condition
&= ~FOR_READ
;
451 if (fd_callback_info
[fd
].condition
== 0)
453 fd_callback_info
[fd
].func
= 0;
454 fd_callback_info
[fd
].data
= 0;
458 /* Add a file descriptor FD to be monitored for when write is possible.
459 When write is possible, call FUNC with argument DATA. */
462 add_write_fd (int fd
, fd_callback func
, void *data
)
464 eassert (fd
< MAXDESC
);
465 FD_SET (fd
, &write_mask
);
466 if (fd
> max_input_desc
)
469 fd_callback_info
[fd
].func
= func
;
470 fd_callback_info
[fd
].data
= data
;
471 fd_callback_info
[fd
].condition
|= FOR_WRITE
;
474 /* Stop monitoring file descriptor FD for when write is possible. */
477 delete_write_fd (int fd
)
479 int lim
= max_input_desc
;
481 eassert (fd
< MAXDESC
);
482 FD_CLR (fd
, &write_mask
);
483 fd_callback_info
[fd
].condition
&= ~FOR_WRITE
;
484 if (fd_callback_info
[fd
].condition
== 0)
486 fd_callback_info
[fd
].func
= 0;
487 fd_callback_info
[fd
].data
= 0;
489 if (fd
== max_input_desc
)
490 for (fd
= lim
; fd
>= 0; fd
--)
491 if (FD_ISSET (fd
, &input_wait_mask
) || FD_ISSET (fd
, &write_mask
))
501 /* Compute the Lisp form of the process status, p->status, from
502 the numeric status that was returned by `wait'. */
504 static Lisp_Object
status_convert (int);
507 update_status (struct Lisp_Process
*p
)
509 eassert (p
->raw_status_new
);
510 pset_status (p
, status_convert (p
->raw_status
));
511 p
->raw_status_new
= 0;
514 /* Convert a process status word in Unix format to
515 the list that we use internally. */
518 status_convert (int w
)
521 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
522 else if (WIFEXITED (w
))
523 return Fcons (Qexit
, Fcons (make_number (WEXITSTATUS (w
)),
524 WCOREDUMP (w
) ? Qt
: Qnil
));
525 else if (WIFSIGNALED (w
))
526 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
527 WCOREDUMP (w
) ? Qt
: Qnil
));
532 /* Given a status-list, extract the three pieces of information
533 and store them individually through the three pointers. */
536 decode_status (Lisp_Object l
, Lisp_Object
*symbol
, int *code
, int *coredump
)
550 *code
= XFASTINT (XCAR (tem
));
552 *coredump
= !NILP (tem
);
556 /* Return a string describing a process status list. */
559 status_message (struct Lisp_Process
*p
)
561 Lisp_Object status
= p
->status
;
564 Lisp_Object string
, string2
;
566 decode_status (status
, &symbol
, &code
, &coredump
);
568 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
571 synchronize_system_messages_locale ();
572 signame
= strsignal (code
);
574 string
= build_string ("unknown");
579 string
= build_unibyte_string (signame
);
580 if (! NILP (Vlocale_coding_system
))
581 string
= (code_convert_string_norecord
582 (string
, Vlocale_coding_system
, 0));
583 c1
= STRING_CHAR (SDATA (string
));
586 Faset (string
, make_number (0), make_number (c2
));
588 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
589 return concat2 (string
, string2
);
591 else if (EQ (symbol
, Qexit
))
594 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
596 return build_string ("finished\n");
597 string
= Fnumber_to_string (make_number (code
));
598 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
599 return concat3 (build_string ("exited abnormally with code "),
602 else if (EQ (symbol
, Qfailed
))
604 string
= Fnumber_to_string (make_number (code
));
605 string2
= build_string ("\n");
606 return concat3 (build_string ("failed with code "),
610 return Fcopy_sequence (Fsymbol_name (symbol
));
615 /* The file name of the pty opened by allocate_pty. */
616 static char pty_name
[24];
618 /* Open an available pty, returning a file descriptor.
619 Return -1 on failure.
620 The file name of the terminal corresponding to the pty
621 is left in the variable pty_name. */
632 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
633 for (i
= 0; i
< 16; i
++)
636 #ifdef PTY_NAME_SPRINTF
639 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
640 #endif /* no PTY_NAME_SPRINTF */
644 #else /* no PTY_OPEN */
647 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
649 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
652 #endif /* no PTY_OPEN */
656 /* check to make certain that both sides are available
657 this avoids a nasty yet stupid bug in rlogins */
658 #ifdef PTY_TTY_NAME_SPRINTF
661 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
662 #endif /* no PTY_TTY_NAME_SPRINTF */
663 if (access (pty_name
, 6) != 0)
678 #endif /* HAVE_PTYS */
681 make_process (Lisp_Object name
)
683 register Lisp_Object val
, tem
, name1
;
684 register struct Lisp_Process
*p
;
685 char suffix
[sizeof "<>" + INT_STRLEN_BOUND (printmax_t
)];
688 p
= allocate_process ();
689 /* Initialize Lisp data. Note that allocate_process initializes all
690 Lisp data to nil, so do it only for slots which should not be nil. */
691 pset_status (p
, Qrun
);
692 pset_mark (p
, Fmake_marker ());
694 /* Initialize non-Lisp data. Note that allocate_process zeroes out all
695 non-Lisp data, so do it only for slots which should not be zero. */
700 p
->gnutls_initstage
= GNUTLS_STAGE_EMPTY
;
703 /* If name is already in use, modify it until it is unused. */
708 tem
= Fget_process (name1
);
709 if (NILP (tem
)) break;
710 name1
= concat2 (name
, make_formatted_string (suffix
, "<%"pMd
">", i
));
714 XSETPROCESS (val
, p
);
715 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
720 remove_process (register Lisp_Object proc
)
722 register Lisp_Object pair
;
724 pair
= Frassq (proc
, Vprocess_alist
);
725 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
727 deactivate_process (proc
);
731 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
732 doc
: /* Return t if OBJECT is a process. */)
735 return PROCESSP (object
) ? Qt
: Qnil
;
738 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
739 doc
: /* Return the process named NAME, or nil if there is none. */)
740 (register Lisp_Object name
)
745 return Fcdr (Fassoc (name
, Vprocess_alist
));
748 /* This is how commands for the user decode process arguments. It
749 accepts a process, a process name, a buffer, a buffer name, or nil.
750 Buffers denote the first process in the buffer, and nil denotes the
754 get_process (register Lisp_Object name
)
756 register Lisp_Object proc
, obj
;
759 obj
= Fget_process (name
);
761 obj
= Fget_buffer (name
);
763 error ("Process %s does not exist", SDATA (name
));
765 else if (NILP (name
))
766 obj
= Fcurrent_buffer ();
770 /* Now obj should be either a buffer object or a process object.
774 proc
= Fget_buffer_process (obj
);
776 error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj
), name
)));
788 /* Fdelete_process promises to immediately forget about the process, but in
789 reality, Emacs needs to remember those processes until they have been
790 treated by the SIGCHLD handler and waitpid has been invoked on them;
791 otherwise they might fill up the kernel's process table. */
792 static Lisp_Object deleted_pid_list
;
795 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
796 doc
: /* Delete PROCESS: kill it and forget about it immediately.
797 PROCESS may be a process, a buffer, the name of a process or buffer, or
798 nil, indicating the current buffer's process. */)
799 (register Lisp_Object process
)
801 register struct Lisp_Process
*p
;
803 process
= get_process (process
);
804 p
= XPROCESS (process
);
806 p
->raw_status_new
= 0;
807 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
809 pset_status (p
, Fcons (Qexit
, Fcons (make_number (0), Qnil
)));
810 p
->tick
= ++process_tick
;
812 redisplay_preserve_echo_area (13);
814 else if (p
->infd
>= 0)
820 /* No problem storing the pid here, as it is still in Vprocess_alist. */
821 deleted_pid_list
= Fcons (make_fixnum_or_float (pid
),
822 /* GC treated elements set to nil. */
823 Fdelq (Qnil
, deleted_pid_list
));
824 /* If the process has already signaled, remove it from the list. */
825 if (p
->raw_status_new
)
828 if (CONSP (p
->status
))
829 symbol
= XCAR (p
->status
);
830 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
832 = Fdelete (make_fixnum_or_float (pid
), deleted_pid_list
);
836 Fkill_process (process
, Qnil
);
837 /* Do this now, since remove_process will make the
838 SIGCHLD handler do nothing. */
839 pset_status (p
, Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
)));
840 p
->tick
= ++process_tick
;
842 redisplay_preserve_echo_area (13);
845 remove_process (process
);
849 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
850 doc
: /* Return the status of PROCESS.
851 The returned value is one of the following symbols:
852 run -- for a process that is running.
853 stop -- for a process stopped but continuable.
854 exit -- for a process that has exited.
855 signal -- for a process that has got a fatal signal.
856 open -- for a network stream connection that is open.
857 listen -- for a network stream server that is listening.
858 closed -- for a network stream connection that is closed.
859 connect -- when waiting for a non-blocking connection to complete.
860 failed -- when a non-blocking connection has failed.
861 nil -- if arg is a process name and no such process exists.
862 PROCESS may be a process, a buffer, the name of a process, or
863 nil, indicating the current buffer's process. */)
864 (register Lisp_Object process
)
866 register struct Lisp_Process
*p
;
867 register Lisp_Object status
;
869 if (STRINGP (process
))
870 process
= Fget_process (process
);
872 process
= get_process (process
);
877 p
= XPROCESS (process
);
878 if (p
->raw_status_new
)
882 status
= XCAR (status
);
883 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
885 if (EQ (status
, Qexit
))
887 else if (EQ (p
->command
, Qt
))
889 else if (EQ (status
, Qrun
))
895 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
897 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
898 If PROCESS has not yet exited or died, return 0. */)
899 (register Lisp_Object process
)
901 CHECK_PROCESS (process
);
902 if (XPROCESS (process
)->raw_status_new
)
903 update_status (XPROCESS (process
));
904 if (CONSP (XPROCESS (process
)->status
))
905 return XCAR (XCDR (XPROCESS (process
)->status
));
906 return make_number (0);
909 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
910 doc
: /* Return the process id of PROCESS.
911 This is the pid of the external process which PROCESS uses or talks to.
912 For a network connection, this value is nil. */)
913 (register Lisp_Object process
)
917 CHECK_PROCESS (process
);
918 pid
= XPROCESS (process
)->pid
;
919 return (pid
? make_fixnum_or_float (pid
) : Qnil
);
922 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
923 doc
: /* Return the name of PROCESS, as a string.
924 This is the name of the program invoked in PROCESS,
925 possibly modified to make it unique among process names. */)
926 (register Lisp_Object process
)
928 CHECK_PROCESS (process
);
929 return XPROCESS (process
)->name
;
932 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
933 doc
: /* Return the command that was executed to start PROCESS.
934 This is a list of strings, the first string being the program executed
935 and the rest of the strings being the arguments given to it.
936 For a network or serial process, this is nil (process is running) or t
937 \(process is stopped). */)
938 (register Lisp_Object process
)
940 CHECK_PROCESS (process
);
941 return XPROCESS (process
)->command
;
944 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
945 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
946 This is the terminal that the process itself reads and writes on,
947 not the name of the pty that Emacs uses to talk with that terminal. */)
948 (register Lisp_Object process
)
950 CHECK_PROCESS (process
);
951 return XPROCESS (process
)->tty_name
;
954 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
956 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
958 (register Lisp_Object process
, Lisp_Object buffer
)
960 struct Lisp_Process
*p
;
962 CHECK_PROCESS (process
);
964 CHECK_BUFFER (buffer
);
965 p
= XPROCESS (process
);
966 pset_buffer (p
, buffer
);
967 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
968 pset_childp (p
, Fplist_put (p
->childp
, QCbuffer
, buffer
));
969 setup_process_coding_systems (process
);
973 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
975 doc
: /* Return the buffer PROCESS is associated with.
976 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
977 (register Lisp_Object process
)
979 CHECK_PROCESS (process
);
980 return XPROCESS (process
)->buffer
;
983 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
985 doc
: /* Return the marker for the end of the last output from PROCESS. */)
986 (register Lisp_Object process
)
988 CHECK_PROCESS (process
);
989 return XPROCESS (process
)->mark
;
992 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
994 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
995 A value of t means stop accepting output from the process.
997 When a process has a filter, its buffer is not used for output.
998 Instead, each time it does output, the entire string of output is
999 passed to the filter.
1001 The filter gets two arguments: the process and the string of output.
1002 The string argument is normally a multibyte string, except:
1003 - if the process' input coding system is no-conversion or raw-text,
1004 it is a unibyte string (the non-converted input), or else
1005 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1006 string (the result of converting the decoded input multibyte
1007 string to unibyte with `string-make-unibyte'). */)
1008 (register Lisp_Object process
, Lisp_Object filter
)
1010 struct Lisp_Process
*p
;
1012 CHECK_PROCESS (process
);
1013 p
= XPROCESS (process
);
1015 /* Don't signal an error if the process' input file descriptor
1016 is closed. This could make debugging Lisp more difficult,
1017 for example when doing something like
1019 (setq process (start-process ...))
1021 (set-process-filter process ...) */
1025 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
1027 FD_CLR (p
->infd
, &input_wait_mask
);
1028 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
1030 else if (EQ (p
->filter
, Qt
)
1031 /* Network or serial process not stopped: */
1032 && !EQ (p
->command
, Qt
))
1034 FD_SET (p
->infd
, &input_wait_mask
);
1035 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
1039 pset_filter (p
, filter
);
1040 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1041 pset_childp (p
, Fplist_put (p
->childp
, QCfilter
, filter
));
1042 setup_process_coding_systems (process
);
1046 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1048 doc
: /* Returns the filter function of PROCESS; nil if none.
1049 See `set-process-filter' for more info on filter functions. */)
1050 (register Lisp_Object process
)
1052 CHECK_PROCESS (process
);
1053 return XPROCESS (process
)->filter
;
1056 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1058 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1059 The sentinel is called as a function when the process changes state.
1060 It gets two arguments: the process, and a string describing the change. */)
1061 (register Lisp_Object process
, Lisp_Object sentinel
)
1063 struct Lisp_Process
*p
;
1065 CHECK_PROCESS (process
);
1066 p
= XPROCESS (process
);
1068 pset_sentinel (p
, sentinel
);
1069 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1070 pset_childp (p
, Fplist_put (p
->childp
, QCsentinel
, sentinel
));
1074 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1076 doc
: /* Return the sentinel of PROCESS; nil if none.
1077 See `set-process-sentinel' for more info on sentinels. */)
1078 (register Lisp_Object process
)
1080 CHECK_PROCESS (process
);
1081 return XPROCESS (process
)->sentinel
;
1084 DEFUN ("set-process-window-size", Fset_process_window_size
,
1085 Sset_process_window_size
, 3, 3, 0,
1086 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1087 (register Lisp_Object process
, Lisp_Object height
, Lisp_Object width
)
1089 CHECK_PROCESS (process
);
1090 CHECK_RANGED_INTEGER (height
, 0, INT_MAX
);
1091 CHECK_RANGED_INTEGER (width
, 0, INT_MAX
);
1093 if (XPROCESS (process
)->infd
< 0
1094 || set_window_size (XPROCESS (process
)->infd
,
1095 XINT (height
), XINT (width
)) <= 0)
1101 DEFUN ("set-process-inherit-coding-system-flag",
1102 Fset_process_inherit_coding_system_flag
,
1103 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1104 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1105 If the second argument FLAG is non-nil, then the variable
1106 `buffer-file-coding-system' of the buffer associated with PROCESS
1107 will be bound to the value of the coding system used to decode
1110 This is useful when the coding system specified for the process buffer
1111 leaves either the character code conversion or the end-of-line conversion
1112 unspecified, or if the coding system used to decode the process output
1113 is more appropriate for saving the process buffer.
1115 Binding the variable `inherit-process-coding-system' to non-nil before
1116 starting the process is an alternative way of setting the inherit flag
1117 for the process which will run.
1119 This function returns FLAG. */)
1120 (register Lisp_Object process
, Lisp_Object flag
)
1122 CHECK_PROCESS (process
);
1123 XPROCESS (process
)->inherit_coding_system_flag
= !NILP (flag
);
1127 DEFUN ("set-process-query-on-exit-flag",
1128 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1130 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1131 If the second argument FLAG is non-nil, Emacs will query the user before
1132 exiting or killing a buffer if PROCESS is running. This function
1134 (register Lisp_Object process
, Lisp_Object flag
)
1136 CHECK_PROCESS (process
);
1137 XPROCESS (process
)->kill_without_query
= NILP (flag
);
1141 DEFUN ("process-query-on-exit-flag",
1142 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1144 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1145 (register Lisp_Object process
)
1147 CHECK_PROCESS (process
);
1148 return (XPROCESS (process
)->kill_without_query
? Qnil
: Qt
);
1151 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1153 doc
: /* Return the contact info of PROCESS; t for a real child.
1154 For a network or serial connection, the value depends on the optional
1155 KEY arg. If KEY is nil, value is a cons cell of the form (HOST
1156 SERVICE) for a network connection or (PORT SPEED) for a serial
1157 connection. If KEY is t, the complete contact information for the
1158 connection is returned, else the specific value for the keyword KEY is
1159 returned. See `make-network-process' or `make-serial-process' for a
1160 list of keywords. */)
1161 (register Lisp_Object process
, Lisp_Object key
)
1163 Lisp_Object contact
;
1165 CHECK_PROCESS (process
);
1166 contact
= XPROCESS (process
)->childp
;
1168 #ifdef DATAGRAM_SOCKETS
1169 if (DATAGRAM_CONN_P (process
)
1170 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1171 contact
= Fplist_put (contact
, QCremote
,
1172 Fprocess_datagram_address (process
));
1175 if ((!NETCONN_P (process
) && !SERIALCONN_P (process
)) || EQ (key
, Qt
))
1177 if (NILP (key
) && NETCONN_P (process
))
1178 return Fcons (Fplist_get (contact
, QChost
),
1179 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1180 if (NILP (key
) && SERIALCONN_P (process
))
1181 return Fcons (Fplist_get (contact
, QCport
),
1182 Fcons (Fplist_get (contact
, QCspeed
), Qnil
));
1183 return Fplist_get (contact
, key
);
1186 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1188 doc
: /* Return the plist of PROCESS. */)
1189 (register Lisp_Object process
)
1191 CHECK_PROCESS (process
);
1192 return XPROCESS (process
)->plist
;
1195 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1197 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1198 (register Lisp_Object process
, Lisp_Object plist
)
1200 CHECK_PROCESS (process
);
1203 pset_plist (XPROCESS (process
), plist
);
1207 #if 0 /* Turned off because we don't currently record this info
1208 in the process. Perhaps add it. */
1209 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1210 doc
: /* Return the connection type of PROCESS.
1211 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1212 a socket connection. */)
1213 (Lisp_Object process
)
1215 return XPROCESS (process
)->type
;
1219 DEFUN ("process-type", Fprocess_type
, Sprocess_type
, 1, 1, 0,
1220 doc
: /* Return the connection type of PROCESS.
1221 The value is either the symbol `real', `network', or `serial'.
1222 PROCESS may be a process, a buffer, the name of a process or buffer, or
1223 nil, indicating the current buffer's process. */)
1224 (Lisp_Object process
)
1227 proc
= get_process (process
);
1228 return XPROCESS (proc
)->type
;
1231 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1233 doc
: /* Convert network ADDRESS from internal format to a string.
1234 A 4 or 5 element vector represents an IPv4 address (with port number).
1235 An 8 or 9 element vector represents an IPv6 address (with port number).
1236 If optional second argument OMIT-PORT is non-nil, don't include a port
1237 number in the string, even when present in ADDRESS.
1238 Returns nil if format of ADDRESS is invalid. */)
1239 (Lisp_Object address
, Lisp_Object omit_port
)
1244 if (STRINGP (address
)) /* AF_LOCAL */
1247 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1249 register struct Lisp_Vector
*p
= XVECTOR (address
);
1250 ptrdiff_t size
= p
->header
.size
;
1251 Lisp_Object args
[10];
1254 if (size
== 4 || (size
== 5 && !NILP (omit_port
)))
1256 args
[0] = build_string ("%d.%d.%d.%d");
1261 args
[0] = build_string ("%d.%d.%d.%d:%d");
1264 else if (size
== 8 || (size
== 9 && !NILP (omit_port
)))
1266 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1271 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1277 for (i
= 0; i
< nargs
; i
++)
1279 if (! RANGED_INTEGERP (0, p
->contents
[i
], 65535))
1282 if (nargs
<= 5 /* IPv4 */
1283 && i
< 4 /* host, not port */
1284 && XINT (p
->contents
[i
]) > 255)
1287 args
[i
+1] = p
->contents
[i
];
1290 return Fformat (nargs
+1, args
);
1293 if (CONSP (address
))
1295 Lisp_Object args
[2];
1296 args
[0] = build_string ("<Family %d>");
1297 args
[1] = Fcar (address
);
1298 return Fformat (2, args
);
1304 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1305 doc
: /* Return a list of all processes. */)
1308 return Fmapcar (Qcdr
, Vprocess_alist
);
1311 /* Starting asynchronous inferior processes. */
1313 static Lisp_Object
start_process_unwind (Lisp_Object proc
);
1315 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1316 doc
: /* Start a program in a subprocess. Return the process object for it.
1317 NAME is name for process. It is modified if necessary to make it unique.
1318 BUFFER is the buffer (or buffer name) to associate with the process.
1320 Process output (both standard output and standard error streams) goes
1321 at end of BUFFER, unless you specify an output stream or filter
1322 function to handle the output. BUFFER may also be nil, meaning that
1323 this process is not associated with any buffer.
1325 PROGRAM is the program file name. It is searched for in `exec-path'
1326 (which see). If nil, just associate a pty with the buffer. Remaining
1327 arguments are strings to give program as arguments.
1329 If you want to separate standard output from standard error, invoke
1330 the command through a shell and redirect one of them using the shell
1333 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1334 (ptrdiff_t nargs
, Lisp_Object
*args
)
1336 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1337 register unsigned char **new_argv
;
1339 ptrdiff_t count
= SPECPDL_INDEX ();
1343 buffer
= Fget_buffer_create (buffer
);
1345 /* Make sure that the child will be able to chdir to the current
1346 buffer's current directory, or its unhandled equivalent. We
1347 can't just have the child check for an error when it does the
1348 chdir, since it's in a vfork.
1350 We have to GCPRO around this because Fexpand_file_name and
1351 Funhandled_file_name_directory might call a file name handling
1352 function. The argument list is protected by the caller, so all
1353 we really have to worry about is buffer. */
1355 struct gcpro gcpro1
, gcpro2
;
1357 current_dir
= BVAR (current_buffer
, directory
);
1359 GCPRO2 (buffer
, current_dir
);
1361 current_dir
= Funhandled_file_name_directory (current_dir
);
1362 if (NILP (current_dir
))
1363 /* If the file name handler says that current_dir is unreachable, use
1364 a sensible default. */
1365 current_dir
= build_string ("~/");
1366 current_dir
= expand_and_dir_to_file (current_dir
, Qnil
);
1367 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1368 report_file_error ("Setting current directory",
1369 Fcons (BVAR (current_buffer
, directory
), Qnil
));
1375 CHECK_STRING (name
);
1379 if (!NILP (program
))
1380 CHECK_STRING (program
);
1382 proc
= make_process (name
);
1383 /* If an error occurs and we can't start the process, we want to
1384 remove it from the process list. This means that each error
1385 check in create_process doesn't need to call remove_process
1386 itself; it's all taken care of here. */
1387 record_unwind_protect (start_process_unwind
, proc
);
1389 pset_childp (XPROCESS (proc
), Qt
);
1390 pset_plist (XPROCESS (proc
), Qnil
);
1391 pset_type (XPROCESS (proc
), Qreal
);
1392 pset_buffer (XPROCESS (proc
), buffer
);
1393 pset_sentinel (XPROCESS (proc
), Qnil
);
1394 pset_filter (XPROCESS (proc
), Qnil
);
1395 pset_command (XPROCESS (proc
), Flist (nargs
- 2, args
+ 2));
1398 /* AKA GNUTLS_INITSTAGE(proc). */
1399 XPROCESS (proc
)->gnutls_initstage
= GNUTLS_STAGE_EMPTY
;
1400 pset_gnutls_cred_type (XPROCESS (proc
), Qnil
);
1403 #ifdef ADAPTIVE_READ_BUFFERING
1404 XPROCESS (proc
)->adaptive_read_buffering
1405 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
1406 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
1409 /* Make the process marker point into the process buffer (if any). */
1410 if (BUFFERP (buffer
))
1411 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1412 BUF_ZV (XBUFFER (buffer
)),
1413 BUF_ZV_BYTE (XBUFFER (buffer
)));
1416 /* Decide coding systems for communicating with the process. Here
1417 we don't setup the structure coding_system nor pay attention to
1418 unibyte mode. They are done in create_process. */
1420 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1421 Lisp_Object coding_systems
= Qt
;
1422 Lisp_Object val
, *args2
;
1423 struct gcpro gcpro1
, gcpro2
;
1425 val
= Vcoding_system_for_read
;
1428 args2
= alloca ((nargs
+ 1) * sizeof *args2
);
1429 args2
[0] = Qstart_process
;
1430 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1431 GCPRO2 (proc
, current_dir
);
1432 if (!NILP (program
))
1433 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1435 if (CONSP (coding_systems
))
1436 val
= XCAR (coding_systems
);
1437 else if (CONSP (Vdefault_process_coding_system
))
1438 val
= XCAR (Vdefault_process_coding_system
);
1440 pset_decode_coding_system (XPROCESS (proc
), val
);
1442 val
= Vcoding_system_for_write
;
1445 if (EQ (coding_systems
, Qt
))
1447 args2
= alloca ((nargs
+ 1) * sizeof *args2
);
1448 args2
[0] = Qstart_process
;
1449 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1450 GCPRO2 (proc
, current_dir
);
1451 if (!NILP (program
))
1452 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1455 if (CONSP (coding_systems
))
1456 val
= XCDR (coding_systems
);
1457 else if (CONSP (Vdefault_process_coding_system
))
1458 val
= XCDR (Vdefault_process_coding_system
);
1460 pset_encode_coding_system (XPROCESS (proc
), val
);
1461 /* Note: At this moment, the above coding system may leave
1462 text-conversion or eol-conversion unspecified. They will be
1463 decided after we read output from the process and decode it by
1464 some coding system, or just before we actually send a text to
1469 pset_decoding_buf (XPROCESS (proc
), empty_unibyte_string
);
1470 XPROCESS (proc
)->decoding_carryover
= 0;
1471 pset_encoding_buf (XPROCESS (proc
), empty_unibyte_string
);
1473 XPROCESS (proc
)->inherit_coding_system_flag
1474 = !(NILP (buffer
) || !inherit_process_coding_system
);
1476 if (!NILP (program
))
1478 /* If program file name is not absolute, search our path for it.
1479 Put the name we will really use in TEM. */
1480 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1481 && !(SCHARS (program
) > 1
1482 && IS_DEVICE_SEP (SREF (program
, 1))))
1484 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1487 GCPRO4 (name
, program
, buffer
, current_dir
);
1488 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1491 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1492 tem
= Fexpand_file_name (tem
, Qnil
);
1496 if (!NILP (Ffile_directory_p (program
)))
1497 error ("Specified program for new process is a directory");
1501 /* If program file name starts with /: for quoting a magic name,
1503 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1504 && SREF (tem
, 1) == ':')
1505 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1508 Lisp_Object arg_encoding
= Qnil
;
1509 struct gcpro gcpro1
;
1512 /* Encode the file name and put it in NEW_ARGV.
1513 That's where the child will use it to execute the program. */
1514 tem
= Fcons (ENCODE_FILE (tem
), Qnil
);
1516 /* Here we encode arguments by the coding system used for sending
1517 data to the process. We don't support using different coding
1518 systems for encoding arguments and for encoding data sent to the
1521 for (i
= 3; i
< nargs
; i
++)
1523 tem
= Fcons (args
[i
], tem
);
1524 CHECK_STRING (XCAR (tem
));
1525 if (STRING_MULTIBYTE (XCAR (tem
)))
1527 if (NILP (arg_encoding
))
1528 arg_encoding
= (complement_process_encoding_system
1529 (XPROCESS (proc
)->encode_coding_system
));
1531 code_convert_string_norecord
1532 (XCAR (tem
), arg_encoding
, 1));
1539 /* Now that everything is encoded we can collect the strings into
1541 new_argv
= alloca ((nargs
- 1) * sizeof *new_argv
);
1542 new_argv
[nargs
- 2] = 0;
1544 for (i
= nargs
- 2; i
-- != 0; )
1546 new_argv
[i
] = SDATA (XCAR (tem
));
1550 create_process (proc
, (char **) new_argv
, current_dir
);
1555 return unbind_to (count
, proc
);
1558 /* This function is the unwind_protect form for Fstart_process. If
1559 PROC doesn't have its pid set, then we know someone has signaled
1560 an error and the process wasn't started successfully, so we should
1561 remove it from the process list. */
1563 start_process_unwind (Lisp_Object proc
)
1565 if (!PROCESSP (proc
))
1568 /* Was PROC started successfully?
1569 -2 is used for a pty with no process, eg for gdb. */
1570 if (XPROCESS (proc
)->pid
<= 0 && XPROCESS (proc
)->pid
!= -2)
1571 remove_process (proc
);
1577 create_process_1 (struct atimer
*timer
)
1579 /* Nothing to do. */
1584 create_process (Lisp_Object process
, char **new_argv
, Lisp_Object current_dir
)
1586 int inchannel
, outchannel
;
1589 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1590 int wait_child_setup
[2];
1595 /* Use volatile to protect variables from being clobbered by vfork. */
1596 volatile int forkin
, forkout
;
1597 volatile int pty_flag
= 0;
1598 volatile Lisp_Object lisp_pty_name
= Qnil
;
1599 volatile Lisp_Object encoded_current_dir
;
1600 #if HAVE_WORKING_VFORK
1601 char **volatile save_environ
;
1604 inchannel
= outchannel
= -1;
1607 if (!NILP (Vprocess_connection_type
))
1608 outchannel
= inchannel
= allocate_pty ();
1612 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1613 /* On most USG systems it does not work to open the pty's tty here,
1614 then close it and reopen it in the child. */
1616 /* Don't let this terminal become our controlling terminal
1617 (in case we don't have one). */
1618 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1620 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1623 report_file_error ("Opening pty", Qnil
);
1625 forkin
= forkout
= -1;
1626 #endif /* not USG, or USG_SUBTTY_WORKS */
1628 lisp_pty_name
= build_string (pty_name
);
1631 #endif /* HAVE_PTYS */
1636 report_file_error ("Creating pipe", Qnil
);
1642 emacs_close (inchannel
);
1643 emacs_close (forkout
);
1644 report_file_error ("Creating pipe", Qnil
);
1650 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1654 tem
= pipe (wait_child_setup
);
1656 report_file_error ("Creating pipe", Qnil
);
1657 tem
= fcntl (wait_child_setup
[1], F_GETFD
, 0);
1659 tem
= fcntl (wait_child_setup
[1], F_SETFD
, tem
| FD_CLOEXEC
);
1662 emacs_close (wait_child_setup
[0]);
1663 emacs_close (wait_child_setup
[1]);
1664 report_file_error ("Setting file descriptor flags", Qnil
);
1670 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1671 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1674 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1675 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1679 /* Record this as an active process, with its channels.
1680 As a result, child_setup will close Emacs's side of the pipes. */
1681 chan_process
[inchannel
] = process
;
1682 XPROCESS (process
)->infd
= inchannel
;
1683 XPROCESS (process
)->outfd
= outchannel
;
1685 /* Previously we recorded the tty descriptor used in the subprocess.
1686 It was only used for getting the foreground tty process, so now
1687 we just reopen the device (see emacs_get_tty_pgrp) as this is
1688 more portable (see USG_SUBTTY_WORKS above). */
1690 XPROCESS (process
)->pty_flag
= pty_flag
;
1691 pset_status (XPROCESS (process
), Qrun
);
1693 FD_SET (inchannel
, &input_wait_mask
);
1694 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1695 if (inchannel
> max_process_desc
)
1696 max_process_desc
= inchannel
;
1698 /* This may signal an error. */
1699 setup_process_coding_systems (process
);
1701 encoded_current_dir
= ENCODE_FILE (current_dir
);
1706 /* Block SIGCHLD until we have a chance to store the new fork's
1707 pid in its process structure. */
1708 sigemptyset (&blocked
);
1709 sigaddset (&blocked
, SIGCHLD
);
1710 pthread_sigmask (SIG_BLOCK
, &blocked
, 0);
1713 #if HAVE_WORKING_VFORK
1714 /* child_setup must clobber environ on systems with true vfork.
1715 Protect it from permanent change. */
1716 save_environ
= environ
;
1722 #endif /* not WINDOWSNT */
1724 int xforkin
= forkin
;
1725 int xforkout
= forkout
;
1727 /* Make the pty be the controlling terminal of the process. */
1729 /* First, disconnect its current controlling terminal. */
1731 /* We tried doing setsid only if pty_flag, but it caused
1732 process_set_signal to fail on SGI when using a pipe. */
1734 /* Make the pty's terminal the controlling terminal. */
1735 if (pty_flag
&& xforkin
>= 0)
1738 /* We ignore the return value
1739 because faith@cs.unc.edu says that is necessary on Linux. */
1740 ioctl (xforkin
, TIOCSCTTY
, 0);
1743 #else /* not HAVE_SETSID */
1744 /* It's very important to call setpgid here and no time
1745 afterwards. Otherwise, we lose our controlling tty which
1746 is set when we open the pty. */
1748 #endif /* not HAVE_SETSID */
1749 #if defined (LDISC1)
1750 if (pty_flag
&& xforkin
>= 0)
1753 tcgetattr (xforkin
, &t
);
1755 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1756 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1759 #if defined (NTTYDISC) && defined (TIOCSETD)
1760 if (pty_flag
&& xforkin
>= 0)
1762 /* Use new line discipline. */
1763 int ldisc
= NTTYDISC
;
1764 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1769 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1770 can do TIOCSPGRP only to the process's controlling tty. */
1773 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1774 I can't test it since I don't have 4.3. */
1775 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1778 ioctl (j
, TIOCNOTTY
, 0);
1782 /* In order to get a controlling terminal on some versions
1783 of BSD, it is necessary to put the process in pgrp 0
1784 before it opens the terminal. */
1788 #endif /* TIOCNOTTY */
1790 #if !defined (DONT_REOPEN_PTY)
1791 /*** There is a suggestion that this ought to be a
1792 conditional on TIOCSPGRP,
1793 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1794 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1795 that system does seem to need this code, even though
1796 both HAVE_SETSID and TIOCSCTTY are defined. */
1797 /* Now close the pty (if we had it open) and reopen it.
1798 This makes the pty the controlling terminal of the subprocess. */
1802 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1805 emacs_close (xforkin
);
1806 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
1810 emacs_write (1, "Couldn't open the pty terminal ", 31);
1811 emacs_write (1, pty_name
, strlen (pty_name
));
1812 emacs_write (1, "\n", 1);
1817 #endif /* not DONT_REOPEN_PTY */
1819 #ifdef SETUP_SLAVE_PTY
1824 #endif /* SETUP_SLAVE_PTY */
1826 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1827 Now reenable it in the child, so it will die when we want it to. */
1829 signal (SIGHUP
, SIG_DFL
);
1831 #endif /* HAVE_PTYS */
1833 signal (SIGINT
, SIG_DFL
);
1834 signal (SIGQUIT
, SIG_DFL
);
1836 /* Emacs ignores SIGPIPE, but the child should not. */
1837 signal (SIGPIPE
, SIG_DFL
);
1840 /* Stop blocking signals in the child. */
1841 pthread_sigmask (SIG_SETMASK
, &empty_mask
, 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 */
1858 /* Back in the parent process. */
1860 #if HAVE_WORKING_VFORK
1861 environ
= save_environ
;
1864 XPROCESS (process
)->pid
= pid
;
1866 XPROCESS (process
)->alive
= 1;
1868 /* Stop blocking signals in the parent. */
1870 pthread_sigmask (SIG_SETMASK
, &empty_mask
, 0);
1877 emacs_close (forkin
);
1878 if (forkin
!= forkout
&& forkout
>= 0)
1879 emacs_close (forkout
);
1883 /* vfork succeeded. */
1886 register_child (pid
, inchannel
);
1887 #endif /* WINDOWSNT */
1889 /* If the subfork execv fails, and it exits,
1890 this close hangs. I don't know why.
1891 So have an interrupt jar it loose. */
1893 struct atimer
*timer
;
1894 EMACS_TIME offset
= make_emacs_time (1, 0);
1897 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
1900 emacs_close (forkin
);
1902 cancel_atimer (timer
);
1906 if (forkin
!= forkout
&& forkout
>= 0)
1907 emacs_close (forkout
);
1909 pset_tty_name (XPROCESS (process
), lisp_pty_name
);
1911 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1912 /* Wait for child_setup to complete in case that vfork is
1913 actually defined as fork. The descriptor wait_child_setup[1]
1914 of a pipe is closed at the child side either by close-on-exec
1915 on successful execvp or the _exit call in child_setup. */
1919 emacs_close (wait_child_setup
[1]);
1920 emacs_read (wait_child_setup
[0], &dummy
, 1);
1921 emacs_close (wait_child_setup
[0]);
1926 /* Now generate the error if vfork failed. */
1928 report_file_error ("Doing vfork", Qnil
);
1932 create_pty (Lisp_Object process
)
1934 int inchannel
, outchannel
;
1937 inchannel
= outchannel
= -1;
1940 if (!NILP (Vprocess_connection_type
))
1941 outchannel
= inchannel
= allocate_pty ();
1945 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1946 /* On most USG systems it does not work to open the pty's tty here,
1947 then close it and reopen it in the child. */
1949 /* Don't let this terminal become our controlling terminal
1950 (in case we don't have one). */
1951 int forkout
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1953 int forkout
= emacs_open (pty_name
, O_RDWR
, 0);
1956 report_file_error ("Opening pty", Qnil
);
1957 #if defined (DONT_REOPEN_PTY)
1958 /* In the case that vfork is defined as fork, the parent process
1959 (Emacs) may send some data before the child process completes
1960 tty options setup. So we setup tty before forking. */
1961 child_setup_tty (forkout
);
1962 #endif /* DONT_REOPEN_PTY */
1963 #endif /* not USG, or USG_SUBTTY_WORKS */
1966 #endif /* HAVE_PTYS */
1969 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1970 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1973 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1974 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1978 /* Record this as an active process, with its channels.
1979 As a result, child_setup will close Emacs's side of the pipes. */
1980 chan_process
[inchannel
] = process
;
1981 XPROCESS (process
)->infd
= inchannel
;
1982 XPROCESS (process
)->outfd
= outchannel
;
1984 /* Previously we recorded the tty descriptor used in the subprocess.
1985 It was only used for getting the foreground tty process, so now
1986 we just reopen the device (see emacs_get_tty_pgrp) as this is
1987 more portable (see USG_SUBTTY_WORKS above). */
1989 XPROCESS (process
)->pty_flag
= pty_flag
;
1990 pset_status (XPROCESS (process
), Qrun
);
1991 setup_process_coding_systems (process
);
1993 FD_SET (inchannel
, &input_wait_mask
);
1994 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1995 if (inchannel
> max_process_desc
)
1996 max_process_desc
= inchannel
;
1998 XPROCESS (process
)->pid
= -2;
2001 pset_tty_name (XPROCESS (process
), build_string (pty_name
));
2004 pset_tty_name (XPROCESS (process
), Qnil
);
2008 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2009 The address family of sa is not included in the result. */
2012 conv_sockaddr_to_lisp (struct sockaddr
*sa
, int len
)
2014 Lisp_Object address
;
2017 register struct Lisp_Vector
*p
;
2019 /* Workaround for a bug in getsockname on BSD: Names bound to
2020 sockets in the UNIX domain are inaccessible; getsockname returns
2021 a zero length name. */
2022 if (len
< offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
))
2023 return empty_unibyte_string
;
2025 switch (sa
->sa_family
)
2029 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2030 len
= sizeof (sin
->sin_addr
) + 1;
2031 address
= Fmake_vector (make_number (len
), Qnil
);
2032 p
= XVECTOR (address
);
2033 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2034 cp
= (unsigned char *) &sin
->sin_addr
;
2040 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2041 uint16_t *ip6
= (uint16_t *) &sin6
->sin6_addr
;
2042 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2043 address
= Fmake_vector (make_number (len
), Qnil
);
2044 p
= XVECTOR (address
);
2045 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2046 for (i
= 0; i
< len
; i
++)
2047 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2051 #ifdef HAVE_LOCAL_SOCKETS
2054 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2055 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2056 if (sockun
->sun_path
[i
] == 0)
2058 return make_unibyte_string (sockun
->sun_path
, i
);
2062 len
-= offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
);
2063 address
= Fcons (make_number (sa
->sa_family
),
2064 Fmake_vector (make_number (len
), Qnil
));
2065 p
= XVECTOR (XCDR (address
));
2066 cp
= (unsigned char *) &sa
->sa_family
+ sizeof (sa
->sa_family
);
2072 p
->contents
[i
++] = make_number (*cp
++);
2078 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2081 get_lisp_to_sockaddr_size (Lisp_Object address
, int *familyp
)
2083 register struct Lisp_Vector
*p
;
2085 if (VECTORP (address
))
2087 p
= XVECTOR (address
);
2088 if (p
->header
.size
== 5)
2091 return sizeof (struct sockaddr_in
);
2094 else if (p
->header
.size
== 9)
2096 *familyp
= AF_INET6
;
2097 return sizeof (struct sockaddr_in6
);
2101 #ifdef HAVE_LOCAL_SOCKETS
2102 else if (STRINGP (address
))
2104 *familyp
= AF_LOCAL
;
2105 return sizeof (struct sockaddr_un
);
2108 else if (CONSP (address
) && TYPE_RANGED_INTEGERP (int, XCAR (address
))
2109 && VECTORP (XCDR (address
)))
2111 struct sockaddr
*sa
;
2112 *familyp
= XINT (XCAR (address
));
2113 p
= XVECTOR (XCDR (address
));
2114 return p
->header
.size
+ sizeof (sa
->sa_family
);
2119 /* Convert an address object (vector or string) to an internal sockaddr.
2121 The address format has been basically validated by
2122 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2123 it could have come from user data. So if FAMILY is not valid,
2124 we return after zeroing *SA. */
2127 conv_lisp_to_sockaddr (int family
, Lisp_Object address
, struct sockaddr
*sa
, int len
)
2129 register struct Lisp_Vector
*p
;
2130 register unsigned char *cp
= NULL
;
2134 memset (sa
, 0, len
);
2136 if (VECTORP (address
))
2138 p
= XVECTOR (address
);
2139 if (family
== AF_INET
)
2141 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2142 len
= sizeof (sin
->sin_addr
) + 1;
2143 hostport
= XINT (p
->contents
[--len
]);
2144 sin
->sin_port
= htons (hostport
);
2145 cp
= (unsigned char *)&sin
->sin_addr
;
2146 sa
->sa_family
= family
;
2149 else if (family
== AF_INET6
)
2151 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2152 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2153 len
= sizeof (sin6
->sin6_addr
) + 1;
2154 hostport
= XINT (p
->contents
[--len
]);
2155 sin6
->sin6_port
= htons (hostport
);
2156 for (i
= 0; i
< len
; i
++)
2157 if (INTEGERP (p
->contents
[i
]))
2159 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2162 sa
->sa_family
= family
;
2169 else if (STRINGP (address
))
2171 #ifdef HAVE_LOCAL_SOCKETS
2172 if (family
== AF_LOCAL
)
2174 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2175 cp
= SDATA (address
);
2176 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2177 sockun
->sun_path
[i
] = *cp
++;
2178 sa
->sa_family
= family
;
2185 p
= XVECTOR (XCDR (address
));
2186 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2189 for (i
= 0; i
< len
; i
++)
2190 if (INTEGERP (p
->contents
[i
]))
2191 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2194 #ifdef DATAGRAM_SOCKETS
2195 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2197 doc
: /* Get the current datagram address associated with PROCESS. */)
2198 (Lisp_Object process
)
2202 CHECK_PROCESS (process
);
2204 if (!DATAGRAM_CONN_P (process
))
2207 channel
= XPROCESS (process
)->infd
;
2208 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2209 datagram_address
[channel
].len
);
2212 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2214 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2215 Returns nil upon error setting address, ADDRESS otherwise. */)
2216 (Lisp_Object process
, Lisp_Object address
)
2221 CHECK_PROCESS (process
);
2223 if (!DATAGRAM_CONN_P (process
))
2226 channel
= XPROCESS (process
)->infd
;
2228 len
= get_lisp_to_sockaddr_size (address
, &family
);
2229 if (datagram_address
[channel
].len
!= len
)
2231 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2237 static const struct socket_options
{
2238 /* The name of this option. Should be lowercase version of option
2239 name without SO_ prefix. */
2241 /* Option level SOL_... */
2243 /* Option number SO_... */
2245 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2246 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2247 } socket_options
[] =
2249 #ifdef SO_BINDTODEVICE
2250 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2253 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2256 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2259 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2262 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2265 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2268 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2271 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2273 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2276 /* Set option OPT to value VAL on socket S.
2278 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2279 Signals an error if setting a known option fails.
2283 set_socket_option (int s
, Lisp_Object opt
, Lisp_Object val
)
2286 const struct socket_options
*sopt
;
2291 name
= SSDATA (SYMBOL_NAME (opt
));
2292 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2293 if (strcmp (name
, sopt
->name
) == 0)
2296 switch (sopt
->opttype
)
2301 optval
= NILP (val
) ? 0 : 1;
2302 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2303 &optval
, sizeof (optval
));
2310 if (TYPE_RANGED_INTEGERP (int, val
))
2311 optval
= XINT (val
);
2313 error ("Bad option value for %s", name
);
2314 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2315 &optval
, sizeof (optval
));
2319 #ifdef SO_BINDTODEVICE
2322 char devname
[IFNAMSIZ
+1];
2324 /* This is broken, at least in the Linux 2.4 kernel.
2325 To unbind, the arg must be a zero integer, not the empty string.
2326 This should work on all systems. KFS. 2003-09-23. */
2327 memset (devname
, 0, sizeof devname
);
2330 char *arg
= SSDATA (val
);
2331 int len
= min (strlen (arg
), IFNAMSIZ
);
2332 memcpy (devname
, arg
, len
);
2334 else if (!NILP (val
))
2335 error ("Bad option value for %s", name
);
2336 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2345 struct linger linger
;
2348 linger
.l_linger
= 0;
2349 if (TYPE_RANGED_INTEGERP (int, val
))
2350 linger
.l_linger
= XINT (val
);
2352 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2353 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2354 &linger
, sizeof (linger
));
2364 report_file_error ("Cannot set network option",
2365 Fcons (opt
, Fcons (val
, Qnil
)));
2366 return (1 << sopt
->optbit
);
2370 DEFUN ("set-network-process-option",
2371 Fset_network_process_option
, Sset_network_process_option
,
2373 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2374 See `make-network-process' for a list of options and values.
2375 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2376 OPTION is not a supported option, return nil instead; otherwise return t. */)
2377 (Lisp_Object process
, Lisp_Object option
, Lisp_Object value
, Lisp_Object no_error
)
2380 struct Lisp_Process
*p
;
2382 CHECK_PROCESS (process
);
2383 p
= XPROCESS (process
);
2384 if (!NETCONN1_P (p
))
2385 error ("Process is not a network process");
2389 error ("Process is not running");
2391 if (set_socket_option (s
, option
, value
))
2393 pset_childp (p
, Fplist_put (p
->childp
, option
, value
));
2397 if (NILP (no_error
))
2398 error ("Unknown or unsupported option");
2404 DEFUN ("serial-process-configure",
2405 Fserial_process_configure
,
2406 Sserial_process_configure
,
2408 doc
: /* Configure speed, bytesize, etc. of a serial process.
2410 Arguments are specified as keyword/argument pairs. Attributes that
2411 are not given are re-initialized from the process's current
2412 configuration (available via the function `process-contact') or set to
2413 reasonable default values. The following arguments are defined:
2419 -- Any of these arguments can be given to identify the process that is
2420 to be configured. If none of these arguments is given, the current
2421 buffer's process is used.
2423 :speed SPEED -- SPEED is the speed of the serial port in bits per
2424 second, also called baud rate. Any value can be given for SPEED, but
2425 most serial ports work only at a few defined values between 1200 and
2426 115200, with 9600 being the most common value. If SPEED is nil, the
2427 serial port is not configured any further, i.e., all other arguments
2428 are ignored. This may be useful for special serial ports such as
2429 Bluetooth-to-serial converters which can only be configured through AT
2430 commands. A value of nil for SPEED can be used only when passed
2431 through `make-serial-process' or `serial-term'.
2433 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2434 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2436 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2437 `odd' (use odd parity), or the symbol `even' (use even parity). If
2438 PARITY is not given, no parity is used.
2440 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2441 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2442 is not given or nil, 1 stopbit is used.
2444 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2445 flowcontrol to be used, which is either nil (don't use flowcontrol),
2446 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2447 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2448 flowcontrol is used.
2450 `serial-process-configure' is called by `make-serial-process' for the
2451 initial configuration of the serial port.
2455 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2457 \(serial-process-configure
2458 :buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)
2460 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2462 usage: (serial-process-configure &rest ARGS) */)
2463 (ptrdiff_t nargs
, Lisp_Object
*args
)
2465 struct Lisp_Process
*p
;
2466 Lisp_Object contact
= Qnil
;
2467 Lisp_Object proc
= Qnil
;
2468 struct gcpro gcpro1
;
2470 contact
= Flist (nargs
, args
);
2473 proc
= Fplist_get (contact
, QCprocess
);
2475 proc
= Fplist_get (contact
, QCname
);
2477 proc
= Fplist_get (contact
, QCbuffer
);
2479 proc
= Fplist_get (contact
, QCport
);
2480 proc
= get_process (proc
);
2481 p
= XPROCESS (proc
);
2482 if (!EQ (p
->type
, Qserial
))
2483 error ("Not a serial process");
2485 if (NILP (Fplist_get (p
->childp
, QCspeed
)))
2491 serial_configure (p
, contact
);
2497 /* Used by make-serial-process to recover from errors. */
2499 make_serial_process_unwind (Lisp_Object proc
)
2501 if (!PROCESSP (proc
))
2503 remove_process (proc
);
2507 DEFUN ("make-serial-process", Fmake_serial_process
, Smake_serial_process
,
2509 doc
: /* Create and return a serial port process.
2511 In Emacs, serial port connections are represented by process objects,
2512 so input and output work as for subprocesses, and `delete-process'
2513 closes a serial port connection. However, a serial process has no
2514 process id, it cannot be signaled, and the status codes are different
2515 from normal processes.
2517 `make-serial-process' creates a process and a buffer, on which you
2518 probably want to use `process-send-string'. Try \\[serial-term] for
2519 an interactive terminal. See below for examples.
2521 Arguments are specified as keyword/argument pairs. The following
2522 arguments are defined:
2524 :port PORT -- (mandatory) PORT is the path or name of the serial port.
2525 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
2526 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
2527 the backslashes in strings).
2529 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
2530 which this function calls.
2532 :name NAME -- NAME is the name of the process. If NAME is not given,
2533 the value of PORT is used.
2535 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2536 with the process. Process output goes at the end of that buffer,
2537 unless you specify an output stream or filter function to handle the
2538 output. If BUFFER is not given, the value of NAME is used.
2540 :coding CODING -- If CODING is a symbol, it specifies the coding
2541 system used for both reading and writing for this process. If CODING
2542 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2543 ENCODING is used for writing.
2545 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2546 the process is running. If BOOL is not given, query before exiting.
2548 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
2549 In the stopped state, a serial process does not accept incoming data,
2550 but you can send outgoing data. The stopped state is cleared by
2551 `continue-process' and set by `stop-process'.
2553 :filter FILTER -- Install FILTER as the process filter.
2555 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2557 :plist PLIST -- Install PLIST as the initial plist of the process.
2563 -- This function calls `serial-process-configure' to handle these
2566 The original argument list, possibly modified by later configuration,
2567 is available via the function `process-contact'.
2571 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
2573 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
2575 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity 'odd)
2577 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
2579 usage: (make-serial-process &rest ARGS) */)
2580 (ptrdiff_t nargs
, Lisp_Object
*args
)
2583 Lisp_Object proc
, contact
, port
;
2584 struct Lisp_Process
*p
;
2585 struct gcpro gcpro1
;
2586 Lisp_Object name
, buffer
;
2587 Lisp_Object tem
, val
;
2588 ptrdiff_t specpdl_count
= -1;
2593 contact
= Flist (nargs
, args
);
2596 port
= Fplist_get (contact
, QCport
);
2598 error ("No port specified");
2599 CHECK_STRING (port
);
2601 if (NILP (Fplist_member (contact
, QCspeed
)))
2602 error (":speed not specified");
2603 if (!NILP (Fplist_get (contact
, QCspeed
)))
2604 CHECK_NUMBER (Fplist_get (contact
, QCspeed
));
2606 name
= Fplist_get (contact
, QCname
);
2609 CHECK_STRING (name
);
2610 proc
= make_process (name
);
2611 specpdl_count
= SPECPDL_INDEX ();
2612 record_unwind_protect (make_serial_process_unwind
, proc
);
2613 p
= XPROCESS (proc
);
2615 fd
= serial_open (SSDATA (port
));
2618 if (fd
> max_process_desc
)
2619 max_process_desc
= fd
;
2620 chan_process
[fd
] = proc
;
2622 buffer
= Fplist_get (contact
, QCbuffer
);
2625 buffer
= Fget_buffer_create (buffer
);
2626 pset_buffer (p
, buffer
);
2628 pset_childp (p
, contact
);
2629 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
2630 pset_type (p
, Qserial
);
2631 pset_sentinel (p
, Fplist_get (contact
, QCsentinel
));
2632 pset_filter (p
, Fplist_get (contact
, QCfilter
));
2634 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
2635 p
->kill_without_query
= 1;
2636 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
2637 pset_command (p
, Qt
);
2640 if (!EQ (p
->command
, Qt
))
2642 FD_SET (fd
, &input_wait_mask
);
2643 FD_SET (fd
, &non_keyboard_wait_mask
);
2646 if (BUFFERP (buffer
))
2648 set_marker_both (p
->mark
, buffer
,
2649 BUF_ZV (XBUFFER (buffer
)),
2650 BUF_ZV_BYTE (XBUFFER (buffer
)));
2653 tem
= Fplist_member (contact
, QCcoding
);
2654 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
2660 val
= XCAR (XCDR (tem
));
2664 else if (!NILP (Vcoding_system_for_read
))
2665 val
= Vcoding_system_for_read
;
2666 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2667 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2669 pset_decode_coding_system (p
, val
);
2674 val
= XCAR (XCDR (tem
));
2678 else if (!NILP (Vcoding_system_for_write
))
2679 val
= Vcoding_system_for_write
;
2680 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2681 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2683 pset_encode_coding_system (p
, val
);
2685 setup_process_coding_systems (proc
);
2686 pset_decoding_buf (p
, empty_unibyte_string
);
2687 p
->decoding_carryover
= 0;
2688 pset_encoding_buf (p
, empty_unibyte_string
);
2689 p
->inherit_coding_system_flag
2690 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
2692 Fserial_process_configure (nargs
, args
);
2694 specpdl_ptr
= specpdl
+ specpdl_count
;
2700 /* Create a network stream/datagram client/server process. Treated
2701 exactly like a normal process when reading and writing. Primary
2702 differences are in status display and process deletion. A network
2703 connection has no PID; you cannot signal it. All you can do is
2704 stop/continue it and deactivate/close it via delete-process */
2706 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2708 doc
: /* Create and return a network server or client process.
2710 In Emacs, network connections are represented by process objects, so
2711 input and output work as for subprocesses and `delete-process' closes
2712 a network connection. However, a network process has no process id,
2713 it cannot be signaled, and the status codes are different from normal
2716 Arguments are specified as keyword/argument pairs. The following
2717 arguments are defined:
2719 :name NAME -- NAME is name for process. It is modified if necessary
2722 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2723 with the process. Process output goes at end of that buffer, unless
2724 you specify an output stream or filter function to handle the output.
2725 BUFFER may be also nil, meaning that this process is not associated
2728 :host HOST -- HOST is name of the host to connect to, or its IP
2729 address. The symbol `local' specifies the local host. If specified
2730 for a server process, it must be a valid name or address for the local
2731 host, and only clients connecting to that address will be accepted.
2733 :service SERVICE -- SERVICE is name of the service desired, or an
2734 integer specifying a port number to connect to. If SERVICE is t,
2735 a random port number is selected for the server. (If Emacs was
2736 compiled with getaddrinfo, a port number can also be specified as a
2737 string, e.g. "80", as well as an integer. This is not portable.)
2739 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2740 stream type connection, `datagram' creates a datagram type connection,
2741 `seqpacket' creates a reliable datagram connection.
2743 :family FAMILY -- FAMILY is the address (and protocol) family for the
2744 service specified by HOST and SERVICE. The default (nil) is to use
2745 whatever address family (IPv4 or IPv6) that is defined for the host
2746 and port number specified by HOST and SERVICE. Other address families
2748 local -- for a local (i.e. UNIX) address specified by SERVICE.
2749 ipv4 -- use IPv4 address family only.
2750 ipv6 -- use IPv6 address family only.
2752 :local ADDRESS -- ADDRESS is the local address used for the connection.
2753 This parameter is ignored when opening a client process. When specified
2754 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2756 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2757 connection. This parameter is ignored when opening a stream server
2758 process. For a datagram server process, it specifies the initial
2759 setting of the remote datagram address. When specified for a client
2760 process, the FAMILY, HOST, and SERVICE args are ignored.
2762 The format of ADDRESS depends on the address family:
2763 - An IPv4 address is represented as an vector of integers [A B C D P]
2764 corresponding to numeric IP address A.B.C.D and port number P.
2765 - A local address is represented as a string with the address in the
2766 local address space.
2767 - An "unsupported family" address is represented by a cons (F . AV)
2768 where F is the family number and AV is a vector containing the socket
2769 address data with one element per address data byte. Do not rely on
2770 this format in portable code, as it may depend on implementation
2771 defined constants, data sizes, and data structure alignment.
2773 :coding CODING -- If CODING is a symbol, it specifies the coding
2774 system used for both reading and writing for this process. If CODING
2775 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2776 ENCODING is used for writing.
2778 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2779 return without waiting for the connection to complete; instead, the
2780 sentinel function will be called with second arg matching "open" (if
2781 successful) or "failed" when the connect completes. Default is to use
2782 a blocking connect (i.e. wait) for stream type connections.
2784 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2785 running when Emacs is exited.
2787 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2788 In the stopped state, a server process does not accept new
2789 connections, and a client process does not handle incoming traffic.
2790 The stopped state is cleared by `continue-process' and set by
2793 :filter FILTER -- Install FILTER as the process filter.
2795 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2796 process filter are multibyte, otherwise they are unibyte.
2797 If this keyword is not specified, the strings are multibyte if
2798 the default value of `enable-multibyte-characters' is non-nil.
2800 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2802 :log LOG -- Install LOG as the server process log function. This
2803 function is called when the server accepts a network connection from a
2804 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2805 is the server process, CLIENT is the new process for the connection,
2806 and MESSAGE is a string.
2808 :plist PLIST -- Install PLIST as the new process' initial plist.
2810 :server QLEN -- if QLEN is non-nil, create a server process for the
2811 specified FAMILY, SERVICE, and connection type (stream or datagram).
2812 If QLEN is an integer, it is used as the max. length of the server's
2813 pending connection queue (also known as the backlog); the default
2814 queue length is 5. Default is to create a client process.
2816 The following network options can be specified for this connection:
2818 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2819 :dontroute BOOL -- Only send to directly connected hosts.
2820 :keepalive BOOL -- Send keep-alive messages on network stream.
2821 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2822 :oobinline BOOL -- Place out-of-band data in receive data stream.
2823 :priority INT -- Set protocol defined priority for sent packets.
2824 :reuseaddr BOOL -- Allow reusing a recently used local address
2825 (this is allowed by default for a server process).
2826 :bindtodevice NAME -- bind to interface NAME. Using this may require
2827 special privileges on some systems.
2829 Consult the relevant system programmer's manual pages for more
2830 information on using these options.
2833 A server process will listen for and accept connections from clients.
2834 When a client connection is accepted, a new network process is created
2835 for the connection with the following parameters:
2837 - The client's process name is constructed by concatenating the server
2838 process' NAME and a client identification string.
2839 - If the FILTER argument is non-nil, the client process will not get a
2840 separate process buffer; otherwise, the client's process buffer is a newly
2841 created buffer named after the server process' BUFFER name or process
2842 NAME concatenated with the client identification string.
2843 - The connection type and the process filter and sentinel parameters are
2844 inherited from the server process' TYPE, FILTER and SENTINEL.
2845 - The client process' contact info is set according to the client's
2846 addressing information (typically an IP address and a port number).
2847 - The client process' plist is initialized from the server's plist.
2849 Notice that the FILTER and SENTINEL args are never used directly by
2850 the server process. Also, the BUFFER argument is not used directly by
2851 the server process, but via the optional :log function, accepted (and
2852 failed) connections may be logged in the server process' buffer.
2854 The original argument list, modified with the actual connection
2855 information, is available via the `process-contact' function.
2857 usage: (make-network-process &rest ARGS) */)
2858 (ptrdiff_t nargs
, Lisp_Object
*args
)
2861 Lisp_Object contact
;
2862 struct Lisp_Process
*p
;
2863 #ifdef HAVE_GETADDRINFO
2864 struct addrinfo ai
, *res
, *lres
;
2865 struct addrinfo hints
;
2866 const char *portstring
;
2868 #else /* HAVE_GETADDRINFO */
2869 struct _emacs_addrinfo
2875 struct sockaddr
*ai_addr
;
2876 struct _emacs_addrinfo
*ai_next
;
2878 #endif /* HAVE_GETADDRINFO */
2879 struct sockaddr_in address_in
;
2880 #ifdef HAVE_LOCAL_SOCKETS
2881 struct sockaddr_un address_un
;
2886 int s
= -1, outch
, inch
;
2887 struct gcpro gcpro1
;
2888 ptrdiff_t count
= SPECPDL_INDEX ();
2890 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2892 Lisp_Object name
, buffer
, host
, service
, address
;
2893 Lisp_Object filter
, sentinel
;
2894 int is_non_blocking_client
= 0;
2895 int is_server
= 0, backlog
= 5;
2902 /* Save arguments for process-contact and clone-process. */
2903 contact
= Flist (nargs
, args
);
2907 /* Ensure socket support is loaded if available. */
2908 init_winsock (TRUE
);
2911 /* :type TYPE (nil: stream, datagram */
2912 tem
= Fplist_get (contact
, QCtype
);
2914 socktype
= SOCK_STREAM
;
2915 #ifdef DATAGRAM_SOCKETS
2916 else if (EQ (tem
, Qdatagram
))
2917 socktype
= SOCK_DGRAM
;
2919 #ifdef HAVE_SEQPACKET
2920 else if (EQ (tem
, Qseqpacket
))
2921 socktype
= SOCK_SEQPACKET
;
2924 error ("Unsupported connection type");
2927 tem
= Fplist_get (contact
, QCserver
);
2930 /* Don't support network sockets when non-blocking mode is
2931 not available, since a blocked Emacs is not useful. */
2932 #if !defined (O_NONBLOCK) && !defined (O_NDELAY)
2933 error ("Network servers not supported");
2936 if (TYPE_RANGED_INTEGERP (int, tem
))
2937 backlog
= XINT (tem
);
2941 /* Make QCaddress an alias for :local (server) or :remote (client). */
2942 QCaddress
= is_server
? QClocal
: QCremote
;
2945 if (!is_server
&& socktype
!= SOCK_DGRAM
2946 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2948 #ifndef NON_BLOCKING_CONNECT
2949 error ("Non-blocking connect not supported");
2951 is_non_blocking_client
= 1;
2955 name
= Fplist_get (contact
, QCname
);
2956 buffer
= Fplist_get (contact
, QCbuffer
);
2957 filter
= Fplist_get (contact
, QCfilter
);
2958 sentinel
= Fplist_get (contact
, QCsentinel
);
2960 CHECK_STRING (name
);
2962 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2963 ai
.ai_socktype
= socktype
;
2968 /* :local ADDRESS or :remote ADDRESS */
2969 address
= Fplist_get (contact
, QCaddress
);
2970 if (!NILP (address
))
2972 host
= service
= Qnil
;
2974 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2975 error ("Malformed :address");
2976 ai
.ai_family
= family
;
2977 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2978 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2982 /* :family FAMILY -- nil (for Inet), local, or integer. */
2983 tem
= Fplist_get (contact
, QCfamily
);
2986 #if defined (HAVE_GETADDRINFO) && defined (AF_INET6)
2992 #ifdef HAVE_LOCAL_SOCKETS
2993 else if (EQ (tem
, Qlocal
))
2997 else if (EQ (tem
, Qipv6
))
3000 else if (EQ (tem
, Qipv4
))
3002 else if (TYPE_RANGED_INTEGERP (int, tem
))
3003 family
= XINT (tem
);
3005 error ("Unknown address family");
3007 ai
.ai_family
= family
;
3009 /* :service SERVICE -- string, integer (port number), or t (random port). */
3010 service
= Fplist_get (contact
, QCservice
);
3012 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3013 host
= Fplist_get (contact
, QChost
);
3016 if (EQ (host
, Qlocal
))
3017 /* Depending on setup, "localhost" may map to different IPv4 and/or
3018 IPv6 addresses, so it's better to be explicit. (Bug#6781) */
3019 host
= build_string ("127.0.0.1");
3020 CHECK_STRING (host
);
3023 #ifdef HAVE_LOCAL_SOCKETS
3024 if (family
== AF_LOCAL
)
3028 message (":family local ignores the :host \"%s\" property",
3030 contact
= Fplist_put (contact
, QChost
, Qnil
);
3033 CHECK_STRING (service
);
3034 memset (&address_un
, 0, sizeof address_un
);
3035 address_un
.sun_family
= AF_LOCAL
;
3036 if (sizeof address_un
.sun_path
<= SBYTES (service
))
3037 error ("Service name too long");
3038 strcpy (address_un
.sun_path
, SSDATA (service
));
3039 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
3040 ai
.ai_addrlen
= sizeof address_un
;
3045 /* Slow down polling to every ten seconds.
3046 Some kernels have a bug which causes retrying connect to fail
3047 after a connect. Polling can interfere with gethostbyname too. */
3048 #ifdef POLL_FOR_INPUT
3049 if (socktype
!= SOCK_DGRAM
)
3051 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
3052 bind_polling_period (10);
3056 #ifdef HAVE_GETADDRINFO
3057 /* If we have a host, use getaddrinfo to resolve both host and service.
3058 Otherwise, use getservbyname to lookup the service. */
3062 /* SERVICE can either be a string or int.
3063 Convert to a C string for later use by getaddrinfo. */
3064 if (EQ (service
, Qt
))
3066 else if (INTEGERP (service
))
3068 sprintf (portbuf
, "%"pI
"d", XINT (service
));
3069 portstring
= portbuf
;
3073 CHECK_STRING (service
);
3074 portstring
= SSDATA (service
);
3079 memset (&hints
, 0, sizeof (hints
));
3081 hints
.ai_family
= family
;
3082 hints
.ai_socktype
= socktype
;
3083 hints
.ai_protocol
= 0;
3085 #ifdef HAVE_RES_INIT
3089 ret
= getaddrinfo (SSDATA (host
), portstring
, &hints
, &res
);
3091 #ifdef HAVE_GAI_STRERROR
3092 error ("%s/%s %s", SSDATA (host
), portstring
, gai_strerror (ret
));
3094 error ("%s/%s getaddrinfo error %d", SSDATA (host
), portstring
, ret
);
3100 #endif /* HAVE_GETADDRINFO */
3102 /* We end up here if getaddrinfo is not defined, or in case no hostname
3103 has been specified (e.g. for a local server process). */
3105 if (EQ (service
, Qt
))
3107 else if (INTEGERP (service
))
3108 port
= htons ((unsigned short) XINT (service
));
3111 struct servent
*svc_info
;
3112 CHECK_STRING (service
);
3113 svc_info
= getservbyname (SSDATA (service
),
3114 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3116 error ("Unknown service: %s", SDATA (service
));
3117 port
= svc_info
->s_port
;
3120 memset (&address_in
, 0, sizeof address_in
);
3121 address_in
.sin_family
= family
;
3122 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3123 address_in
.sin_port
= port
;
3125 #ifndef HAVE_GETADDRINFO
3128 struct hostent
*host_info_ptr
;
3130 /* gethostbyname may fail with TRY_AGAIN, but we don't honor that,
3131 as it may `hang' Emacs for a very long time. */
3135 #ifdef HAVE_RES_INIT
3139 host_info_ptr
= gethostbyname (SDATA (host
));
3144 memcpy (&address_in
.sin_addr
, host_info_ptr
->h_addr
,
3145 host_info_ptr
->h_length
);
3146 family
= host_info_ptr
->h_addrtype
;
3147 address_in
.sin_family
= family
;
3150 /* Attempt to interpret host as numeric inet address */
3152 unsigned long numeric_addr
;
3153 numeric_addr
= inet_addr (SSDATA (host
));
3154 if (numeric_addr
== -1)
3155 error ("Unknown host \"%s\"", SDATA (host
));
3157 memcpy (&address_in
.sin_addr
, &numeric_addr
,
3158 sizeof (address_in
.sin_addr
));
3162 #endif /* not HAVE_GETADDRINFO */
3164 ai
.ai_family
= family
;
3165 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3166 ai
.ai_addrlen
= sizeof address_in
;
3170 /* Do this in case we never enter the for-loop below. */
3171 count1
= SPECPDL_INDEX ();
3174 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3183 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3190 #ifdef DATAGRAM_SOCKETS
3191 if (!is_server
&& socktype
== SOCK_DGRAM
)
3193 #endif /* DATAGRAM_SOCKETS */
3195 #ifdef NON_BLOCKING_CONNECT
3196 if (is_non_blocking_client
)
3199 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3201 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3213 /* Make us close S if quit. */
3214 record_unwind_protect (close_file_unwind
, make_number (s
));
3216 /* Parse network options in the arg list.
3217 We simply ignore anything which isn't a known option (including other keywords).
3218 An error is signaled if setting a known option fails. */
3219 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3220 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3224 /* Configure as a server socket. */
3226 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3227 explicit :reuseaddr key to override this. */
3228 #ifdef HAVE_LOCAL_SOCKETS
3229 if (family
!= AF_LOCAL
)
3231 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3234 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3235 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3238 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3239 report_file_error ("Cannot bind server socket", Qnil
);
3241 #ifdef HAVE_GETSOCKNAME
3242 if (EQ (service
, Qt
))
3244 struct sockaddr_in sa1
;
3245 socklen_t len1
= sizeof (sa1
);
3246 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3248 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3249 service
= make_number (ntohs (sa1
.sin_port
));
3250 contact
= Fplist_put (contact
, QCservice
, service
);
3255 if (socktype
!= SOCK_DGRAM
&& listen (s
, backlog
))
3256 report_file_error ("Cannot listen on server socket", Qnil
);
3264 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3267 if (ret
== 0 || xerrno
== EISCONN
)
3269 /* The unwind-protect will be discarded afterwards.
3270 Likewise for immediate_quit. */
3274 #ifdef NON_BLOCKING_CONNECT
3276 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3280 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3287 if (xerrno
== EINTR
)
3289 /* Unlike most other syscalls connect() cannot be called
3290 again. (That would return EALREADY.) The proper way to
3291 wait for completion is pselect(). */
3299 sc
= pselect (s
+ 1, NULL
, &fdset
, NULL
, NULL
, NULL
);
3305 report_file_error ("select failed", Qnil
);
3309 len
= sizeof xerrno
;
3310 eassert (FD_ISSET (s
, &fdset
));
3311 if (getsockopt (s
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &len
) == -1)
3312 report_file_error ("getsockopt failed", Qnil
);
3314 errno
= xerrno
, report_file_error ("error during connect", Qnil
);
3318 #endif /* !WINDOWSNT */
3322 /* Discard the unwind protect closing S. */
3323 specpdl_ptr
= specpdl
+ count1
;
3328 if (xerrno
== EINTR
)
3335 #ifdef DATAGRAM_SOCKETS
3336 if (socktype
== SOCK_DGRAM
)
3338 if (datagram_address
[s
].sa
)
3340 datagram_address
[s
].sa
= xmalloc (lres
->ai_addrlen
);
3341 datagram_address
[s
].len
= lres
->ai_addrlen
;
3345 memset (datagram_address
[s
].sa
, 0, lres
->ai_addrlen
);
3346 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3349 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3350 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3351 conv_lisp_to_sockaddr (rfamily
, remote
,
3352 datagram_address
[s
].sa
, rlen
);
3356 memcpy (datagram_address
[s
].sa
, lres
->ai_addr
, lres
->ai_addrlen
);
3359 contact
= Fplist_put (contact
, QCaddress
,
3360 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3361 #ifdef HAVE_GETSOCKNAME
3364 struct sockaddr_in sa1
;
3365 socklen_t len1
= sizeof (sa1
);
3366 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3367 contact
= Fplist_put (contact
, QClocal
,
3368 conv_sockaddr_to_lisp ((struct sockaddr
*)&sa1
, len1
));
3375 #ifdef HAVE_GETADDRINFO
3384 /* Discard the unwind protect for closing S, if any. */
3385 specpdl_ptr
= specpdl
+ count1
;
3387 /* Unwind bind_polling_period and request_sigio. */
3388 unbind_to (count
, Qnil
);
3392 /* If non-blocking got this far - and failed - assume non-blocking is
3393 not supported after all. This is probably a wrong assumption, but
3394 the normal blocking calls to open-network-stream handles this error
3396 if (is_non_blocking_client
)
3401 report_file_error ("make server process failed", contact
);
3403 report_file_error ("make client process failed", contact
);
3410 buffer
= Fget_buffer_create (buffer
);
3411 proc
= make_process (name
);
3413 chan_process
[inch
] = proc
;
3416 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3419 fcntl (inch
, F_SETFL
, O_NDELAY
);
3423 p
= XPROCESS (proc
);
3425 pset_childp (p
, contact
);
3426 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
3427 pset_type (p
, Qnetwork
);
3429 pset_buffer (p
, buffer
);
3430 pset_sentinel (p
, sentinel
);
3431 pset_filter (p
, filter
);
3432 pset_log (p
, Fplist_get (contact
, QClog
));
3433 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3434 p
->kill_without_query
= 1;
3435 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3436 pset_command (p
, Qt
);
3440 if (is_server
&& socktype
!= SOCK_DGRAM
)
3441 pset_status (p
, Qlisten
);
3443 /* Make the process marker point into the process buffer (if any). */
3444 if (BUFFERP (buffer
))
3445 set_marker_both (p
->mark
, buffer
,
3446 BUF_ZV (XBUFFER (buffer
)),
3447 BUF_ZV_BYTE (XBUFFER (buffer
)));
3449 #ifdef NON_BLOCKING_CONNECT
3450 if (is_non_blocking_client
)
3452 /* We may get here if connect did succeed immediately. However,
3453 in that case, we still need to signal this like a non-blocking
3455 pset_status (p
, Qconnect
);
3456 if (!FD_ISSET (inch
, &connect_wait_mask
))
3458 FD_SET (inch
, &connect_wait_mask
);
3459 FD_SET (inch
, &write_mask
);
3460 num_pending_connects
++;
3465 /* A server may have a client filter setting of Qt, but it must
3466 still listen for incoming connects unless it is stopped. */
3467 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3468 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3470 FD_SET (inch
, &input_wait_mask
);
3471 FD_SET (inch
, &non_keyboard_wait_mask
);
3474 if (inch
> max_process_desc
)
3475 max_process_desc
= inch
;
3477 tem
= Fplist_member (contact
, QCcoding
);
3478 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3479 tem
= Qnil
; /* No error message (too late!). */
3482 /* Setup coding systems for communicating with the network stream. */
3483 struct gcpro gcpro1
;
3484 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3485 Lisp_Object coding_systems
= Qt
;
3486 Lisp_Object fargs
[5], val
;
3490 val
= XCAR (XCDR (tem
));
3494 else if (!NILP (Vcoding_system_for_read
))
3495 val
= Vcoding_system_for_read
;
3496 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
3497 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
3498 /* We dare not decode end-of-line format by setting VAL to
3499 Qraw_text, because the existing Emacs Lisp libraries
3500 assume that they receive bare code including a sequence of
3505 if (NILP (host
) || NILP (service
))
3506 coding_systems
= Qnil
;
3509 fargs
[0] = Qopen_network_stream
, fargs
[1] = name
,
3510 fargs
[2] = buffer
, fargs
[3] = host
, fargs
[4] = service
;
3512 coding_systems
= Ffind_operation_coding_system (5, fargs
);
3515 if (CONSP (coding_systems
))
3516 val
= XCAR (coding_systems
);
3517 else if (CONSP (Vdefault_process_coding_system
))
3518 val
= XCAR (Vdefault_process_coding_system
);
3522 pset_decode_coding_system (p
, val
);
3526 val
= XCAR (XCDR (tem
));
3530 else if (!NILP (Vcoding_system_for_write
))
3531 val
= Vcoding_system_for_write
;
3532 else if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3536 if (EQ (coding_systems
, Qt
))
3538 if (NILP (host
) || NILP (service
))
3539 coding_systems
= Qnil
;
3542 fargs
[0] = Qopen_network_stream
, fargs
[1] = name
,
3543 fargs
[2] = buffer
, fargs
[3] = host
, fargs
[4] = service
;
3545 coding_systems
= Ffind_operation_coding_system (5, fargs
);
3549 if (CONSP (coding_systems
))
3550 val
= XCDR (coding_systems
);
3551 else if (CONSP (Vdefault_process_coding_system
))
3552 val
= XCDR (Vdefault_process_coding_system
);
3556 pset_encode_coding_system (p
, val
);
3558 setup_process_coding_systems (proc
);
3560 pset_decoding_buf (p
, empty_unibyte_string
);
3561 p
->decoding_carryover
= 0;
3562 pset_encoding_buf (p
, empty_unibyte_string
);
3564 p
->inherit_coding_system_flag
3565 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
3572 #if defined (HAVE_NET_IF_H)
3575 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3576 doc
: /* Return an alist of all network interfaces and their network address.
3577 Each element is a cons, the car of which is a string containing the
3578 interface name, and the cdr is the network address in internal
3579 format; see the description of ADDRESS in `make-network-process'. */)
3582 struct ifconf ifconf
;
3583 struct ifreq
*ifreq
;
3585 ptrdiff_t buf_size
= 512;
3589 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3595 buf
= xpalloc (buf
, &buf_size
, 1, INT_MAX
, 1);
3596 ifconf
.ifc_buf
= buf
;
3597 ifconf
.ifc_len
= buf_size
;
3598 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3605 while (ifconf
.ifc_len
== buf_size
);
3610 ifreq
= ifconf
.ifc_req
;
3611 while ((char *) ifreq
< (char *) ifconf
.ifc_req
+ ifconf
.ifc_len
)
3613 struct ifreq
*ifq
= ifreq
;
3614 #ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
3615 #define SIZEOF_IFREQ(sif) \
3616 ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \
3617 ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len)
3619 int len
= SIZEOF_IFREQ (ifq
);
3621 int len
= sizeof (*ifreq
);
3623 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3625 ifreq
= (struct ifreq
*) ((char *) ifreq
+ len
);
3627 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3630 memcpy (namebuf
, ifq
->ifr_name
, sizeof (ifq
->ifr_name
));
3631 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3632 res
= Fcons (Fcons (build_string (namebuf
),
3633 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3634 sizeof (struct sockaddr
))),
3641 #endif /* SIOCGIFCONF */
3643 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
3647 const char *flag_sym
;
3650 static const struct ifflag_def ifflag_table
[] = {
3654 #ifdef IFF_BROADCAST
3655 { IFF_BROADCAST
, "broadcast" },
3658 { IFF_DEBUG
, "debug" },
3661 { IFF_LOOPBACK
, "loopback" },
3663 #ifdef IFF_POINTOPOINT
3664 { IFF_POINTOPOINT
, "pointopoint" },
3667 { IFF_RUNNING
, "running" },
3670 { IFF_NOARP
, "noarp" },
3673 { IFF_PROMISC
, "promisc" },
3675 #ifdef IFF_NOTRAILERS
3676 #ifdef NS_IMPL_COCOA
3677 /* Really means smart, notrailers is obsolete */
3678 { IFF_NOTRAILERS
, "smart" },
3680 { IFF_NOTRAILERS
, "notrailers" },
3684 { IFF_ALLMULTI
, "allmulti" },
3687 { IFF_MASTER
, "master" },
3690 { IFF_SLAVE
, "slave" },
3692 #ifdef IFF_MULTICAST
3693 { IFF_MULTICAST
, "multicast" },
3696 { IFF_PORTSEL
, "portsel" },
3698 #ifdef IFF_AUTOMEDIA
3699 { IFF_AUTOMEDIA
, "automedia" },
3702 { IFF_DYNAMIC
, "dynamic" },
3705 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3708 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3711 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3714 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3717 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3722 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3723 doc
: /* Return information about network interface named IFNAME.
3724 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3725 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3726 NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
3727 FLAGS is the current flags of the interface. */)
3728 (Lisp_Object ifname
)
3731 Lisp_Object res
= Qnil
;
3735 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
3736 && defined HAVE_GETIFADDRS && defined LLADDR)
3737 struct ifaddrs
*ifap
;
3740 CHECK_STRING (ifname
);
3742 if (sizeof rq
.ifr_name
<= SBYTES (ifname
))
3743 error ("interface name too long");
3744 strcpy (rq
.ifr_name
, SSDATA (ifname
));
3746 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3751 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
3752 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3754 int flags
= rq
.ifr_flags
;
3755 const struct ifflag_def
*fp
;
3758 /* If flags is smaller than int (i.e. short) it may have the high bit set
3759 due to IFF_MULTICAST. In that case, sign extending it into
3761 if (flags
< 0 && sizeof (rq
.ifr_flags
) < sizeof (flags
))
3762 flags
= (unsigned short) rq
.ifr_flags
;
3765 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3767 if (flags
& fp
->flag_bit
)
3769 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3770 flags
-= fp
->flag_bit
;
3773 for (fnum
= 0; flags
&& fnum
< 32; flags
>>= 1, fnum
++)
3777 elt
= Fcons (make_number (fnum
), elt
);
3782 res
= Fcons (elt
, res
);
3785 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
3786 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3788 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3789 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3793 for (n
= 0; n
< 6; n
++)
3794 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3795 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3797 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
3798 if (getifaddrs (&ifap
) != -1)
3800 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3801 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3804 for (it
= ifap
; it
!= NULL
; it
= it
->ifa_next
)
3806 struct sockaddr_dl
*sdl
= (struct sockaddr_dl
*) it
->ifa_addr
;
3807 unsigned char linkaddr
[6];
3810 if (it
->ifa_addr
->sa_family
!= AF_LINK
3811 || strcmp (it
->ifa_name
, SSDATA (ifname
)) != 0
3812 || sdl
->sdl_alen
!= 6)
3815 memcpy (linkaddr
, LLADDR (sdl
), sdl
->sdl_alen
);
3816 for (n
= 0; n
< 6; n
++)
3817 p
->contents
[n
] = make_number (linkaddr
[n
]);
3819 elt
= Fcons (make_number (it
->ifa_addr
->sa_family
), hwaddr
);
3823 #ifdef HAVE_FREEIFADDRS
3827 #endif /* HAVE_GETIFADDRS && LLADDR */
3829 res
= Fcons (elt
, res
);
3832 #if defined (SIOCGIFNETMASK) && (defined (HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined (HAVE_STRUCT_IFREQ_IFR_ADDR))
3833 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3836 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3837 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3839 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3843 res
= Fcons (elt
, res
);
3846 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3847 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3850 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3853 res
= Fcons (elt
, res
);
3856 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
3857 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3860 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3863 res
= Fcons (elt
, res
);
3867 return any
? res
: Qnil
;
3870 #endif /* defined (HAVE_NET_IF_H) */
3872 /* Turn off input and output for process PROC. */
3875 deactivate_process (Lisp_Object proc
)
3877 register int inchannel
, outchannel
;
3878 register struct Lisp_Process
*p
= XPROCESS (proc
);
3881 /* Delete GnuTLS structures in PROC, if any. */
3882 emacs_gnutls_deinit (proc
);
3883 #endif /* HAVE_GNUTLS */
3885 inchannel
= p
->infd
;
3886 outchannel
= p
->outfd
;
3888 #ifdef ADAPTIVE_READ_BUFFERING
3889 if (p
->read_output_delay
> 0)
3891 if (--process_output_delay_count
< 0)
3892 process_output_delay_count
= 0;
3893 p
->read_output_delay
= 0;
3894 p
->read_output_skip
= 0;
3900 /* Beware SIGCHLD hereabouts. */
3901 flush_pending_output (inchannel
);
3902 emacs_close (inchannel
);
3903 if (outchannel
>= 0 && outchannel
!= inchannel
)
3904 emacs_close (outchannel
);
3908 #ifdef DATAGRAM_SOCKETS
3909 if (DATAGRAM_CHAN_P (inchannel
))
3911 xfree (datagram_address
[inchannel
].sa
);
3912 datagram_address
[inchannel
].sa
= 0;
3913 datagram_address
[inchannel
].len
= 0;
3916 chan_process
[inchannel
] = Qnil
;
3917 FD_CLR (inchannel
, &input_wait_mask
);
3918 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3919 #ifdef NON_BLOCKING_CONNECT
3920 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3922 FD_CLR (inchannel
, &connect_wait_mask
);
3923 FD_CLR (inchannel
, &write_mask
);
3924 if (--num_pending_connects
< 0)
3928 if (inchannel
== max_process_desc
)
3931 /* We just closed the highest-numbered process input descriptor,
3932 so recompute the highest-numbered one now. */
3933 max_process_desc
= 0;
3934 for (i
= 0; i
< MAXDESC
; i
++)
3935 if (!NILP (chan_process
[i
]))
3936 max_process_desc
= i
;
3942 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3944 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3945 It is read into the process' buffers or given to their filter functions.
3946 Non-nil arg PROCESS means do not return until some output has been received
3949 Non-nil second arg SECONDS and third arg MILLISEC are number of seconds
3950 and milliseconds to wait; return after that much time whether or not
3951 there is any subprocess output. If SECONDS is a floating point number,
3952 it specifies a fractional number of seconds to wait.
3953 The MILLISEC argument is obsolete and should be avoided.
3955 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3956 from PROCESS, suspending reading output from other processes.
3957 If JUST-THIS-ONE is an integer, don't run any timers either.
3958 Return non-nil if we received any output before the timeout expired. */)
3959 (register Lisp_Object process
, Lisp_Object seconds
, Lisp_Object millisec
, Lisp_Object just_this_one
)
3964 if (! NILP (process
))
3965 CHECK_PROCESS (process
);
3967 just_this_one
= Qnil
;
3969 if (!NILP (millisec
))
3970 { /* Obsolete calling convention using integers rather than floats. */
3971 CHECK_NUMBER (millisec
);
3973 seconds
= make_float (XINT (millisec
) / 1000.0);
3976 CHECK_NUMBER (seconds
);
3977 seconds
= make_float (XINT (millisec
) / 1000.0 + XINT (seconds
));
3984 if (!NILP (seconds
))
3986 if (INTEGERP (seconds
))
3988 if (0 < XINT (seconds
))
3990 secs
= XINT (seconds
);
3994 else if (FLOATP (seconds
))
3996 if (0 < XFLOAT_DATA (seconds
))
3998 EMACS_TIME t
= EMACS_TIME_FROM_DOUBLE (XFLOAT_DATA (seconds
));
3999 secs
= min (EMACS_SECS (t
), WAIT_READING_MAX
);
4000 nsecs
= EMACS_NSECS (t
);
4004 wrong_type_argument (Qnumberp
, seconds
);
4006 else if (! NILP (process
))
4010 (wait_reading_process_output (secs
, nsecs
, 0, 0,
4012 !NILP (process
) ? XPROCESS (process
) : NULL
,
4013 NILP (just_this_one
) ? 0 :
4014 !INTEGERP (just_this_one
) ? 1 : -1)
4018 /* Accept a connection for server process SERVER on CHANNEL. */
4020 static int connect_counter
= 0;
4023 server_accept_connection (Lisp_Object server
, int channel
)
4025 Lisp_Object proc
, caller
, name
, buffer
;
4026 Lisp_Object contact
, host
, service
;
4027 struct Lisp_Process
*ps
= XPROCESS (server
);
4028 struct Lisp_Process
*p
;
4032 struct sockaddr_in in
;
4034 struct sockaddr_in6 in6
;
4036 #ifdef HAVE_LOCAL_SOCKETS
4037 struct sockaddr_un un
;
4040 socklen_t len
= sizeof saddr
;
4042 s
= accept (channel
, &saddr
.sa
, &len
);
4051 if (code
== EWOULDBLOCK
)
4055 if (!NILP (ps
->log
))
4056 call3 (ps
->log
, server
, Qnil
,
4057 concat3 (build_string ("accept failed with code"),
4058 Fnumber_to_string (make_number (code
)),
4059 build_string ("\n")));
4065 /* Setup a new process to handle the connection. */
4067 /* Generate a unique identification of the caller, and build contact
4068 information for this process. */
4071 switch (saddr
.sa
.sa_family
)
4075 Lisp_Object args
[5];
4076 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4077 args
[0] = build_string ("%d.%d.%d.%d");
4078 args
[1] = make_number (*ip
++);
4079 args
[2] = make_number (*ip
++);
4080 args
[3] = make_number (*ip
++);
4081 args
[4] = make_number (*ip
++);
4082 host
= Fformat (5, args
);
4083 service
= make_number (ntohs (saddr
.in
.sin_port
));
4085 args
[0] = build_string (" <%s:%d>");
4088 caller
= Fformat (3, args
);
4095 Lisp_Object args
[9];
4096 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4098 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4099 for (i
= 0; i
< 8; i
++)
4100 args
[i
+1] = make_number (ntohs (ip6
[i
]));
4101 host
= Fformat (9, args
);
4102 service
= make_number (ntohs (saddr
.in
.sin_port
));
4104 args
[0] = build_string (" <[%s]:%d>");
4107 caller
= Fformat (3, args
);
4112 #ifdef HAVE_LOCAL_SOCKETS
4116 caller
= Fnumber_to_string (make_number (connect_counter
));
4117 caller
= concat3 (build_string (" <"), caller
, build_string (">"));
4121 /* Create a new buffer name for this process if it doesn't have a
4122 filter. The new buffer name is based on the buffer name or
4123 process name of the server process concatenated with the caller
4126 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4130 buffer
= ps
->buffer
;
4132 buffer
= Fbuffer_name (buffer
);
4137 buffer
= concat2 (buffer
, caller
);
4138 buffer
= Fget_buffer_create (buffer
);
4142 /* Generate a unique name for the new server process. Combine the
4143 server process name with the caller identification. */
4145 name
= concat2 (ps
->name
, caller
);
4146 proc
= make_process (name
);
4148 chan_process
[s
] = proc
;
4151 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4154 fcntl (s
, F_SETFL
, O_NDELAY
);
4158 p
= XPROCESS (proc
);
4160 /* Build new contact information for this setup. */
4161 contact
= Fcopy_sequence (ps
->childp
);
4162 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4163 contact
= Fplist_put (contact
, QChost
, host
);
4164 if (!NILP (service
))
4165 contact
= Fplist_put (contact
, QCservice
, service
);
4166 contact
= Fplist_put (contact
, QCremote
,
4167 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4168 #ifdef HAVE_GETSOCKNAME
4170 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4171 contact
= Fplist_put (contact
, QClocal
,
4172 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4175 pset_childp (p
, contact
);
4176 pset_plist (p
, Fcopy_sequence (ps
->plist
));
4177 pset_type (p
, Qnetwork
);
4179 pset_buffer (p
, buffer
);
4180 pset_sentinel (p
, ps
->sentinel
);
4181 pset_filter (p
, ps
->filter
);
4182 pset_command (p
, Qnil
);
4186 pset_status (p
, Qrun
);
4188 /* Client processes for accepted connections are not stopped initially. */
4189 if (!EQ (p
->filter
, Qt
))
4191 FD_SET (s
, &input_wait_mask
);
4192 FD_SET (s
, &non_keyboard_wait_mask
);
4195 if (s
> max_process_desc
)
4196 max_process_desc
= s
;
4198 /* Setup coding system for new process based on server process.
4199 This seems to be the proper thing to do, as the coding system
4200 of the new process should reflect the settings at the time the
4201 server socket was opened; not the current settings. */
4203 pset_decode_coding_system (p
, ps
->decode_coding_system
);
4204 pset_encode_coding_system (p
, ps
->encode_coding_system
);
4205 setup_process_coding_systems (proc
);
4207 pset_decoding_buf (p
, empty_unibyte_string
);
4208 p
->decoding_carryover
= 0;
4209 pset_encoding_buf (p
, empty_unibyte_string
);
4211 p
->inherit_coding_system_flag
4212 = (NILP (buffer
) ? 0 : ps
->inherit_coding_system_flag
);
4214 if (!NILP (ps
->log
))
4215 call3 (ps
->log
, server
, proc
,
4216 concat3 (build_string ("accept from "),
4217 (STRINGP (host
) ? host
: build_string ("-")),
4218 build_string ("\n")));
4220 if (!NILP (p
->sentinel
))
4221 exec_sentinel (proc
,
4222 concat3 (build_string ("open from "),
4223 (STRINGP (host
) ? host
: build_string ("-")),
4224 build_string ("\n")));
4227 /* This variable is different from waiting_for_input in keyboard.c.
4228 It is used to communicate to a lisp process-filter/sentinel (via the
4229 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4230 for user-input when that process-filter was called.
4231 waiting_for_input cannot be used as that is by definition 0 when
4232 lisp code is being evalled.
4233 This is also used in record_asynch_buffer_change.
4234 For that purpose, this must be 0
4235 when not inside wait_reading_process_output. */
4236 static int waiting_for_user_input_p
;
4239 wait_reading_process_output_unwind (Lisp_Object data
)
4241 waiting_for_user_input_p
= XINT (data
);
4245 /* This is here so breakpoints can be put on it. */
4247 wait_reading_process_output_1 (void)
4251 /* Read and dispose of subprocess output while waiting for timeout to
4252 elapse and/or keyboard input to be available.
4256 If negative, gobble data immediately available but don't wait for any.
4259 an additional duration to wait, measured in nanoseconds
4260 If TIME_LIMIT is zero, then:
4261 If NSECS == 0, there is no limit.
4262 If NSECS > 0, the timeout consists of NSECS only.
4263 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
4266 0 to ignore keyboard input, or
4267 1 to return when input is available, or
4268 -1 meaning caller will actually read the input, so don't throw to
4269 the quit handler, or
4271 DO_DISPLAY means redisplay should be done to show subprocess
4272 output that arrives.
4274 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4275 (and gobble terminal input into the buffer if any arrives).
4277 If WAIT_PROC is specified, wait until something arrives from that
4278 process. The return value is true if we read some input from
4281 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4282 (suspending output from other processes). A negative value
4283 means don't run any timers either.
4285 If WAIT_PROC is specified, then the function returns true if we
4286 received input from that process before the timeout elapsed.
4287 Otherwise, return true if we received input from any process. */
4290 wait_reading_process_output (intmax_t time_limit
, int nsecs
, int read_kbd
,
4292 Lisp_Object wait_for_cell
,
4293 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
4295 register int channel
, nfds
;
4296 SELECT_TYPE Available
;
4297 SELECT_TYPE Writeok
;
4299 int check_delay
, no_avail
;
4302 EMACS_TIME timeout
, end_time
;
4303 int wait_channel
= -1;
4304 int got_some_input
= 0;
4305 ptrdiff_t count
= SPECPDL_INDEX ();
4307 FD_ZERO (&Available
);
4310 if (time_limit
== 0 && nsecs
== 0 && wait_proc
&& !NILP (Vinhibit_quit
)
4311 && !(CONSP (wait_proc
->status
)
4312 && EQ (XCAR (wait_proc
->status
), Qexit
)))
4313 message ("Blocking call to accept-process-output with quit inhibited!!");
4315 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4316 if (wait_proc
!= NULL
)
4317 wait_channel
= wait_proc
->infd
;
4319 record_unwind_protect (wait_reading_process_output_unwind
,
4320 make_number (waiting_for_user_input_p
));
4321 waiting_for_user_input_p
= read_kbd
;
4328 else if (TYPE_MAXIMUM (time_t) < time_limit
)
4329 time_limit
= TYPE_MAXIMUM (time_t);
4331 /* Since we may need to wait several times,
4332 compute the absolute time to return at. */
4333 if (time_limit
|| 0 < nsecs
)
4335 timeout
= make_emacs_time (time_limit
, nsecs
);
4336 end_time
= add_emacs_time (current_emacs_time (), timeout
);
4341 int timeout_reduced_for_timers
= 0;
4343 /* If calling from keyboard input, do not quit
4344 since we want to return C-g as an input character.
4345 Otherwise, do pending quit if requested. */
4348 else if (pending_signals
)
4349 process_pending_signals ();
4351 /* Exit now if the cell we're waiting for became non-nil. */
4352 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4355 /* Compute time from now till when time limit is up */
4356 /* Exit if already run out */
4359 /* A negative timeout means
4360 gobble output available now
4361 but don't wait at all. */
4363 timeout
= make_emacs_time (0, 0);
4365 else if (time_limit
|| 0 < nsecs
)
4367 EMACS_TIME now
= current_emacs_time ();
4368 if (EMACS_TIME_LE (end_time
, now
))
4370 timeout
= sub_emacs_time (end_time
, now
);
4374 timeout
= make_emacs_time (100000, 0);
4377 /* Normally we run timers here.
4378 But not if wait_for_cell; in those cases,
4379 the wait is supposed to be short,
4380 and those callers cannot handle running arbitrary Lisp code here. */
4381 if (NILP (wait_for_cell
)
4382 && just_wait_proc
>= 0)
4384 EMACS_TIME timer_delay
;
4388 unsigned old_timers_run
= timers_run
;
4389 struct buffer
*old_buffer
= current_buffer
;
4390 Lisp_Object old_window
= selected_window
;
4392 timer_delay
= timer_check ();
4394 /* If a timer has run, this might have changed buffers
4395 an alike. Make read_key_sequence aware of that. */
4396 if (timers_run
!= old_timers_run
4397 && (old_buffer
!= current_buffer
4398 || !EQ (old_window
, selected_window
))
4399 && waiting_for_user_input_p
== -1)
4400 record_asynch_buffer_change ();
4402 if (timers_run
!= old_timers_run
&& do_display
)
4403 /* We must retry, since a timer may have requeued itself
4404 and that could alter the time_delay. */
4405 redisplay_preserve_echo_area (9);
4409 while (!detect_input_pending ());
4411 /* If there is unread keyboard input, also return. */
4413 && requeued_events_pending_p ())
4416 /* A negative timeout means do not wait at all. */
4419 if (EMACS_TIME_VALID_P (timer_delay
))
4421 if (EMACS_TIME_LT (timer_delay
, timeout
))
4423 timeout
= timer_delay
;
4424 timeout_reduced_for_timers
= 1;
4429 /* This is so a breakpoint can be put here. */
4430 wait_reading_process_output_1 ();
4435 /* Cause C-g and alarm signals to take immediate action,
4436 and cause input available signals to zero out timeout.
4438 It is important that we do this before checking for process
4439 activity. If we get a SIGCHLD after the explicit checks for
4440 process activity, timeout is the only way we will know. */
4442 set_waiting_for_input (&timeout
);
4444 /* If status of something has changed, and no input is
4445 available, notify the user of the change right away. After
4446 this explicit check, we'll let the SIGCHLD handler zap
4447 timeout to get our attention. */
4448 if (update_tick
!= process_tick
)
4453 if (kbd_on_hold_p ())
4456 Atemp
= input_wait_mask
;
4459 timeout
= make_emacs_time (0, 0);
4460 if ((pselect (max (max_process_desc
, max_input_desc
) + 1,
4462 #ifdef NON_BLOCKING_CONNECT
4463 (num_pending_connects
> 0 ? &Ctemp
: NULL
),
4467 NULL
, &timeout
, NULL
)
4470 /* It's okay for us to do this and then continue with
4471 the loop, since timeout has already been zeroed out. */
4472 clear_waiting_for_input ();
4473 status_notify (NULL
);
4474 if (do_display
) redisplay_preserve_echo_area (13);
4478 /* Don't wait for output from a non-running process. Just
4479 read whatever data has already been received. */
4480 if (wait_proc
&& wait_proc
->raw_status_new
)
4481 update_status (wait_proc
);
4483 && ! EQ (wait_proc
->status
, Qrun
)
4484 && ! EQ (wait_proc
->status
, Qconnect
))
4486 int nread
, total_nread
= 0;
4488 clear_waiting_for_input ();
4489 XSETPROCESS (proc
, wait_proc
);
4491 /* Read data from the process, until we exhaust it. */
4492 while (wait_proc
->infd
>= 0)
4494 nread
= read_process_output (proc
, wait_proc
->infd
);
4501 total_nread
+= nread
;
4505 else if (nread
== -1 && EIO
== errno
)
4509 else if (nread
== -1 && EAGAIN
== errno
)
4513 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4517 if (total_nread
> 0 && do_display
)
4518 redisplay_preserve_echo_area (10);
4523 /* Wait till there is something to do */
4525 if (wait_proc
&& just_wait_proc
)
4527 if (wait_proc
->infd
< 0) /* Terminated */
4529 FD_SET (wait_proc
->infd
, &Available
);
4533 else if (!NILP (wait_for_cell
))
4535 Available
= non_process_wait_mask
;
4542 Available
= non_keyboard_wait_mask
;
4544 Available
= input_wait_mask
;
4545 Writeok
= write_mask
;
4546 #ifdef SELECT_CANT_DO_WRITE_MASK
4551 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4554 /* If frame size has changed or the window is newly mapped,
4555 redisplay now, before we start to wait. There is a race
4556 condition here; if a SIGIO arrives between now and the select
4557 and indicates that a frame is trashed, the select may block
4558 displaying a trashed screen. */
4559 if (frame_garbaged
&& do_display
)
4561 clear_waiting_for_input ();
4562 redisplay_preserve_echo_area (11);
4564 set_waiting_for_input (&timeout
);
4567 /* Skip the `select' call if input is available and we're
4568 waiting for keyboard input or a cell change (which can be
4569 triggered by processing X events). In the latter case, set
4570 nfds to 1 to avoid breaking the loop. */
4572 if ((read_kbd
|| !NILP (wait_for_cell
))
4573 && detect_input_pending ())
4575 nfds
= read_kbd
? 0 : 1;
4582 #ifdef ADAPTIVE_READ_BUFFERING
4583 /* Set the timeout for adaptive read buffering if any
4584 process has non-zero read_output_skip and non-zero
4585 read_output_delay, and we are not reading output for a
4586 specific wait_channel. It is not executed if
4587 Vprocess_adaptive_read_buffering is nil. */
4588 if (process_output_skip
&& check_delay
> 0)
4590 int nsecs
= EMACS_NSECS (timeout
);
4591 if (EMACS_SECS (timeout
) > 0 || nsecs
> READ_OUTPUT_DELAY_MAX
)
4592 nsecs
= READ_OUTPUT_DELAY_MAX
;
4593 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4595 proc
= chan_process
[channel
];
4598 /* Find minimum non-zero read_output_delay among the
4599 processes with non-zero read_output_skip. */
4600 if (XPROCESS (proc
)->read_output_delay
> 0)
4603 if (!XPROCESS (proc
)->read_output_skip
)
4605 FD_CLR (channel
, &Available
);
4606 XPROCESS (proc
)->read_output_skip
= 0;
4607 if (XPROCESS (proc
)->read_output_delay
< nsecs
)
4608 nsecs
= XPROCESS (proc
)->read_output_delay
;
4611 timeout
= make_emacs_time (0, nsecs
);
4612 process_output_skip
= 0;
4616 #if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
4618 #elif defined (HAVE_NS)
4623 (max (max_process_desc
, max_input_desc
) + 1,
4625 (check_write
? &Writeok
: (SELECT_TYPE
*)0),
4626 NULL
, &timeout
, NULL
);
4629 /* GnuTLS buffers data internally. In lowat mode it leaves
4630 some data in the TCP buffers so that select works, but
4631 with custom pull/push functions we need to check if some
4632 data is available in the buffers manually. */
4637 /* We're not waiting on a specific process, so loop
4638 through all the channels and check for data.
4639 This is a workaround needed for some versions of
4640 the gnutls library -- 2.12.14 has been confirmed
4642 http://comments.gmane.org/gmane.emacs.devel/145074 */
4643 for (channel
= 0; channel
< MAXDESC
; ++channel
)
4644 if (! NILP (chan_process
[channel
]))
4646 struct Lisp_Process
*p
=
4647 XPROCESS (chan_process
[channel
]);
4648 if (p
&& p
->gnutls_p
&& p
->infd
4649 && ((emacs_gnutls_record_check_pending
4654 FD_SET (p
->infd
, &Available
);
4660 /* Check this specific channel. */
4661 if (wait_proc
->gnutls_p
/* Check for valid process. */
4662 /* Do we have pending data? */
4663 && ((emacs_gnutls_record_check_pending
4664 (wait_proc
->gnutls_state
))
4668 /* Set to Available. */
4669 FD_SET (wait_proc
->infd
, &Available
);
4678 /* Make C-g and alarm signals set flags again */
4679 clear_waiting_for_input ();
4681 /* If we woke up due to SIGWINCH, actually change size now. */
4682 do_pending_window_change (0);
4684 if ((time_limit
|| nsecs
) && nfds
== 0 && ! timeout_reduced_for_timers
)
4685 /* We waited the full specified time, so return now. */
4689 if (xerrno
== EINTR
)
4691 else if (xerrno
== EBADF
)
4694 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4695 the child's closure of the pts gives the parent a SIGHUP, and
4696 the ptc file descriptor is automatically closed,
4697 yielding EBADF here or at select() call above.
4698 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4699 in m/ibmrt-aix.h), and here we just ignore the select error.
4700 Cleanup occurs c/o status_notify after SIGCLD. */
4701 no_avail
= 1; /* Cannot depend on values returned */
4707 error ("select error: %s", emacs_strerror (xerrno
));
4712 FD_ZERO (&Available
);
4716 /* Check for keyboard input */
4717 /* If there is any, return immediately
4718 to give it higher priority than subprocesses */
4722 unsigned old_timers_run
= timers_run
;
4723 struct buffer
*old_buffer
= current_buffer
;
4724 Lisp_Object old_window
= selected_window
;
4727 if (detect_input_pending_run_timers (do_display
))
4729 swallow_events (do_display
);
4730 if (detect_input_pending_run_timers (do_display
))
4734 /* If a timer has run, this might have changed buffers
4735 an alike. Make read_key_sequence aware of that. */
4736 if (timers_run
!= old_timers_run
4737 && waiting_for_user_input_p
== -1
4738 && (old_buffer
!= current_buffer
4739 || !EQ (old_window
, selected_window
)))
4740 record_asynch_buffer_change ();
4746 /* If there is unread keyboard input, also return. */
4748 && requeued_events_pending_p ())
4751 /* If we are not checking for keyboard input now,
4752 do process events (but don't run any timers).
4753 This is so that X events will be processed.
4754 Otherwise they may have to wait until polling takes place.
4755 That would causes delays in pasting selections, for example.
4757 (We used to do this only if wait_for_cell.) */
4758 if (read_kbd
== 0 && detect_input_pending ())
4760 swallow_events (do_display
);
4761 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4762 if (detect_input_pending ())
4767 /* Exit now if the cell we're waiting for became non-nil. */
4768 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4772 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4773 go read it. This can happen with X on BSD after logging out.
4774 In that case, there really is no input and no SIGIO,
4775 but select says there is input. */
4777 if (read_kbd
&& interrupt_input
4778 && keyboard_bit_set (&Available
) && ! noninteractive
)
4779 handle_input_available_signal (SIGIO
);
4783 got_some_input
|= nfds
> 0;
4785 /* If checking input just got us a size-change event from X,
4786 obey it now if we should. */
4787 if (read_kbd
|| ! NILP (wait_for_cell
))
4788 do_pending_window_change (0);
4790 /* Check for data from a process. */
4791 if (no_avail
|| nfds
== 0)
4794 for (channel
= 0; channel
<= max_input_desc
; ++channel
)
4796 struct fd_callback_data
*d
= &fd_callback_info
[channel
];
4798 && ((d
->condition
& FOR_READ
4799 && FD_ISSET (channel
, &Available
))
4800 || (d
->condition
& FOR_WRITE
4801 && FD_ISSET (channel
, &write_mask
))))
4802 d
->func (channel
, d
->data
);
4805 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4807 if (FD_ISSET (channel
, &Available
)
4808 && FD_ISSET (channel
, &non_keyboard_wait_mask
)
4809 && !FD_ISSET (channel
, &non_process_wait_mask
))
4813 /* If waiting for this channel, arrange to return as
4814 soon as no more input to be processed. No more
4816 if (wait_channel
== channel
)
4822 proc
= chan_process
[channel
];
4826 /* If this is a server stream socket, accept connection. */
4827 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4829 server_accept_connection (proc
, channel
);
4833 /* Read data from the process, starting with our
4834 buffered-ahead character if we have one. */
4836 nread
= read_process_output (proc
, channel
);
4839 /* Since read_process_output can run a filter,
4840 which can call accept-process-output,
4841 don't try to read from any other processes
4842 before doing the select again. */
4843 FD_ZERO (&Available
);
4846 redisplay_preserve_echo_area (12);
4849 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4852 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4853 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4855 else if (nread
== -1 && errno
== EAGAIN
)
4859 else if (nread
== -1 && errno
== EAGAIN
)
4861 /* Note that we cannot distinguish between no input
4862 available now and a closed pipe.
4863 With luck, a closed pipe will be accompanied by
4864 subprocess termination and SIGCHLD. */
4865 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
4867 #endif /* O_NDELAY */
4868 #endif /* O_NONBLOCK */
4870 /* On some OSs with ptys, when the process on one end of
4871 a pty exits, the other end gets an error reading with
4872 errno = EIO instead of getting an EOF (0 bytes read).
4873 Therefore, if we get an error reading and errno =
4874 EIO, just continue, because the child process has
4875 exited and should clean itself up soon (e.g. when we
4878 However, it has been known to happen that the SIGCHLD
4879 got lost. So raise the signal again just in case.
4881 else if (nread
== -1 && errno
== EIO
)
4883 struct Lisp_Process
*p
= XPROCESS (proc
);
4885 /* Clear the descriptor now, so we only raise the
4887 FD_CLR (channel
, &input_wait_mask
);
4888 FD_CLR (channel
, &non_keyboard_wait_mask
);
4892 /* If the EIO occurs on a pty, the SIGCHLD handler's
4893 waitpid call will not find the process object to
4894 delete. Do it here. */
4895 p
->tick
= ++process_tick
;
4896 pset_status (p
, Qfailed
);
4899 handle_child_signal (SIGCHLD
);
4901 #endif /* HAVE_PTYS */
4902 /* If we can detect process termination, don't consider the
4903 process gone just because its pipe is closed. */
4905 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
4910 /* Preserve status of processes already terminated. */
4911 XPROCESS (proc
)->tick
= ++process_tick
;
4912 deactivate_process (proc
);
4913 if (XPROCESS (proc
)->raw_status_new
)
4914 update_status (XPROCESS (proc
));
4915 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4916 pset_status (XPROCESS (proc
),
4917 list2 (Qexit
, make_number (256)));
4920 #ifdef NON_BLOCKING_CONNECT
4921 if (FD_ISSET (channel
, &Writeok
)
4922 && FD_ISSET (channel
, &connect_wait_mask
))
4924 struct Lisp_Process
*p
;
4926 FD_CLR (channel
, &connect_wait_mask
);
4927 FD_CLR (channel
, &write_mask
);
4928 if (--num_pending_connects
< 0)
4931 proc
= chan_process
[channel
];
4935 p
= XPROCESS (proc
);
4938 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4939 So only use it on systems where it is known to work. */
4941 socklen_t xlen
= sizeof (xerrno
);
4942 if (getsockopt (channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4947 struct sockaddr pname
;
4948 int pnamelen
= sizeof (pname
);
4950 /* If connection failed, getpeername will fail. */
4952 if (getpeername (channel
, &pname
, &pnamelen
) < 0)
4954 /* Obtain connect failure code through error slippage. */
4957 if (errno
== ENOTCONN
&& read (channel
, &dummy
, 1) < 0)
4964 p
->tick
= ++process_tick
;
4965 pset_status (p
, list2 (Qfailed
, make_number (xerrno
)));
4966 deactivate_process (proc
);
4970 pset_status (p
, Qrun
);
4971 /* Execute the sentinel here. If we had relied on
4972 status_notify to do it later, it will read input
4973 from the process before calling the sentinel. */
4974 exec_sentinel (proc
, build_string ("open\n"));
4975 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4977 FD_SET (p
->infd
, &input_wait_mask
);
4978 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
4982 #endif /* NON_BLOCKING_CONNECT */
4983 } /* end for each file descriptor */
4984 } /* end while exit conditions not met */
4986 unbind_to (count
, Qnil
);
4988 /* If calling from keyboard input, do not quit
4989 since we want to return C-g as an input character.
4990 Otherwise, do pending quit if requested. */
4993 /* Prevent input_pending from remaining set if we quit. */
4994 clear_input_pending ();
4998 return got_some_input
;
5001 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5004 read_process_output_call (Lisp_Object fun_and_args
)
5006 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
5010 read_process_output_error_handler (Lisp_Object error_val
)
5012 cmd_error_internal (error_val
, "error in process filter: ");
5014 update_echo_area ();
5015 Fsleep_for (make_number (2), Qnil
);
5019 /* Read pending output from the process channel,
5020 starting with our buffered-ahead character if we have one.
5021 Yield number of decoded characters read.
5023 This function reads at most 4096 characters.
5024 If you want to read all available subprocess output,
5025 you must call it repeatedly until it returns zero.
5027 The characters read are decoded according to PROC's coding-system
5031 read_process_output (Lisp_Object proc
, register int channel
)
5033 register ssize_t nbytes
;
5035 register Lisp_Object outstream
;
5036 register struct Lisp_Process
*p
= XPROCESS (proc
);
5037 register ptrdiff_t opoint
;
5038 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
5039 int carryover
= p
->decoding_carryover
;
5041 ptrdiff_t count
= SPECPDL_INDEX ();
5042 Lisp_Object odeactivate
;
5044 chars
= alloca (carryover
+ readmax
);
5046 /* See the comment above. */
5047 memcpy (chars
, SDATA (p
->decoding_buf
), carryover
);
5049 #ifdef DATAGRAM_SOCKETS
5050 /* We have a working select, so proc_buffered_char is always -1. */
5051 if (DATAGRAM_CHAN_P (channel
))
5053 socklen_t len
= datagram_address
[channel
].len
;
5054 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5055 0, datagram_address
[channel
].sa
, &len
);
5060 int buffered
= 0 <= proc_buffered_char
[channel
];
5063 chars
[carryover
] = proc_buffered_char
[channel
];
5064 proc_buffered_char
[channel
] = -1;
5068 nbytes
= emacs_gnutls_read (p
, chars
+ carryover
+ buffered
,
5069 readmax
- buffered
);
5072 nbytes
= emacs_read (channel
, chars
+ carryover
+ buffered
,
5073 readmax
- buffered
);
5074 #ifdef ADAPTIVE_READ_BUFFERING
5075 if (nbytes
> 0 && p
->adaptive_read_buffering
)
5077 int delay
= p
->read_output_delay
;
5080 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5083 process_output_delay_count
++;
5084 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5087 else if (delay
> 0 && nbytes
== readmax
- buffered
)
5089 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5091 process_output_delay_count
--;
5093 p
->read_output_delay
= delay
;
5096 p
->read_output_skip
= 1;
5097 process_output_skip
= 1;
5102 nbytes
+= buffered
&& nbytes
<= 0;
5105 p
->decoding_carryover
= 0;
5107 /* At this point, NBYTES holds number of bytes just received
5108 (including the one in proc_buffered_char[channel]). */
5111 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5113 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5116 /* Now set NBYTES how many bytes we must decode. */
5117 nbytes
+= carryover
;
5119 odeactivate
= Vdeactivate_mark
;
5120 /* There's no good reason to let process filters change the current
5121 buffer, and many callers of accept-process-output, sit-for, and
5122 friends don't expect current-buffer to be changed from under them. */
5123 record_unwind_current_buffer ();
5125 /* Read and dispose of the process output. */
5126 outstream
= p
->filter
;
5127 if (!NILP (outstream
))
5130 bool outer_running_asynch_code
= running_asynch_code
;
5131 int waiting
= waiting_for_user_input_p
;
5133 /* No need to gcpro these, because all we do with them later
5134 is test them for EQness, and none of them should be a string. */
5136 Lisp_Object obuffer
, okeymap
;
5137 XSETBUFFER (obuffer
, current_buffer
);
5138 okeymap
= BVAR (current_buffer
, keymap
);
5141 /* We inhibit quit here instead of just catching it so that
5142 hitting ^G when a filter happens to be running won't screw
5144 specbind (Qinhibit_quit
, Qt
);
5145 specbind (Qlast_nonmenu_event
, Qt
);
5147 /* In case we get recursively called,
5148 and we already saved the match data nonrecursively,
5149 save the same match data in safely recursive fashion. */
5150 if (outer_running_asynch_code
)
5153 /* Don't clobber the CURRENT match data, either! */
5154 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5155 restore_search_regs ();
5156 record_unwind_save_match_data ();
5157 Fset_match_data (tem
, Qt
);
5160 /* For speed, if a search happens within this code,
5161 save the match data in a special nonrecursive fashion. */
5162 running_asynch_code
= 1;
5164 decode_coding_c_string (coding
, (unsigned char *) chars
, nbytes
, Qt
);
5165 text
= coding
->dst_object
;
5166 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5167 /* A new coding system might be found. */
5168 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5170 pset_decode_coding_system (p
, Vlast_coding_system_used
);
5172 /* Don't call setup_coding_system for
5173 proc_decode_coding_system[channel] here. It is done in
5174 detect_coding called via decode_coding above. */
5176 /* If a coding system for encoding is not yet decided, we set
5177 it as the same as coding-system for decoding.
5179 But, before doing that we must check if
5180 proc_encode_coding_system[p->outfd] surely points to a
5181 valid memory because p->outfd will be changed once EOF is
5182 sent to the process. */
5183 if (NILP (p
->encode_coding_system
)
5184 && proc_encode_coding_system
[p
->outfd
])
5186 pset_encode_coding_system
5187 (p
, coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
));
5188 setup_coding_system (p
->encode_coding_system
,
5189 proc_encode_coding_system
[p
->outfd
]);
5193 if (coding
->carryover_bytes
> 0)
5195 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5196 pset_decoding_buf (p
, make_uninit_string (coding
->carryover_bytes
));
5197 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5198 coding
->carryover_bytes
);
5199 p
->decoding_carryover
= coding
->carryover_bytes
;
5201 if (SBYTES (text
) > 0)
5202 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5203 sometimes it's simply wrong to wrap (e.g. when called from
5204 accept-process-output). */
5205 internal_condition_case_1 (read_process_output_call
,
5207 Fcons (proc
, Fcons (text
, Qnil
))),
5208 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5209 read_process_output_error_handler
);
5211 /* If we saved the match data nonrecursively, restore it now. */
5212 restore_search_regs ();
5213 running_asynch_code
= outer_running_asynch_code
;
5215 /* Restore waiting_for_user_input_p as it was
5216 when we were called, in case the filter clobbered it. */
5217 waiting_for_user_input_p
= waiting
;
5219 #if 0 /* Call record_asynch_buffer_change unconditionally,
5220 because we might have changed minor modes or other things
5221 that affect key bindings. */
5222 if (! EQ (Fcurrent_buffer (), obuffer
)
5223 || ! EQ (current_buffer
->keymap
, okeymap
))
5225 /* But do it only if the caller is actually going to read events.
5226 Otherwise there's no need to make him wake up, and it could
5227 cause trouble (for example it would make sit_for return). */
5228 if (waiting_for_user_input_p
== -1)
5229 record_asynch_buffer_change ();
5232 /* If no filter, write into buffer if it isn't dead. */
5233 else if (!NILP (p
->buffer
) && BUFFER_LIVE_P (XBUFFER (p
->buffer
)))
5235 Lisp_Object old_read_only
;
5236 ptrdiff_t old_begv
, old_zv
;
5237 ptrdiff_t old_begv_byte
, old_zv_byte
;
5238 ptrdiff_t before
, before_byte
;
5239 ptrdiff_t opoint_byte
;
5243 Fset_buffer (p
->buffer
);
5245 opoint_byte
= PT_BYTE
;
5246 old_read_only
= BVAR (current_buffer
, read_only
);
5249 old_begv_byte
= BEGV_BYTE
;
5250 old_zv_byte
= ZV_BYTE
;
5252 bset_read_only (current_buffer
, Qnil
);
5254 /* Insert new output into buffer
5255 at the current end-of-output marker,
5256 thus preserving logical ordering of input and output. */
5257 if (XMARKER (p
->mark
)->buffer
)
5258 SET_PT_BOTH (clip_to_bounds (BEGV
,
5259 marker_position (p
->mark
), ZV
),
5260 clip_to_bounds (BEGV_BYTE
,
5261 marker_byte_position (p
->mark
),
5264 SET_PT_BOTH (ZV
, ZV_BYTE
);
5266 before_byte
= PT_BYTE
;
5268 /* If the output marker is outside of the visible region, save
5269 the restriction and widen. */
5270 if (! (BEGV
<= PT
&& PT
<= ZV
))
5273 decode_coding_c_string (coding
, (unsigned char *) chars
, nbytes
, Qt
);
5274 text
= coding
->dst_object
;
5275 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5276 /* A new coding system might be found. See the comment in the
5277 similar code in the previous `if' block. */
5278 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5280 pset_decode_coding_system (p
, Vlast_coding_system_used
);
5281 if (NILP (p
->encode_coding_system
)
5282 && proc_encode_coding_system
[p
->outfd
])
5284 pset_encode_coding_system
5285 (p
, coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
));
5286 setup_coding_system (p
->encode_coding_system
,
5287 proc_encode_coding_system
[p
->outfd
]);
5290 if (coding
->carryover_bytes
> 0)
5292 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5293 pset_decoding_buf (p
, make_uninit_string (coding
->carryover_bytes
));
5294 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5295 coding
->carryover_bytes
);
5296 p
->decoding_carryover
= coding
->carryover_bytes
;
5298 /* Adjust the multibyteness of TEXT to that of the buffer. */
5299 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
5300 != ! STRING_MULTIBYTE (text
))
5301 text
= (STRING_MULTIBYTE (text
)
5302 ? Fstring_as_unibyte (text
)
5303 : Fstring_to_multibyte (text
));
5304 /* Insert before markers in case we are inserting where
5305 the buffer's mark is, and the user's next command is Meta-y. */
5306 insert_from_string_before_markers (text
, 0, 0,
5307 SCHARS (text
), SBYTES (text
), 0);
5309 /* Make sure the process marker's position is valid when the
5310 process buffer is changed in the signal_after_change above.
5311 W3 is known to do that. */
5312 if (BUFFERP (p
->buffer
)
5313 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5314 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5316 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5318 update_mode_lines
++;
5320 /* Make sure opoint and the old restrictions
5321 float ahead of any new text just as point would. */
5322 if (opoint
>= before
)
5324 opoint
+= PT
- before
;
5325 opoint_byte
+= PT_BYTE
- before_byte
;
5327 if (old_begv
> before
)
5329 old_begv
+= PT
- before
;
5330 old_begv_byte
+= PT_BYTE
- before_byte
;
5332 if (old_zv
>= before
)
5334 old_zv
+= PT
- before
;
5335 old_zv_byte
+= PT_BYTE
- before_byte
;
5338 /* If the restriction isn't what it should be, set it. */
5339 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5340 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5343 bset_read_only (current_buffer
, old_read_only
);
5344 SET_PT_BOTH (opoint
, opoint_byte
);
5346 /* Handling the process output should not deactivate the mark. */
5347 Vdeactivate_mark
= odeactivate
;
5349 unbind_to (count
, Qnil
);
5353 /* Sending data to subprocess */
5355 /* In send_process, when a write fails temporarily,
5356 wait_reading_process_output is called. It may execute user code,
5357 e.g. timers, that attempts to write new data to the same process.
5358 We must ensure that data is sent in the right order, and not
5359 interspersed half-completed with other writes (Bug#10815). This is
5360 handled by the write_queue element of struct process. It is a list
5361 with each entry having the form
5363 (string . (offset . length))
5365 where STRING is a lisp string, OFFSET is the offset into the
5366 string's byte sequence from which we should begin to send, and
5367 LENGTH is the number of bytes left to send. */
5369 /* Create a new entry in write_queue.
5370 INPUT_OBJ should be a buffer, string Qt, or Qnil.
5371 BUF is a pointer to the string sequence of the input_obj or a C
5372 string in case of Qt or Qnil. */
5375 write_queue_push (struct Lisp_Process
*p
, Lisp_Object input_obj
,
5376 const char *buf
, ptrdiff_t len
, int front
)
5379 Lisp_Object entry
, obj
;
5381 if (STRINGP (input_obj
))
5383 offset
= buf
- SSDATA (input_obj
);
5389 obj
= make_unibyte_string (buf
, len
);
5392 entry
= Fcons (obj
, Fcons (make_number (offset
), make_number (len
)));
5395 pset_write_queue (p
, Fcons (entry
, p
->write_queue
));
5397 pset_write_queue (p
, nconc2 (p
->write_queue
, Fcons (entry
, Qnil
)));
5400 /* Remove the first element in the write_queue of process P, put its
5401 contents in OBJ, BUF and LEN, and return non-zero. If the
5402 write_queue is empty, return zero. */
5405 write_queue_pop (struct Lisp_Process
*p
, Lisp_Object
*obj
,
5406 const char **buf
, ptrdiff_t *len
)
5408 Lisp_Object entry
, offset_length
;
5411 if (NILP (p
->write_queue
))
5414 entry
= XCAR (p
->write_queue
);
5415 pset_write_queue (p
, XCDR (p
->write_queue
));
5417 *obj
= XCAR (entry
);
5418 offset_length
= XCDR (entry
);
5420 *len
= XINT (XCDR (offset_length
));
5421 offset
= XINT (XCAR (offset_length
));
5422 *buf
= SSDATA (*obj
) + offset
;
5427 /* Send some data to process PROC.
5428 BUF is the beginning of the data; LEN is the number of characters.
5429 OBJECT is the Lisp object that the data comes from. If OBJECT is
5430 nil or t, it means that the data comes from C string.
5432 If OBJECT is not nil, the data is encoded by PROC's coding-system
5433 for encoding before it is sent.
5435 This function can evaluate Lisp code and can garbage collect. */
5438 send_process (Lisp_Object proc
, const char *buf
, ptrdiff_t len
,
5441 struct Lisp_Process
*p
= XPROCESS (proc
);
5443 struct coding_system
*coding
;
5445 if (p
->raw_status_new
)
5447 if (! EQ (p
->status
, Qrun
))
5448 error ("Process %s not running", SDATA (p
->name
));
5450 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5452 coding
= proc_encode_coding_system
[p
->outfd
];
5453 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5455 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5456 || (BUFFERP (object
)
5457 && !NILP (BVAR (XBUFFER (object
), enable_multibyte_characters
)))
5460 pset_encode_coding_system
5461 (p
, complement_process_encoding_system (p
->encode_coding_system
));
5462 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
5464 /* The coding system for encoding was changed to raw-text
5465 because we sent a unibyte text previously. Now we are
5466 sending a multibyte text, thus we must encode it by the
5467 original coding system specified for the current process.
5469 Another reason we come here is that the coding system
5470 was just complemented and a new one was returned by
5471 complement_process_encoding_system. */
5472 setup_coding_system (p
->encode_coding_system
, coding
);
5473 Vlast_coding_system_used
= p
->encode_coding_system
;
5475 coding
->src_multibyte
= 1;
5479 coding
->src_multibyte
= 0;
5480 /* For sending a unibyte text, character code conversion should
5481 not take place but EOL conversion should. So, setup raw-text
5482 or one of the subsidiary if we have not yet done it. */
5483 if (CODING_REQUIRE_ENCODING (coding
))
5485 if (CODING_REQUIRE_FLUSHING (coding
))
5487 /* But, before changing the coding, we must flush out data. */
5488 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5489 send_process (proc
, "", 0, Qt
);
5490 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
5492 setup_coding_system (raw_text_coding_system
5493 (Vlast_coding_system_used
),
5495 coding
->src_multibyte
= 0;
5498 coding
->dst_multibyte
= 0;
5500 if (CODING_REQUIRE_ENCODING (coding
))
5502 coding
->dst_object
= Qt
;
5503 if (BUFFERP (object
))
5505 ptrdiff_t from_byte
, from
, to
;
5506 ptrdiff_t save_pt
, save_pt_byte
;
5507 struct buffer
*cur
= current_buffer
;
5509 set_buffer_internal (XBUFFER (object
));
5510 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
5512 from_byte
= PTR_BYTE_POS ((unsigned char *) buf
);
5513 from
= BYTE_TO_CHAR (from_byte
);
5514 to
= BYTE_TO_CHAR (from_byte
+ len
);
5515 TEMP_SET_PT_BOTH (from
, from_byte
);
5516 encode_coding_object (coding
, object
, from
, from_byte
,
5517 to
, from_byte
+ len
, Qt
);
5518 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
5519 set_buffer_internal (cur
);
5521 else if (STRINGP (object
))
5523 encode_coding_object (coding
, object
, 0, 0, SCHARS (object
),
5524 SBYTES (object
), Qt
);
5528 coding
->dst_object
= make_unibyte_string (buf
, len
);
5529 coding
->produced
= len
;
5532 len
= coding
->produced
;
5533 object
= coding
->dst_object
;
5534 buf
= SSDATA (object
);
5537 if (pty_max_bytes
== 0)
5539 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5540 pty_max_bytes
= fpathconf (p
->outfd
, _PC_MAX_CANON
);
5541 if (pty_max_bytes
< 0)
5542 pty_max_bytes
= 250;
5544 pty_max_bytes
= 250;
5546 /* Deduct one, to leave space for the eof. */
5550 /* If there is already data in the write_queue, put the new data
5551 in the back of queue. Otherwise, ignore it. */
5552 if (!NILP (p
->write_queue
))
5553 write_queue_push (p
, object
, buf
, len
, 0);
5555 do /* while !NILP (p->write_queue) */
5557 ptrdiff_t cur_len
= -1;
5558 const char *cur_buf
;
5559 Lisp_Object cur_object
;
5561 /* If write_queue is empty, ignore it. */
5562 if (!write_queue_pop (p
, &cur_object
, &cur_buf
, &cur_len
))
5566 cur_object
= object
;
5571 /* Send this batch, using one or more write calls. */
5572 ptrdiff_t written
= 0;
5573 int outfd
= p
->outfd
;
5574 #ifdef DATAGRAM_SOCKETS
5575 if (DATAGRAM_CHAN_P (outfd
))
5577 rv
= sendto (outfd
, cur_buf
, cur_len
,
5578 0, datagram_address
[outfd
].sa
,
5579 datagram_address
[outfd
].len
);
5582 else if (errno
== EMSGSIZE
)
5583 report_file_error ("sending datagram", Fcons (proc
, Qnil
));
5590 written
= emacs_gnutls_write (p
, cur_buf
, cur_len
);
5593 written
= emacs_write (outfd
, cur_buf
, cur_len
);
5594 rv
= (written
? 0 : -1);
5595 #ifdef ADAPTIVE_READ_BUFFERING
5596 if (p
->read_output_delay
> 0
5597 && p
->adaptive_read_buffering
== 1)
5599 p
->read_output_delay
= 0;
5600 process_output_delay_count
--;
5601 p
->read_output_skip
= 0;
5610 || errno
== EWOULDBLOCK
5616 /* Buffer is full. Wait, accepting input;
5617 that may allow the program
5618 to finish doing output and read more. */
5620 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5621 /* A gross hack to work around a bug in FreeBSD.
5622 In the following sequence, read(2) returns
5626 write(2) 954 bytes, get EAGAIN
5627 read(2) 1024 bytes in process_read_output
5628 read(2) 11 bytes in process_read_output
5630 That is, read(2) returns more bytes than have
5631 ever been written successfully. The 1033 bytes
5632 read are the 1022 bytes written successfully
5633 after processing (for example with CRs added if
5634 the terminal is set up that way which it is
5635 here). The same bytes will be seen again in a
5636 later read(2), without the CRs. */
5638 if (errno
== EAGAIN
)
5641 ioctl (p
->outfd
, TIOCFLUSH
, &flags
);
5643 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5645 /* Put what we should have written in wait_queue. */
5646 write_queue_push (p
, cur_object
, cur_buf
, cur_len
, 1);
5647 wait_reading_process_output (0, 20 * 1000 * 1000,
5648 0, 0, Qnil
, NULL
, 0);
5649 /* Reread queue, to see what is left. */
5652 else if (errno
== EPIPE
)
5654 p
->raw_status_new
= 0;
5655 pset_status (p
, list2 (Qexit
, make_number (256)));
5656 p
->tick
= ++process_tick
;
5657 deactivate_process (proc
);
5658 error ("process %s no longer connected to pipe; closed it",
5662 /* This is a real error. */
5663 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5669 while (!NILP (p
->write_queue
));
5672 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5674 doc
: /* Send current contents of region as input to PROCESS.
5675 PROCESS may be a process, a buffer, the name of a process or buffer, or
5676 nil, indicating the current buffer's process.
5677 Called from program, takes three arguments, PROCESS, START and END.
5678 If the region is more than 500 characters long,
5679 it is sent in several bunches. This may happen even for shorter regions.
5680 Output from processes can arrive in between bunches. */)
5681 (Lisp_Object process
, Lisp_Object start
, Lisp_Object end
)
5684 ptrdiff_t start1
, end1
;
5686 proc
= get_process (process
);
5687 validate_region (&start
, &end
);
5689 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5690 move_gap (XINT (start
));
5692 start1
= CHAR_TO_BYTE (XINT (start
));
5693 end1
= CHAR_TO_BYTE (XINT (end
));
5694 send_process (proc
, (char *) BYTE_POS_ADDR (start1
), end1
- start1
,
5695 Fcurrent_buffer ());
5700 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5702 doc
: /* Send PROCESS the contents of STRING as input.
5703 PROCESS may be a process, a buffer, the name of a process or buffer, or
5704 nil, indicating the current buffer's process.
5705 If STRING is more than 500 characters long,
5706 it is sent in several bunches. This may happen even for shorter strings.
5707 Output from processes can arrive in between bunches. */)
5708 (Lisp_Object process
, Lisp_Object string
)
5711 CHECK_STRING (string
);
5712 proc
= get_process (process
);
5713 send_process (proc
, SSDATA (string
),
5714 SBYTES (string
), string
);
5718 /* Return the foreground process group for the tty/pty that
5719 the process P uses. */
5721 emacs_get_tty_pgrp (struct Lisp_Process
*p
)
5726 if (ioctl (p
->infd
, TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5729 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5730 master side. Try the slave side. */
5731 fd
= emacs_open (SSDATA (p
->tty_name
), O_RDONLY
, 0);
5735 ioctl (fd
, TIOCGPGRP
, &gid
);
5739 #endif /* defined (TIOCGPGRP ) */
5744 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5745 Sprocess_running_child_p
, 0, 1, 0,
5746 doc
: /* Return t if PROCESS has given the terminal to a child.
5747 If the operating system does not make it possible to find out,
5748 return t unconditionally. */)
5749 (Lisp_Object process
)
5751 /* Initialize in case ioctl doesn't exist or gives an error,
5752 in a way that will cause returning t. */
5755 struct Lisp_Process
*p
;
5757 proc
= get_process (process
);
5758 p
= XPROCESS (proc
);
5760 if (!EQ (p
->type
, Qreal
))
5761 error ("Process %s is not a subprocess",
5764 error ("Process %s is not active",
5767 gid
= emacs_get_tty_pgrp (p
);
5774 /* send a signal number SIGNO to PROCESS.
5775 If CURRENT_GROUP is t, that means send to the process group
5776 that currently owns the terminal being used to communicate with PROCESS.
5777 This is used for various commands in shell mode.
5778 If CURRENT_GROUP is lambda, that means send to the process group
5779 that currently owns the terminal, but only if it is NOT the shell itself.
5781 If NOMSG is zero, insert signal-announcements into process's buffers
5784 If we can, we try to signal PROCESS by sending control characters
5785 down the pty. This allows us to signal inferiors who have changed
5786 their uid, for which killpg would return an EPERM error. */
5789 process_send_signal (Lisp_Object process
, int signo
, Lisp_Object current_group
,
5793 register struct Lisp_Process
*p
;
5797 proc
= get_process (process
);
5798 p
= XPROCESS (proc
);
5800 if (!EQ (p
->type
, Qreal
))
5801 error ("Process %s is not a subprocess",
5804 error ("Process %s is not active",
5808 current_group
= Qnil
;
5810 /* If we are using pgrps, get a pgrp number and make it negative. */
5811 if (NILP (current_group
))
5812 /* Send the signal to the shell's process group. */
5816 #ifdef SIGNALS_VIA_CHARACTERS
5817 /* If possible, send signals to the entire pgrp
5818 by sending an input character to it. */
5821 cc_t
*sig_char
= NULL
;
5823 tcgetattr (p
->infd
, &t
);
5828 sig_char
= &t
.c_cc
[VINTR
];
5832 sig_char
= &t
.c_cc
[VQUIT
];
5836 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5837 sig_char
= &t
.c_cc
[VSWTCH
];
5839 sig_char
= &t
.c_cc
[VSUSP
];
5844 if (sig_char
&& *sig_char
!= CDISABLE
)
5846 send_process (proc
, (char *) sig_char
, 1, Qnil
);
5849 /* If we can't send the signal with a character,
5850 fall through and send it another way. */
5852 /* The code above may fall through if it can't
5853 handle the signal. */
5854 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5857 /* Get the current pgrp using the tty itself, if we have that.
5858 Otherwise, use the pty to get the pgrp.
5859 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5860 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5861 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5862 His patch indicates that if TIOCGPGRP returns an error, then
5863 we should just assume that p->pid is also the process group id. */
5865 gid
= emacs_get_tty_pgrp (p
);
5868 /* If we can't get the information, assume
5869 the shell owns the tty. */
5872 /* It is not clear whether anything really can set GID to -1.
5873 Perhaps on some system one of those ioctls can or could do so.
5874 Or perhaps this is vestigial. */
5877 #else /* ! defined (TIOCGPGRP ) */
5878 /* Can't select pgrps on this system, so we know that
5879 the child itself heads the pgrp. */
5881 #endif /* ! defined (TIOCGPGRP ) */
5883 /* If current_group is lambda, and the shell owns the terminal,
5884 don't send any signal. */
5885 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
5893 p
->raw_status_new
= 0;
5894 pset_status (p
, Qrun
);
5895 p
->tick
= ++process_tick
;
5898 status_notify (NULL
);
5899 redisplay_preserve_echo_area (13);
5902 #endif /* ! defined (SIGCONT) */
5906 flush_pending_output (p
->infd
);
5910 /* If we don't have process groups, send the signal to the immediate
5911 subprocess. That isn't really right, but it's better than any
5912 obvious alternative. */
5915 kill (p
->pid
, signo
);
5919 /* gid may be a pid, or minus a pgrp's number */
5921 if (!NILP (current_group
))
5923 if (ioctl (p
->infd
, TIOCSIGSEND
, signo
) == -1)
5924 EMACS_KILLPG (gid
, signo
);
5931 #else /* ! defined (TIOCSIGSEND) */
5932 EMACS_KILLPG (gid
, signo
);
5933 #endif /* ! defined (TIOCSIGSEND) */
5936 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5937 doc
: /* Interrupt process PROCESS.
5938 PROCESS may be a process, a buffer, or the name of a process or buffer.
5939 No arg or nil means current buffer's process.
5940 Second arg CURRENT-GROUP non-nil means send signal to
5941 the current process-group of the process's controlling terminal
5942 rather than to the process's own process group.
5943 If the process is a shell, this means interrupt current subjob
5944 rather than the shell.
5946 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5947 don't send the signal. */)
5948 (Lisp_Object process
, Lisp_Object current_group
)
5950 process_send_signal (process
, SIGINT
, current_group
, 0);
5954 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5955 doc
: /* Kill process PROCESS. May be process or name of one.
5956 See function `interrupt-process' for more details on usage. */)
5957 (Lisp_Object process
, Lisp_Object current_group
)
5959 process_send_signal (process
, SIGKILL
, current_group
, 0);
5963 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5964 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5965 See function `interrupt-process' for more details on usage. */)
5966 (Lisp_Object process
, Lisp_Object current_group
)
5968 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5972 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5973 doc
: /* Stop process PROCESS. May be process or name of one.
5974 See function `interrupt-process' for more details on usage.
5975 If PROCESS is a network or serial process, inhibit handling of incoming
5977 (Lisp_Object process
, Lisp_Object current_group
)
5979 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
5981 struct Lisp_Process
*p
;
5983 p
= XPROCESS (process
);
5984 if (NILP (p
->command
)
5987 FD_CLR (p
->infd
, &input_wait_mask
);
5988 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
5990 pset_command (p
, Qt
);
5994 error ("No SIGTSTP support");
5996 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6001 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6002 doc
: /* Continue process PROCESS. May be process or name of one.
6003 See function `interrupt-process' for more details on usage.
6004 If PROCESS is a network or serial process, resume handling of incoming
6006 (Lisp_Object process
, Lisp_Object current_group
)
6008 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
6010 struct Lisp_Process
*p
;
6012 p
= XPROCESS (process
);
6013 if (EQ (p
->command
, Qt
)
6015 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6017 FD_SET (p
->infd
, &input_wait_mask
);
6018 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
6020 if (fd_info
[ p
->infd
].flags
& FILE_SERIAL
)
6021 PurgeComm (fd_info
[ p
->infd
].hnd
, PURGE_RXABORT
| PURGE_RXCLEAR
);
6022 #else /* not WINDOWSNT */
6023 tcflush (p
->infd
, TCIFLUSH
);
6024 #endif /* not WINDOWSNT */
6026 pset_command (p
, Qnil
);
6030 process_send_signal (process
, SIGCONT
, current_group
, 0);
6032 error ("No SIGCONT support");
6037 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6038 2, 2, "sProcess (name or number): \nnSignal code: ",
6039 doc
: /* Send PROCESS the signal with code SIGCODE.
6040 PROCESS may also be a number specifying the process id of the
6041 process to signal; in this case, the process need not be a child of
6043 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6044 (Lisp_Object process
, Lisp_Object sigcode
)
6048 if (STRINGP (process
))
6050 Lisp_Object tem
= Fget_process (process
);
6053 Lisp_Object process_number
=
6054 string_to_number (SSDATA (process
), 10, 1);
6055 if (INTEGERP (process_number
) || FLOATP (process_number
))
6056 tem
= process_number
;
6060 else if (!NUMBERP (process
))
6061 process
= get_process (process
);
6066 if (NUMBERP (process
))
6067 CONS_TO_INTEGER (process
, pid_t
, pid
);
6070 CHECK_PROCESS (process
);
6071 pid
= XPROCESS (process
)->pid
;
6073 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6076 #define parse_signal(NAME, VALUE) \
6077 else if (!xstrcasecmp (name, NAME)) \
6078 XSETINT (sigcode, VALUE)
6080 if (INTEGERP (sigcode
))
6081 CHECK_TYPE_RANGED_INTEGER (int, sigcode
);
6086 CHECK_SYMBOL (sigcode
);
6087 name
= SSDATA (SYMBOL_NAME (sigcode
));
6089 if (!strncmp (name
, "SIG", 3) || !strncmp (name
, "sig", 3))
6095 parse_signal ("usr1", SIGUSR1
);
6098 parse_signal ("usr2", SIGUSR2
);
6100 parse_signal ("term", SIGTERM
);
6102 parse_signal ("hup", SIGHUP
);
6104 parse_signal ("int", SIGINT
);
6106 parse_signal ("quit", SIGQUIT
);
6108 parse_signal ("ill", SIGILL
);
6109 parse_signal ("abrt", SIGABRT
);
6111 parse_signal ("emt", SIGEMT
);
6114 parse_signal ("kill", SIGKILL
);
6116 parse_signal ("fpe", SIGFPE
);
6118 parse_signal ("bus", SIGBUS
);
6120 parse_signal ("segv", SIGSEGV
);
6122 parse_signal ("sys", SIGSYS
);
6125 parse_signal ("pipe", SIGPIPE
);
6128 parse_signal ("alrm", SIGALRM
);
6131 parse_signal ("urg", SIGURG
);
6134 parse_signal ("stop", SIGSTOP
);
6137 parse_signal ("tstp", SIGTSTP
);
6140 parse_signal ("cont", SIGCONT
);
6143 parse_signal ("chld", SIGCHLD
);
6146 parse_signal ("ttin", SIGTTIN
);
6149 parse_signal ("ttou", SIGTTOU
);
6152 parse_signal ("io", SIGIO
);
6155 parse_signal ("xcpu", SIGXCPU
);
6158 parse_signal ("xfsz", SIGXFSZ
);
6161 parse_signal ("vtalrm", SIGVTALRM
);
6164 parse_signal ("prof", SIGPROF
);
6167 parse_signal ("winch", SIGWINCH
);
6170 parse_signal ("info", SIGINFO
);
6173 error ("Undefined signal name %s", name
);
6178 return make_number (kill (pid
, XINT (sigcode
)));
6181 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6182 doc
: /* Make PROCESS see end-of-file in its input.
6183 EOF comes after any text already sent to it.
6184 PROCESS may be a process, a buffer, the name of a process or buffer, or
6185 nil, indicating the current buffer's process.
6186 If PROCESS is a network connection, or is a process communicating
6187 through a pipe (as opposed to a pty), then you cannot send any more
6188 text to PROCESS after you call this function.
6189 If PROCESS is a serial process, wait until all output written to the
6190 process has been transmitted to the serial port. */)
6191 (Lisp_Object process
)
6194 struct coding_system
*coding
;
6196 if (DATAGRAM_CONN_P (process
))
6199 proc
= get_process (process
);
6200 coding
= proc_encode_coding_system
[XPROCESS (proc
)->outfd
];
6202 /* Make sure the process is really alive. */
6203 if (XPROCESS (proc
)->raw_status_new
)
6204 update_status (XPROCESS (proc
));
6205 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6206 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6208 if (CODING_REQUIRE_FLUSHING (coding
))
6210 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6211 send_process (proc
, "", 0, Qnil
);
6214 if (XPROCESS (proc
)->pty_flag
)
6215 send_process (proc
, "\004", 1, Qnil
);
6216 else if (EQ (XPROCESS (proc
)->type
, Qserial
))
6219 if (tcdrain (XPROCESS (proc
)->outfd
) != 0)
6220 error ("tcdrain() failed: %s", emacs_strerror (errno
));
6221 #endif /* not WINDOWSNT */
6222 /* Do nothing on Windows because writes are blocking. */
6226 int old_outfd
, new_outfd
;
6228 #ifdef HAVE_SHUTDOWN
6229 /* If this is a network connection, or socketpair is used
6230 for communication with the subprocess, call shutdown to cause EOF.
6231 (In some old system, shutdown to socketpair doesn't work.
6232 Then we just can't win.) */
6233 if (EQ (XPROCESS (proc
)->type
, Qnetwork
)
6234 || XPROCESS (proc
)->outfd
== XPROCESS (proc
)->infd
)
6235 shutdown (XPROCESS (proc
)->outfd
, 1);
6236 /* In case of socketpair, outfd == infd, so don't close it. */
6237 if (XPROCESS (proc
)->outfd
!= XPROCESS (proc
)->infd
)
6238 emacs_close (XPROCESS (proc
)->outfd
);
6239 #else /* not HAVE_SHUTDOWN */
6240 emacs_close (XPROCESS (proc
)->outfd
);
6241 #endif /* not HAVE_SHUTDOWN */
6242 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6245 old_outfd
= XPROCESS (proc
)->outfd
;
6247 if (!proc_encode_coding_system
[new_outfd
])
6248 proc_encode_coding_system
[new_outfd
]
6249 = xmalloc (sizeof (struct coding_system
));
6250 *proc_encode_coding_system
[new_outfd
]
6251 = *proc_encode_coding_system
[old_outfd
];
6252 memset (proc_encode_coding_system
[old_outfd
], 0,
6253 sizeof (struct coding_system
));
6255 XPROCESS (proc
)->outfd
= new_outfd
;
6260 /* If the status of the process DESIRED has changed, return true and
6261 set *STATUS to its exit status; otherwise, return false.
6262 If HAVE is nonnegative, assume that HAVE = waitpid (HAVE, STATUS, ...)
6263 has already been invoked, and do not invoke waitpid again. */
6266 process_status_retrieved (pid_t desired
, pid_t have
, int *status
)
6270 /* Invoke waitpid only with a known process ID; do not invoke
6271 waitpid with a nonpositive argument. Otherwise, Emacs might
6272 reap an unwanted process by mistake. For example, invoking
6273 waitpid (-1, ...) can mess up glib by reaping glib's subprocesses,
6274 so that another thread running glib won't find them. */
6276 have
= waitpid (desired
, status
, WNOHANG
| WUNTRACED
);
6277 while (have
< 0 && errno
== EINTR
);
6280 return have
== desired
;
6283 /* If PID is nonnegative, the child process PID with wait status W has
6284 changed its status; record this and return true.
6286 If PID is negative, ignore W, and look for known child processes
6287 of Emacs whose status have changed. For each one found, record its new
6290 All we do is change the status; we do not run sentinels or print
6291 notifications. That is saved for the next time keyboard input is
6292 done, in order to avoid timing errors.
6294 ** WARNING: this can be called during garbage collection.
6295 Therefore, it must not be fooled by the presence of mark bits in
6298 ** USG WARNING: Although it is not obvious from the documentation
6299 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6300 signal() before executing at least one wait(), otherwise the
6301 handler will be called again, resulting in an infinite loop. The
6302 relevant portion of the documentation reads "SIGCLD signals will be
6303 queued and the signal-catching function will be continually
6304 reentered until the queue is empty". Invoking signal() causes the
6305 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6308 ** Malloc WARNING: This should never call malloc either directly or
6309 indirectly; if it does, that is a bug */
6312 record_child_status_change (pid_t pid
, int w
)
6316 /* On POSIXish hosts, record at most one child only if we already
6317 know one child that has exited. */
6318 bool record_at_most_one_child
= 0 <= pid
;
6322 /* Find the process that signaled us, and record its status. */
6324 /* The process can have been deleted by Fdelete_process. */
6325 for (tail
= deleted_pid_list
; CONSP (tail
); tail
= XCDR (tail
))
6327 bool all_pids_are_fixnums
6328 = (MOST_NEGATIVE_FIXNUM
<= TYPE_MINIMUM (pid_t
)
6329 && TYPE_MAXIMUM (pid_t
) <= MOST_POSITIVE_FIXNUM
);
6330 Lisp_Object xpid
= XCAR (tail
);
6331 if (all_pids_are_fixnums
? INTEGERP (xpid
) : NUMBERP (xpid
))
6334 if (INTEGERP (xpid
))
6335 deleted_pid
= XINT (xpid
);
6337 deleted_pid
= XFLOAT_DATA (xpid
);
6338 if (process_status_retrieved (deleted_pid
, pid
, &w
))
6340 XSETCAR (tail
, Qnil
);
6341 if (record_at_most_one_child
)
6347 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6348 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6350 Lisp_Object proc
= XCDR (XCAR (tail
));
6351 struct Lisp_Process
*p
= XPROCESS (proc
);
6352 if (p
->alive
&& process_status_retrieved (p
->pid
, pid
, &w
))
6354 /* Change the status of the process that was found. */
6355 p
->tick
= ++process_tick
;
6357 p
->raw_status_new
= 1;
6359 /* If process has terminated, stop waiting for its output. */
6360 if (WIFSIGNALED (w
) || WIFEXITED (w
))
6362 int clear_desc_flag
= 0;
6365 clear_desc_flag
= 1;
6367 /* clear_desc_flag avoids a compiler bug in Microsoft C. */
6368 if (clear_desc_flag
)
6370 FD_CLR (p
->infd
, &input_wait_mask
);
6371 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6375 /* Tell wait_reading_process_output that it needs to wake up and
6377 if (input_available_clear_time
)
6378 *input_available_clear_time
= make_emacs_time (0, 0);
6380 if (record_at_most_one_child
)
6387 /* The caller successfully waited for a pid but no asynchronous
6388 process was found for it, so this is a synchronous process. */
6390 synch_process_alive
= 0;
6392 /* Report the status of the synchronous process. */
6394 synch_process_retcode
= WEXITSTATUS (w
);
6395 else if (WIFSIGNALED (w
))
6396 synch_process_termsig
= WTERMSIG (w
);
6398 /* Tell wait_reading_process_output that it needs to wake up and
6400 if (input_available_clear_time
)
6401 *input_available_clear_time
= make_emacs_time (0, 0);
6409 handle_child_signal (int sig
)
6411 record_child_status_change (-1, 0);
6415 deliver_child_signal (int sig
)
6417 deliver_process_signal (sig
, handle_child_signal
);
6420 #endif /* SIGCHLD */
6424 exec_sentinel_unwind (Lisp_Object data
)
6426 pset_sentinel (XPROCESS (XCAR (data
)), XCDR (data
));
6431 exec_sentinel_error_handler (Lisp_Object error_val
)
6433 cmd_error_internal (error_val
, "error in process sentinel: ");
6435 update_echo_area ();
6436 Fsleep_for (make_number (2), Qnil
);
6441 exec_sentinel (Lisp_Object proc
, Lisp_Object reason
)
6443 Lisp_Object sentinel
, odeactivate
;
6444 struct Lisp_Process
*p
= XPROCESS (proc
);
6445 ptrdiff_t count
= SPECPDL_INDEX ();
6446 bool outer_running_asynch_code
= running_asynch_code
;
6447 int waiting
= waiting_for_user_input_p
;
6449 if (inhibit_sentinels
)
6452 /* No need to gcpro these, because all we do with them later
6453 is test them for EQness, and none of them should be a string. */
6454 odeactivate
= Vdeactivate_mark
;
6456 Lisp_Object obuffer
, okeymap
;
6457 XSETBUFFER (obuffer
, current_buffer
);
6458 okeymap
= BVAR (current_buffer
, keymap
);
6461 /* There's no good reason to let sentinels change the current
6462 buffer, and many callers of accept-process-output, sit-for, and
6463 friends don't expect current-buffer to be changed from under them. */
6464 record_unwind_current_buffer ();
6466 sentinel
= p
->sentinel
;
6467 if (NILP (sentinel
))
6470 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6471 assure that it gets restored no matter how the sentinel exits. */
6472 pset_sentinel (p
, Qnil
);
6473 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6474 /* Inhibit quit so that random quits don't screw up a running filter. */
6475 specbind (Qinhibit_quit
, Qt
);
6476 specbind (Qlast_nonmenu_event
, Qt
); /* Why? --Stef */
6478 /* In case we get recursively called,
6479 and we already saved the match data nonrecursively,
6480 save the same match data in safely recursive fashion. */
6481 if (outer_running_asynch_code
)
6484 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6485 restore_search_regs ();
6486 record_unwind_save_match_data ();
6487 Fset_match_data (tem
, Qt
);
6490 /* For speed, if a search happens within this code,
6491 save the match data in a special nonrecursive fashion. */
6492 running_asynch_code
= 1;
6494 internal_condition_case_1 (read_process_output_call
,
6496 Fcons (proc
, Fcons (reason
, Qnil
))),
6497 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6498 exec_sentinel_error_handler
);
6500 /* If we saved the match data nonrecursively, restore it now. */
6501 restore_search_regs ();
6502 running_asynch_code
= outer_running_asynch_code
;
6504 Vdeactivate_mark
= odeactivate
;
6506 /* Restore waiting_for_user_input_p as it was
6507 when we were called, in case the filter clobbered it. */
6508 waiting_for_user_input_p
= waiting
;
6511 if (! EQ (Fcurrent_buffer (), obuffer
)
6512 || ! EQ (current_buffer
->keymap
, okeymap
))
6514 /* But do it only if the caller is actually going to read events.
6515 Otherwise there's no need to make him wake up, and it could
6516 cause trouble (for example it would make sit_for return). */
6517 if (waiting_for_user_input_p
== -1)
6518 record_asynch_buffer_change ();
6520 unbind_to (count
, Qnil
);
6523 /* Report all recent events of a change in process status
6524 (either run the sentinel or output a message).
6525 This is usually done while Emacs is waiting for keyboard input
6526 but can be done at other times. */
6529 status_notify (struct Lisp_Process
*deleting_process
)
6531 register Lisp_Object proc
, buffer
;
6532 Lisp_Object tail
, msg
;
6533 struct gcpro gcpro1
, gcpro2
;
6537 /* We need to gcpro tail; if read_process_output calls a filter
6538 which deletes a process and removes the cons to which tail points
6539 from Vprocess_alist, and then causes a GC, tail is an unprotected
6543 /* Set this now, so that if new processes are created by sentinels
6544 that we run, we get called again to handle their status changes. */
6545 update_tick
= process_tick
;
6547 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6550 register struct Lisp_Process
*p
;
6552 proc
= Fcdr (XCAR (tail
));
6553 p
= XPROCESS (proc
);
6555 if (p
->tick
!= p
->update_tick
)
6557 p
->update_tick
= p
->tick
;
6559 /* If process is still active, read any output that remains. */
6560 while (! EQ (p
->filter
, Qt
)
6561 && ! EQ (p
->status
, Qconnect
)
6562 && ! EQ (p
->status
, Qlisten
)
6563 /* Network or serial process not stopped: */
6564 && ! EQ (p
->command
, Qt
)
6566 && p
!= deleting_process
6567 && read_process_output (proc
, p
->infd
) > 0);
6571 /* Get the text to use for the message. */
6572 if (p
->raw_status_new
)
6574 msg
= status_message (p
);
6576 /* If process is terminated, deactivate it or delete it. */
6578 if (CONSP (p
->status
))
6579 symbol
= XCAR (p
->status
);
6581 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6582 || EQ (symbol
, Qclosed
))
6584 if (delete_exited_processes
)
6585 remove_process (proc
);
6587 deactivate_process (proc
);
6590 /* The actions above may have further incremented p->tick.
6591 So set p->update_tick again
6592 so that an error in the sentinel will not cause
6593 this code to be run again. */
6594 p
->update_tick
= p
->tick
;
6595 /* Now output the message suitably. */
6596 if (!NILP (p
->sentinel
))
6597 exec_sentinel (proc
, msg
);
6598 /* Don't bother with a message in the buffer
6599 when a process becomes runnable. */
6600 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6603 struct buffer
*old
= current_buffer
;
6604 ptrdiff_t opoint
, opoint_byte
;
6605 ptrdiff_t before
, before_byte
;
6607 /* Avoid error if buffer is deleted
6608 (probably that's why the process is dead, too) */
6609 if (!BUFFER_LIVE_P (XBUFFER (buffer
)))
6611 Fset_buffer (buffer
);
6614 opoint_byte
= PT_BYTE
;
6615 /* Insert new output into buffer
6616 at the current end-of-output marker,
6617 thus preserving logical ordering of input and output. */
6618 if (XMARKER (p
->mark
)->buffer
)
6619 Fgoto_char (p
->mark
);
6621 SET_PT_BOTH (ZV
, ZV_BYTE
);
6624 before_byte
= PT_BYTE
;
6626 tem
= BVAR (current_buffer
, read_only
);
6627 bset_read_only (current_buffer
, Qnil
);
6628 insert_string ("\nProcess ");
6629 { /* FIXME: temporary kludge */
6630 Lisp_Object tem2
= p
->name
; Finsert (1, &tem2
); }
6631 insert_string (" ");
6633 bset_read_only (current_buffer
, tem
);
6634 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6636 if (opoint
>= before
)
6637 SET_PT_BOTH (opoint
+ (PT
- before
),
6638 opoint_byte
+ (PT_BYTE
- before_byte
));
6640 SET_PT_BOTH (opoint
, opoint_byte
);
6642 set_buffer_internal (old
);
6647 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6652 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6653 Sset_process_coding_system
, 1, 3, 0,
6654 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6655 DECODING will be used to decode subprocess output and ENCODING to
6656 encode subprocess input. */)
6657 (register Lisp_Object process
, Lisp_Object decoding
, Lisp_Object encoding
)
6659 register struct Lisp_Process
*p
;
6661 CHECK_PROCESS (process
);
6662 p
= XPROCESS (process
);
6664 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6666 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6667 Fcheck_coding_system (decoding
);
6668 Fcheck_coding_system (encoding
);
6669 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
6670 pset_decode_coding_system (p
, decoding
);
6671 pset_encode_coding_system (p
, encoding
);
6672 setup_process_coding_systems (process
);
6677 DEFUN ("process-coding-system",
6678 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6679 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6680 (register Lisp_Object process
)
6682 CHECK_PROCESS (process
);
6683 return Fcons (XPROCESS (process
)->decode_coding_system
,
6684 XPROCESS (process
)->encode_coding_system
);
6687 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6688 Sset_process_filter_multibyte
, 2, 2, 0,
6689 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6690 If FLAG is non-nil, the filter is given multibyte strings.
6691 If FLAG is nil, the filter is given unibyte strings. In this case,
6692 all character code conversion except for end-of-line conversion is
6694 (Lisp_Object process
, Lisp_Object flag
)
6696 register struct Lisp_Process
*p
;
6698 CHECK_PROCESS (process
);
6699 p
= XPROCESS (process
);
6701 pset_decode_coding_system
6702 (p
, raw_text_coding_system (p
->decode_coding_system
));
6703 setup_process_coding_systems (process
);
6708 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6709 Sprocess_filter_multibyte_p
, 1, 1, 0,
6710 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6711 (Lisp_Object process
)
6713 register struct Lisp_Process
*p
;
6714 struct coding_system
*coding
;
6716 CHECK_PROCESS (process
);
6717 p
= XPROCESS (process
);
6718 coding
= proc_decode_coding_system
[p
->infd
];
6719 return (CODING_FOR_UNIBYTE (coding
) ? Qnil
: Qt
);
6728 add_gpm_wait_descriptor (int desc
)
6730 add_keyboard_wait_descriptor (desc
);
6734 delete_gpm_wait_descriptor (int desc
)
6736 delete_keyboard_wait_descriptor (desc
);
6741 # ifdef USABLE_SIGIO
6743 /* Return nonzero if *MASK has a bit set
6744 that corresponds to one of the keyboard input descriptors. */
6747 keyboard_bit_set (fd_set
*mask
)
6751 for (fd
= 0; fd
<= max_input_desc
; fd
++)
6752 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6753 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6760 #else /* not subprocesses */
6762 /* Defined on msdos.c. */
6763 extern int sys_select (int, SELECT_TYPE
*, SELECT_TYPE
*, SELECT_TYPE
*,
6764 EMACS_TIME
*, void *);
6766 /* Implementation of wait_reading_process_output, assuming that there
6767 are no subprocesses. Used only by the MS-DOS build.
6769 Wait for timeout to elapse and/or keyboard input to be available.
6773 If negative, gobble data immediately available but don't wait for any.
6776 an additional duration to wait, measured in nanoseconds
6777 If TIME_LIMIT is zero, then:
6778 If NSECS == 0, there is no limit.
6779 If NSECS > 0, the timeout consists of NSECS only.
6780 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
6783 0 to ignore keyboard input, or
6784 1 to return when input is available, or
6785 -1 means caller will actually read the input, so don't throw to
6788 see full version for other parameters. We know that wait_proc will
6789 always be NULL, since `subprocesses' isn't defined.
6791 DO_DISPLAY means redisplay should be done to show subprocess
6792 output that arrives.
6794 Return true if we received input from any process. */
6797 wait_reading_process_output (intmax_t time_limit
, int nsecs
, int read_kbd
,
6799 Lisp_Object wait_for_cell
,
6800 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
6803 EMACS_TIME end_time
, timeout
;
6810 else if (TYPE_MAXIMUM (time_t) < time_limit
)
6811 time_limit
= TYPE_MAXIMUM (time_t);
6813 /* What does time_limit really mean? */
6814 if (time_limit
|| 0 < nsecs
)
6816 timeout
= make_emacs_time (time_limit
, nsecs
);
6817 end_time
= add_emacs_time (current_emacs_time (), timeout
);
6820 /* Turn off periodic alarms (in case they are in use)
6821 and then turn off any other atimers,
6822 because the select emulator uses alarms. */
6824 turn_on_atimers (0);
6828 int timeout_reduced_for_timers
= 0;
6829 SELECT_TYPE waitchannels
;
6832 /* If calling from keyboard input, do not quit
6833 since we want to return C-g as an input character.
6834 Otherwise, do pending quit if requested. */
6838 /* Exit now if the cell we're waiting for became non-nil. */
6839 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6842 /* Compute time from now till when time limit is up */
6843 /* Exit if already run out */
6846 /* A negative timeout means
6847 gobble output available now
6848 but don't wait at all. */
6850 timeout
= make_emacs_time (0, 0);
6852 else if (time_limit
|| 0 < nsecs
)
6854 EMACS_TIME now
= current_emacs_time ();
6855 if (EMACS_TIME_LE (end_time
, now
))
6857 timeout
= sub_emacs_time (end_time
, now
);
6861 timeout
= make_emacs_time (100000, 0);
6864 /* If our caller will not immediately handle keyboard events,
6865 run timer events directly.
6866 (Callers that will immediately read keyboard events
6867 call timer_delay on their own.) */
6868 if (NILP (wait_for_cell
))
6870 EMACS_TIME timer_delay
;
6874 unsigned old_timers_run
= timers_run
;
6875 timer_delay
= timer_check ();
6876 if (timers_run
!= old_timers_run
&& do_display
)
6877 /* We must retry, since a timer may have requeued itself
6878 and that could alter the time delay. */
6879 redisplay_preserve_echo_area (14);
6883 while (!detect_input_pending ());
6885 /* If there is unread keyboard input, also return. */
6887 && requeued_events_pending_p ())
6890 if (EMACS_TIME_VALID_P (timer_delay
) && 0 <= nsecs
)
6892 if (EMACS_TIME_LT (timer_delay
, timeout
))
6894 timeout
= timer_delay
;
6895 timeout_reduced_for_timers
= 1;
6900 /* Cause C-g and alarm signals to take immediate action,
6901 and cause input available signals to zero out timeout. */
6903 set_waiting_for_input (&timeout
);
6905 /* If a frame has been newly mapped and needs updating,
6906 reprocess its display stuff. */
6907 if (frame_garbaged
&& do_display
)
6909 clear_waiting_for_input ();
6910 redisplay_preserve_echo_area (15);
6912 set_waiting_for_input (&timeout
);
6915 /* Wait till there is something to do. */
6916 FD_ZERO (&waitchannels
);
6917 if (read_kbd
&& detect_input_pending ())
6921 if (read_kbd
|| !NILP (wait_for_cell
))
6922 FD_SET (0, &waitchannels
);
6923 nfds
= pselect (1, &waitchannels
, NULL
, NULL
, &timeout
, NULL
);
6928 /* Make C-g and alarm signals set flags again */
6929 clear_waiting_for_input ();
6931 /* If we woke up due to SIGWINCH, actually change size now. */
6932 do_pending_window_change (0);
6934 if ((time_limit
|| nsecs
) && nfds
== 0 && ! timeout_reduced_for_timers
)
6935 /* We waited the full specified time, so return now. */
6940 /* If the system call was interrupted, then go around the
6942 if (xerrno
== EINTR
)
6943 FD_ZERO (&waitchannels
);
6945 error ("select error: %s", emacs_strerror (xerrno
));
6948 /* Check for keyboard input */
6951 && detect_input_pending_run_timers (do_display
))
6953 swallow_events (do_display
);
6954 if (detect_input_pending_run_timers (do_display
))
6958 /* If there is unread keyboard input, also return. */
6960 && requeued_events_pending_p ())
6963 /* If wait_for_cell. check for keyboard input
6964 but don't run any timers.
6965 ??? (It seems wrong to me to check for keyboard
6966 input at all when wait_for_cell, but the code
6967 has been this way since July 1994.
6968 Try changing this after version 19.31.) */
6969 if (! NILP (wait_for_cell
)
6970 && detect_input_pending ())
6972 swallow_events (do_display
);
6973 if (detect_input_pending ())
6977 /* Exit now if the cell we're waiting for became non-nil. */
6978 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6987 #endif /* not subprocesses */
6989 /* The following functions are needed even if async subprocesses are
6990 not supported. Some of them are no-op stubs in that case. */
6992 /* Add DESC to the set of keyboard input descriptors. */
6995 add_keyboard_wait_descriptor (int desc
)
6997 #ifdef subprocesses /* actually means "not MSDOS" */
6998 FD_SET (desc
, &input_wait_mask
);
6999 FD_SET (desc
, &non_process_wait_mask
);
7000 if (desc
> max_input_desc
)
7001 max_input_desc
= desc
;
7005 /* From now on, do not expect DESC to give keyboard input. */
7008 delete_keyboard_wait_descriptor (int desc
)
7012 int lim
= max_input_desc
;
7014 FD_CLR (desc
, &input_wait_mask
);
7015 FD_CLR (desc
, &non_process_wait_mask
);
7017 if (desc
== max_input_desc
)
7018 for (fd
= 0; fd
< lim
; fd
++)
7019 if (FD_ISSET (fd
, &input_wait_mask
) || FD_ISSET (fd
, &write_mask
))
7020 max_input_desc
= fd
;
7024 /* Setup coding systems of PROCESS. */
7027 setup_process_coding_systems (Lisp_Object process
)
7030 struct Lisp_Process
*p
= XPROCESS (process
);
7032 int outch
= p
->outfd
;
7033 Lisp_Object coding_system
;
7035 if (inch
< 0 || outch
< 0)
7038 if (!proc_decode_coding_system
[inch
])
7039 proc_decode_coding_system
[inch
] = xmalloc (sizeof (struct coding_system
));
7040 coding_system
= p
->decode_coding_system
;
7041 if (! NILP (p
->filter
))
7043 else if (BUFFERP (p
->buffer
))
7045 if (NILP (BVAR (XBUFFER (p
->buffer
), enable_multibyte_characters
)))
7046 coding_system
= raw_text_coding_system (coding_system
);
7048 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
7050 if (!proc_encode_coding_system
[outch
])
7051 proc_encode_coding_system
[outch
] = xmalloc (sizeof (struct coding_system
));
7052 setup_coding_system (p
->encode_coding_system
,
7053 proc_encode_coding_system
[outch
]);
7057 /* Close all descriptors currently in use for communication
7058 with subprocess. This is used in a newly-forked subprocess
7059 to get rid of irrelevant descriptors. */
7062 close_process_descs (void)
7066 for (i
= 0; i
< MAXDESC
; i
++)
7068 Lisp_Object process
;
7069 process
= chan_process
[i
];
7070 if (!NILP (process
))
7072 int in
= XPROCESS (process
)->infd
;
7073 int out
= XPROCESS (process
)->outfd
;
7076 if (out
>= 0 && in
!= out
)
7083 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7084 doc
: /* Return the (or a) process associated with BUFFER.
7085 BUFFER may be a buffer or the name of one. */)
7086 (register Lisp_Object buffer
)
7089 register Lisp_Object buf
, tail
, proc
;
7091 if (NILP (buffer
)) return Qnil
;
7092 buf
= Fget_buffer (buffer
);
7093 if (NILP (buf
)) return Qnil
;
7095 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
7097 proc
= Fcdr (XCAR (tail
));
7098 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
7101 #endif /* subprocesses */
7105 DEFUN ("process-inherit-coding-system-flag",
7106 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7108 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
7109 If this flag is t, `buffer-file-coding-system' of the buffer
7110 associated with PROCESS will inherit the coding system used to decode
7111 the process output. */)
7112 (register Lisp_Object process
)
7115 CHECK_PROCESS (process
);
7116 return XPROCESS (process
)->inherit_coding_system_flag
? Qt
: Qnil
;
7118 /* Ignore the argument and return the value of
7119 inherit-process-coding-system. */
7120 return inherit_process_coding_system
? Qt
: Qnil
;
7124 /* Kill all processes associated with `buffer'.
7125 If `buffer' is nil, kill all processes */
7128 kill_buffer_processes (Lisp_Object buffer
)
7131 Lisp_Object tail
, proc
;
7133 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
7135 proc
= XCDR (XCAR (tail
));
7137 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
7139 if (NETCONN_P (proc
) || SERIALCONN_P (proc
))
7140 Fdelete_process (proc
);
7141 else if (XPROCESS (proc
)->infd
>= 0)
7142 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
7145 #else /* subprocesses */
7146 /* Since we have no subprocesses, this does nothing. */
7147 #endif /* subprocesses */
7150 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
,
7151 Swaiting_for_user_input_p
, 0, 0, 0,
7152 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
7153 This is intended for use by asynchronous process output filters and sentinels. */)
7157 return (waiting_for_user_input_p
? Qt
: Qnil
);
7163 /* Stop reading input from keyboard sources. */
7166 hold_keyboard_input (void)
7171 /* Resume reading input from keyboard sources. */
7174 unhold_keyboard_input (void)
7179 /* Return non-zero if keyboard input is on hold, zero otherwise. */
7182 kbd_on_hold_p (void)
7184 return kbd_is_on_hold
;
7188 /* Enumeration of and access to system processes a-la ps(1). */
7190 DEFUN ("list-system-processes", Flist_system_processes
, Slist_system_processes
,
7192 doc
: /* Return a list of numerical process IDs of all running processes.
7193 If this functionality is unsupported, return nil.
7195 See `process-attributes' for getting attributes of a process given its ID. */)
7198 return list_system_processes ();
7201 DEFUN ("process-attributes", Fprocess_attributes
,
7202 Sprocess_attributes
, 1, 1, 0,
7203 doc
: /* Return attributes of the process given by its PID, a number.
7205 Value is an alist where each element is a cons cell of the form
7209 If this functionality is unsupported, the value is nil.
7211 See `list-system-processes' for getting a list of all process IDs.
7213 The KEYs of the attributes that this function may return are listed
7214 below, together with the type of the associated VALUE (in parentheses).
7215 Not all platforms support all of these attributes; unsupported
7216 attributes will not appear in the returned alist.
7217 Unless explicitly indicated otherwise, numbers can have either
7218 integer or floating point values.
7220 euid -- Effective user User ID of the process (number)
7221 user -- User name corresponding to euid (string)
7222 egid -- Effective user Group ID of the process (number)
7223 group -- Group name corresponding to egid (string)
7224 comm -- Command name (executable name only) (string)
7225 state -- Process state code, such as "S", "R", or "T" (string)
7226 ppid -- Parent process ID (number)
7227 pgrp -- Process group ID (number)
7228 sess -- Session ID, i.e. process ID of session leader (number)
7229 ttname -- Controlling tty name (string)
7230 tpgid -- ID of foreground process group on the process's tty (number)
7231 minflt -- number of minor page faults (number)
7232 majflt -- number of major page faults (number)
7233 cminflt -- cumulative number of minor page faults (number)
7234 cmajflt -- cumulative number of major page faults (number)
7235 utime -- user time used by the process, in (current-time) format,
7236 which is a list of integers (HIGH LOW USEC PSEC)
7237 stime -- system time used by the process (current-time)
7238 time -- sum of utime and stime (current-time)
7239 cutime -- user time used by the process and its children (current-time)
7240 cstime -- system time used by the process and its children (current-time)
7241 ctime -- sum of cutime and cstime (current-time)
7242 pri -- priority of the process (number)
7243 nice -- nice value of the process (number)
7244 thcount -- process thread count (number)
7245 start -- time the process started (current-time)
7246 vsize -- virtual memory size of the process in KB's (number)
7247 rss -- resident set size of the process in KB's (number)
7248 etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
7249 pcpu -- percents of CPU time used by the process (floating-point number)
7250 pmem -- percents of total physical memory used by process's resident set
7251 (floating-point number)
7252 args -- command line which invoked the process (string). */)
7255 return system_process_attributes (pid
);
7259 /* This is not called "init_process" because that is the name of a
7260 Mach system call, so it would cause problems on Darwin systems. */
7262 init_process_emacs (void)
7267 inhibit_sentinels
= 0;
7271 if (! noninteractive
|| initialized
)
7274 struct sigaction action
;
7275 emacs_sigaction_init (&action
, deliver_child_signal
);
7276 sigaction (SIGCHLD
, &action
, 0);
7280 FD_ZERO (&input_wait_mask
);
7281 FD_ZERO (&non_keyboard_wait_mask
);
7282 FD_ZERO (&non_process_wait_mask
);
7283 FD_ZERO (&write_mask
);
7284 max_process_desc
= 0;
7285 memset (fd_callback_info
, 0, sizeof (fd_callback_info
));
7287 #ifdef NON_BLOCKING_CONNECT
7288 FD_ZERO (&connect_wait_mask
);
7289 num_pending_connects
= 0;
7292 #ifdef ADAPTIVE_READ_BUFFERING
7293 process_output_delay_count
= 0;
7294 process_output_skip
= 0;
7297 /* Don't do this, it caused infinite select loops. The display
7298 method should call add_keyboard_wait_descriptor on stdin if it
7301 FD_SET (0, &input_wait_mask
);
7304 Vprocess_alist
= Qnil
;
7306 deleted_pid_list
= Qnil
;
7308 for (i
= 0; i
< MAXDESC
; i
++)
7310 chan_process
[i
] = Qnil
;
7311 proc_buffered_char
[i
] = -1;
7313 memset (proc_decode_coding_system
, 0, sizeof proc_decode_coding_system
);
7314 memset (proc_encode_coding_system
, 0, sizeof proc_encode_coding_system
);
7315 #ifdef DATAGRAM_SOCKETS
7316 memset (datagram_address
, 0, sizeof datagram_address
);
7320 Lisp_Object subfeatures
= Qnil
;
7321 const struct socket_options
*sopt
;
7323 #define ADD_SUBFEATURE(key, val) \
7324 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
7326 #ifdef NON_BLOCKING_CONNECT
7327 ADD_SUBFEATURE (QCnowait
, Qt
);
7329 #ifdef DATAGRAM_SOCKETS
7330 ADD_SUBFEATURE (QCtype
, Qdatagram
);
7332 #ifdef HAVE_SEQPACKET
7333 ADD_SUBFEATURE (QCtype
, Qseqpacket
);
7335 #ifdef HAVE_LOCAL_SOCKETS
7336 ADD_SUBFEATURE (QCfamily
, Qlocal
);
7338 ADD_SUBFEATURE (QCfamily
, Qipv4
);
7340 ADD_SUBFEATURE (QCfamily
, Qipv6
);
7342 #ifdef HAVE_GETSOCKNAME
7343 ADD_SUBFEATURE (QCservice
, Qt
);
7345 #if defined (O_NONBLOCK) || defined (O_NDELAY)
7346 ADD_SUBFEATURE (QCserver
, Qt
);
7349 for (sopt
= socket_options
; sopt
->name
; sopt
++)
7350 subfeatures
= pure_cons (intern_c_string (sopt
->name
), subfeatures
);
7352 Fprovide (intern_c_string ("make-network-process"), subfeatures
);
7355 #if defined (DARWIN_OS)
7356 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7357 processes. As such, we only change the default value. */
7360 char const *release
= (STRINGP (Voperating_system_release
)
7361 ? SSDATA (Voperating_system_release
)
7363 if (!release
|| !release
[0] || (release
[0] < '7' && release
[1] == '.')) {
7364 Vprocess_connection_type
= Qnil
;
7368 #endif /* subprocesses */
7373 syms_of_process (void)
7377 DEFSYM (Qprocessp
, "processp");
7378 DEFSYM (Qrun
, "run");
7379 DEFSYM (Qstop
, "stop");
7380 DEFSYM (Qsignal
, "signal");
7382 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7385 Qexit = intern_c_string ("exit");
7386 staticpro (&Qexit); */
7388 DEFSYM (Qopen
, "open");
7389 DEFSYM (Qclosed
, "closed");
7390 DEFSYM (Qconnect
, "connect");
7391 DEFSYM (Qfailed
, "failed");
7392 DEFSYM (Qlisten
, "listen");
7393 DEFSYM (Qlocal
, "local");
7394 DEFSYM (Qipv4
, "ipv4");
7396 DEFSYM (Qipv6
, "ipv6");
7398 DEFSYM (Qdatagram
, "datagram");
7399 DEFSYM (Qseqpacket
, "seqpacket");
7401 DEFSYM (QCport
, ":port");
7402 DEFSYM (QCspeed
, ":speed");
7403 DEFSYM (QCprocess
, ":process");
7405 DEFSYM (QCbytesize
, ":bytesize");
7406 DEFSYM (QCstopbits
, ":stopbits");
7407 DEFSYM (QCparity
, ":parity");
7408 DEFSYM (Qodd
, "odd");
7409 DEFSYM (Qeven
, "even");
7410 DEFSYM (QCflowcontrol
, ":flowcontrol");
7413 DEFSYM (QCsummary
, ":summary");
7415 DEFSYM (Qreal
, "real");
7416 DEFSYM (Qnetwork
, "network");
7417 DEFSYM (Qserial
, "serial");
7418 DEFSYM (QCbuffer
, ":buffer");
7419 DEFSYM (QChost
, ":host");
7420 DEFSYM (QCservice
, ":service");
7421 DEFSYM (QClocal
, ":local");
7422 DEFSYM (QCremote
, ":remote");
7423 DEFSYM (QCcoding
, ":coding");
7424 DEFSYM (QCserver
, ":server");
7425 DEFSYM (QCnowait
, ":nowait");
7426 DEFSYM (QCsentinel
, ":sentinel");
7427 DEFSYM (QClog
, ":log");
7428 DEFSYM (QCnoquery
, ":noquery");
7429 DEFSYM (QCstop
, ":stop");
7430 DEFSYM (QCoptions
, ":options");
7431 DEFSYM (QCplist
, ":plist");
7433 DEFSYM (Qlast_nonmenu_event
, "last-nonmenu-event");
7435 staticpro (&Vprocess_alist
);
7437 staticpro (&deleted_pid_list
);
7440 #endif /* subprocesses */
7442 DEFSYM (QCname
, ":name");
7443 DEFSYM (QCtype
, ":type");
7445 DEFSYM (Qeuid
, "euid");
7446 DEFSYM (Qegid
, "egid");
7447 DEFSYM (Quser
, "user");
7448 DEFSYM (Qgroup
, "group");
7449 DEFSYM (Qcomm
, "comm");
7450 DEFSYM (Qstate
, "state");
7451 DEFSYM (Qppid
, "ppid");
7452 DEFSYM (Qpgrp
, "pgrp");
7453 DEFSYM (Qsess
, "sess");
7454 DEFSYM (Qttname
, "ttname");
7455 DEFSYM (Qtpgid
, "tpgid");
7456 DEFSYM (Qminflt
, "minflt");
7457 DEFSYM (Qmajflt
, "majflt");
7458 DEFSYM (Qcminflt
, "cminflt");
7459 DEFSYM (Qcmajflt
, "cmajflt");
7460 DEFSYM (Qutime
, "utime");
7461 DEFSYM (Qstime
, "stime");
7462 DEFSYM (Qtime
, "time");
7463 DEFSYM (Qcutime
, "cutime");
7464 DEFSYM (Qcstime
, "cstime");
7465 DEFSYM (Qctime
, "ctime");
7466 DEFSYM (Qpri
, "pri");
7467 DEFSYM (Qnice
, "nice");
7468 DEFSYM (Qthcount
, "thcount");
7469 DEFSYM (Qstart
, "start");
7470 DEFSYM (Qvsize
, "vsize");
7471 DEFSYM (Qrss
, "rss");
7472 DEFSYM (Qetime
, "etime");
7473 DEFSYM (Qpcpu
, "pcpu");
7474 DEFSYM (Qpmem
, "pmem");
7475 DEFSYM (Qargs
, "args");
7477 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes
,
7478 doc
: /* Non-nil means delete processes immediately when they exit.
7479 A value of nil means don't delete them until `list-processes' is run. */);
7481 delete_exited_processes
= 1;
7484 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type
,
7485 doc
: /* Control type of device used to communicate with subprocesses.
7486 Values are nil to use a pipe, or t or `pty' to use a pty.
7487 The value has no effect if the system has no ptys or if all ptys are busy:
7488 then a pipe is used in any case.
7489 The value takes effect when `start-process' is called. */);
7490 Vprocess_connection_type
= Qt
;
7492 #ifdef ADAPTIVE_READ_BUFFERING
7493 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering
,
7494 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7495 On some systems, when Emacs reads the output from a subprocess, the output data
7496 is read in very small blocks, potentially resulting in very poor performance.
7497 This behavior can be remedied to some extent by setting this variable to a
7498 non-nil value, as it will automatically delay reading from such processes, to
7499 allow them to produce more output before Emacs tries to read it.
7500 If the value is t, the delay is reset after each write to the process; any other
7501 non-nil value means that the delay is not reset on write.
7502 The variable takes effect when `start-process' is called. */);
7503 Vprocess_adaptive_read_buffering
= Qt
;
7506 defsubr (&Sprocessp
);
7507 defsubr (&Sget_process
);
7508 defsubr (&Sdelete_process
);
7509 defsubr (&Sprocess_status
);
7510 defsubr (&Sprocess_exit_status
);
7511 defsubr (&Sprocess_id
);
7512 defsubr (&Sprocess_name
);
7513 defsubr (&Sprocess_tty_name
);
7514 defsubr (&Sprocess_command
);
7515 defsubr (&Sset_process_buffer
);
7516 defsubr (&Sprocess_buffer
);
7517 defsubr (&Sprocess_mark
);
7518 defsubr (&Sset_process_filter
);
7519 defsubr (&Sprocess_filter
);
7520 defsubr (&Sset_process_sentinel
);
7521 defsubr (&Sprocess_sentinel
);
7522 defsubr (&Sset_process_window_size
);
7523 defsubr (&Sset_process_inherit_coding_system_flag
);
7524 defsubr (&Sset_process_query_on_exit_flag
);
7525 defsubr (&Sprocess_query_on_exit_flag
);
7526 defsubr (&Sprocess_contact
);
7527 defsubr (&Sprocess_plist
);
7528 defsubr (&Sset_process_plist
);
7529 defsubr (&Sprocess_list
);
7530 defsubr (&Sstart_process
);
7531 defsubr (&Sserial_process_configure
);
7532 defsubr (&Smake_serial_process
);
7533 defsubr (&Sset_network_process_option
);
7534 defsubr (&Smake_network_process
);
7535 defsubr (&Sformat_network_address
);
7536 #if defined (HAVE_NET_IF_H)
7538 defsubr (&Snetwork_interface_list
);
7540 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
7541 defsubr (&Snetwork_interface_info
);
7543 #endif /* defined (HAVE_NET_IF_H) */
7544 #ifdef DATAGRAM_SOCKETS
7545 defsubr (&Sprocess_datagram_address
);
7546 defsubr (&Sset_process_datagram_address
);
7548 defsubr (&Saccept_process_output
);
7549 defsubr (&Sprocess_send_region
);
7550 defsubr (&Sprocess_send_string
);
7551 defsubr (&Sinterrupt_process
);
7552 defsubr (&Skill_process
);
7553 defsubr (&Squit_process
);
7554 defsubr (&Sstop_process
);
7555 defsubr (&Scontinue_process
);
7556 defsubr (&Sprocess_running_child_p
);
7557 defsubr (&Sprocess_send_eof
);
7558 defsubr (&Ssignal_process
);
7559 defsubr (&Swaiting_for_user_input_p
);
7560 defsubr (&Sprocess_type
);
7561 defsubr (&Sset_process_coding_system
);
7562 defsubr (&Sprocess_coding_system
);
7563 defsubr (&Sset_process_filter_multibyte
);
7564 defsubr (&Sprocess_filter_multibyte_p
);
7566 #endif /* subprocesses */
7568 defsubr (&Sget_buffer_process
);
7569 defsubr (&Sprocess_inherit_coding_system_flag
);
7570 defsubr (&Slist_system_processes
);
7571 defsubr (&Sprocess_attributes
);