1 /* Asynchronous subprocess control for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2011
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
27 #include <sys/types.h> /* some typedefs are used in sys/file.h */
31 #ifdef HAVE_INTTYPES_H
38 /* Only MS-DOS does not define `subprocesses'. */
41 #include <sys/socket.h>
43 #include <netinet/in.h>
44 #include <arpa/inet.h>
46 /* Are local (unix) sockets supported? */
47 #if defined (HAVE_SYS_UN_H)
48 #if !defined (AF_LOCAL) && defined (AF_UNIX)
49 #define AF_LOCAL AF_UNIX
52 #define HAVE_LOCAL_SOCKETS
57 #include <sys/ioctl.h>
58 #if defined(HAVE_NET_IF_H)
60 #endif /* HAVE_NET_IF_H */
67 #include <netinet/in.h>
68 #include <arpa/nameser.h>
80 #endif /* subprocesses */
88 #include "character.h"
92 #include "termhooks.h"
96 #include "blockinput.h"
97 #include "dispextern.h"
98 #include "composite.h"
100 #include "sysselect.h"
101 #include "syssignal.h"
107 #if defined (USE_GTK) || defined (HAVE_GCONF)
108 #include "xgselect.h"
109 #endif /* defined (USE_GTK) || defined (HAVE_GCONF) */
114 Lisp_Object Qeuid
, Qegid
, Qcomm
, Qstate
, Qppid
, Qpgrp
, Qsess
, Qttname
, Qtpgid
;
115 Lisp_Object Qminflt
, Qmajflt
, Qcminflt
, Qcmajflt
, Qutime
, Qstime
, Qcstime
;
116 Lisp_Object Qcutime
, Qpri
, Qnice
, Qthcount
, Qstart
, Qvsize
, Qrss
, Qargs
;
117 Lisp_Object Quser
, Qgroup
, Qetime
, Qpcpu
, Qpmem
, Qtime
, Qctime
;
118 Lisp_Object QCname
, QCtype
;
120 /* Non-zero if keyboard input is on hold, zero otherwise. */
122 static int kbd_is_on_hold
;
124 /* Nonzero means don't run process sentinels. This is used
126 int inhibit_sentinels
;
130 static Lisp_Object Qprocessp
;
131 static Lisp_Object Qrun
, Qstop
, Qsignal
;
132 static Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
134 static Lisp_Object Qipv4
, Qdatagram
, Qseqpacket
;
135 static Lisp_Object Qreal
, Qnetwork
, Qserial
;
137 static Lisp_Object Qipv6
;
139 static Lisp_Object QCport
, QCprocess
;
141 Lisp_Object QCbytesize
, QCstopbits
, QCparity
, Qodd
, Qeven
;
142 Lisp_Object QCflowcontrol
, Qhw
, Qsw
, QCsummary
;
143 static Lisp_Object QCbuffer
, QChost
, QCservice
;
144 static Lisp_Object QClocal
, QCremote
, QCcoding
;
145 static Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
146 static Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
147 static Lisp_Object Qlast_nonmenu_event
;
148 /* QCfamily is declared and initialized in xfaces.c,
149 QCfilter in keyboard.c. */
150 extern Lisp_Object QCfamily
, QCfilter
;
152 /* Qexit is declared and initialized in eval.c. */
154 /* QCfamily is defined in xfaces.c. */
155 extern Lisp_Object QCfamily
;
156 /* QCfilter is defined in keyboard.c. */
157 extern Lisp_Object QCfilter
;
159 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
160 #define NETCONN1_P(p) (EQ ((p)->type, Qnetwork))
161 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
162 #define SERIALCONN1_P(p) (EQ ((p)->type, Qserial))
168 /* Number of events of change of status of a process. */
169 static int process_tick
;
170 /* Number of events for which the user or sentinel has been notified. */
171 static int update_tick
;
173 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
175 /* Only W32 has this, it really means that select can't take write mask. */
176 #ifdef BROKEN_NON_BLOCKING_CONNECT
177 #undef NON_BLOCKING_CONNECT
178 #define SELECT_CANT_DO_WRITE_MASK
180 #ifndef NON_BLOCKING_CONNECT
182 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
183 #if defined (O_NONBLOCK) || defined (O_NDELAY)
184 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
185 #define NON_BLOCKING_CONNECT
186 #endif /* EWOULDBLOCK || EINPROGRESS */
187 #endif /* O_NONBLOCK || O_NDELAY */
188 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
189 #endif /* HAVE_SELECT */
190 #endif /* NON_BLOCKING_CONNECT */
191 #endif /* BROKEN_NON_BLOCKING_CONNECT */
193 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
194 this system. We need to read full packets, so we need a
195 "non-destructive" select. So we require either native select,
196 or emulation of select using FIONREAD. */
198 #ifdef BROKEN_DATAGRAM_SOCKETS
199 #undef DATAGRAM_SOCKETS
201 #ifndef DATAGRAM_SOCKETS
202 #if defined (HAVE_SELECT) || defined (FIONREAD)
203 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
204 #define DATAGRAM_SOCKETS
205 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
206 #endif /* HAVE_SELECT || FIONREAD */
207 #endif /* DATAGRAM_SOCKETS */
208 #endif /* BROKEN_DATAGRAM_SOCKETS */
210 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
211 # define HAVE_SEQPACKET
214 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
215 #ifdef EMACS_HAS_USECS
216 #define ADAPTIVE_READ_BUFFERING
220 #ifdef ADAPTIVE_READ_BUFFERING
221 #define READ_OUTPUT_DELAY_INCREMENT 10000
222 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
223 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
225 /* Number of processes which have a non-zero read_output_delay,
226 and therefore might be delayed for adaptive read buffering. */
228 static int process_output_delay_count
;
230 /* Non-zero if any process has non-nil read_output_skip. */
232 static int process_output_skip
;
235 #define process_output_delay_count 0
238 INFUN (Fget_process
, 1);
239 static void create_process (Lisp_Object
, char **, Lisp_Object
);
240 static int keyboard_bit_set (SELECT_TYPE
*);
241 static void deactivate_process (Lisp_Object
);
242 static void status_notify (struct Lisp_Process
*);
243 static int read_process_output (Lisp_Object
, int);
244 static void create_pty (Lisp_Object
);
246 /* If we support a window system, turn on the code to poll periodically
247 to detect C-g. It isn't actually used when doing interrupt input. */
248 #ifdef HAVE_WINDOW_SYSTEM
249 #define POLL_FOR_INPUT
252 static Lisp_Object
get_process (register Lisp_Object name
);
253 static void exec_sentinel (Lisp_Object proc
, Lisp_Object reason
);
255 /* Mask of bits indicating the descriptors that we wait for input on. */
257 static SELECT_TYPE input_wait_mask
;
259 /* Mask that excludes keyboard input descriptor(s). */
261 static SELECT_TYPE non_keyboard_wait_mask
;
263 /* Mask that excludes process input descriptor(s). */
265 static SELECT_TYPE non_process_wait_mask
;
267 /* Mask for selecting for write. */
269 static SELECT_TYPE write_mask
;
271 #ifdef NON_BLOCKING_CONNECT
272 /* Mask of bits indicating the descriptors that we wait for connect to
273 complete on. Once they complete, they are removed from this mask
274 and added to the input_wait_mask and non_keyboard_wait_mask. */
276 static SELECT_TYPE connect_wait_mask
;
278 /* Number of bits set in connect_wait_mask. */
279 static int num_pending_connects
;
280 #endif /* NON_BLOCKING_CONNECT */
282 /* The largest descriptor currently in use for a process object. */
283 static int max_process_desc
;
285 /* The largest descriptor currently in use for input. */
286 static int max_input_desc
;
288 /* Indexed by descriptor, gives the process (if any) for that descriptor */
289 static Lisp_Object chan_process
[MAXDESC
];
291 /* Alist of elements (NAME . PROCESS) */
292 static Lisp_Object Vprocess_alist
;
294 /* Buffered-ahead input char from process, indexed by channel.
295 -1 means empty (no char is buffered).
296 Used on sys V where the only way to tell if there is any
297 output from the process is to read at least one char.
298 Always -1 on systems that support FIONREAD. */
300 static int proc_buffered_char
[MAXDESC
];
302 /* Table of `struct coding-system' for each process. */
303 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
304 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
306 #ifdef DATAGRAM_SOCKETS
307 /* Table of `partner address' for datagram sockets. */
308 static struct sockaddr_and_len
{
311 } datagram_address
[MAXDESC
];
312 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
313 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
315 #define DATAGRAM_CHAN_P(chan) (0)
316 #define DATAGRAM_CONN_P(proc) (0)
319 /* Maximum number of bytes to send to a pty without an eof. */
320 static int pty_max_bytes
;
324 static struct fd_callback_data
330 int condition
; /* mask of the defines above. */
331 } fd_callback_info
[MAXDESC
];
334 /* Add a file descriptor FD to be monitored for when read is possible.
335 When read is possible, call FUNC with argument DATA. */
338 add_read_fd (int fd
, fd_callback func
, void *data
)
340 xassert (fd
< MAXDESC
);
341 add_keyboard_wait_descriptor (fd
);
343 fd_callback_info
[fd
].func
= func
;
344 fd_callback_info
[fd
].data
= data
;
345 fd_callback_info
[fd
].condition
|= FOR_READ
;
348 /* Stop monitoring file descriptor FD for when read is possible. */
351 delete_read_fd (int fd
)
353 xassert (fd
< MAXDESC
);
354 delete_keyboard_wait_descriptor (fd
);
356 fd_callback_info
[fd
].condition
&= ~FOR_READ
;
357 if (fd_callback_info
[fd
].condition
== 0)
359 fd_callback_info
[fd
].func
= 0;
360 fd_callback_info
[fd
].data
= 0;
364 /* Add a file descriptor FD to be monitored for when write is possible.
365 When write is possible, call FUNC with argument DATA. */
368 add_write_fd (int fd
, fd_callback func
, void *data
)
370 xassert (fd
< MAXDESC
);
371 FD_SET (fd
, &write_mask
);
372 if (fd
> max_input_desc
)
375 fd_callback_info
[fd
].func
= func
;
376 fd_callback_info
[fd
].data
= data
;
377 fd_callback_info
[fd
].condition
|= FOR_WRITE
;
380 /* Stop monitoring file descriptor FD for when write is possible. */
383 delete_write_fd (int fd
)
385 int lim
= max_input_desc
;
387 xassert (fd
< MAXDESC
);
388 FD_CLR (fd
, &write_mask
);
389 fd_callback_info
[fd
].condition
&= ~FOR_WRITE
;
390 if (fd_callback_info
[fd
].condition
== 0)
392 fd_callback_info
[fd
].func
= 0;
393 fd_callback_info
[fd
].data
= 0;
395 if (fd
== max_input_desc
)
396 for (fd
= lim
; fd
>= 0; fd
--)
397 if (FD_ISSET (fd
, &input_wait_mask
) || FD_ISSET (fd
, &write_mask
))
407 /* Compute the Lisp form of the process status, p->status, from
408 the numeric status that was returned by `wait'. */
410 static Lisp_Object
status_convert (int);
413 update_status (struct Lisp_Process
*p
)
415 eassert (p
->raw_status_new
);
416 p
->status
= status_convert (p
->raw_status
);
417 p
->raw_status_new
= 0;
420 /* Convert a process status word in Unix format to
421 the list that we use internally. */
424 status_convert (int w
)
427 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
428 else if (WIFEXITED (w
))
429 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
430 WCOREDUMP (w
) ? Qt
: Qnil
));
431 else if (WIFSIGNALED (w
))
432 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
433 WCOREDUMP (w
) ? Qt
: Qnil
));
438 /* Given a status-list, extract the three pieces of information
439 and store them individually through the three pointers. */
442 decode_status (Lisp_Object l
, Lisp_Object
*symbol
, int *code
, int *coredump
)
456 *code
= XFASTINT (XCAR (tem
));
458 *coredump
= !NILP (tem
);
462 /* Return a string describing a process status list. */
465 status_message (struct Lisp_Process
*p
)
467 Lisp_Object status
= p
->status
;
470 Lisp_Object string
, string2
;
472 decode_status (status
, &symbol
, &code
, &coredump
);
474 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
477 synchronize_system_messages_locale ();
478 signame
= strsignal (code
);
480 string
= build_string ("unknown");
485 string
= make_unibyte_string (signame
, strlen (signame
));
486 if (! NILP (Vlocale_coding_system
))
487 string
= (code_convert_string_norecord
488 (string
, Vlocale_coding_system
, 0));
489 c1
= STRING_CHAR (SDATA (string
));
492 Faset (string
, make_number (0), make_number (c2
));
494 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
495 return concat2 (string
, string2
);
497 else if (EQ (symbol
, Qexit
))
500 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
502 return build_string ("finished\n");
503 string
= Fnumber_to_string (make_number (code
));
504 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
505 return concat3 (build_string ("exited abnormally with code "),
508 else if (EQ (symbol
, Qfailed
))
510 string
= Fnumber_to_string (make_number (code
));
511 string2
= build_string ("\n");
512 return concat3 (build_string ("failed with code "),
516 return Fcopy_sequence (Fsymbol_name (symbol
));
521 /* The file name of the pty opened by allocate_pty. */
522 static char pty_name
[24];
524 /* Open an available pty, returning a file descriptor.
525 Return -1 on failure.
526 The file name of the terminal corresponding to the pty
527 is left in the variable pty_name. */
538 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
539 for (i
= 0; i
< 16; i
++)
542 #ifdef PTY_NAME_SPRINTF
545 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
546 #endif /* no PTY_NAME_SPRINTF */
550 #else /* no PTY_OPEN */
552 { /* Some systems name their pseudoterminals so that there are gaps in
553 the usual sequence - for example, on HP9000/S700 systems, there
554 are no pseudoterminals with names ending in 'f'. So we wait for
555 three failures in a row before deciding that we've reached the
557 int failed_count
= 0;
560 if (stat (pty_name
, &stb
) < 0)
563 if (failed_count
>= 3)
570 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
572 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
575 #endif /* no PTY_OPEN */
579 /* check to make certain that both sides are available
580 this avoids a nasty yet stupid bug in rlogins */
581 #ifdef PTY_TTY_NAME_SPRINTF
584 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
585 #endif /* no PTY_TTY_NAME_SPRINTF */
586 if (access (pty_name
, 6) != 0)
601 #endif /* HAVE_PTYS */
604 make_process (Lisp_Object name
)
606 register Lisp_Object val
, tem
, name1
;
607 register struct Lisp_Process
*p
;
611 p
= allocate_process ();
619 p
->raw_status_new
= 0;
621 p
->mark
= Fmake_marker ();
622 p
->kill_without_query
= 0;
624 #ifdef ADAPTIVE_READ_BUFFERING
625 p
->adaptive_read_buffering
= 0;
626 p
->read_output_delay
= 0;
627 p
->read_output_skip
= 0;
631 p
->gnutls_initstage
= GNUTLS_STAGE_EMPTY
;
632 p
->gnutls_log_level
= 0;
636 /* If name is already in use, modify it until it is unused. */
641 tem
= Fget_process (name1
);
642 if (NILP (tem
)) break;
643 sprintf (suffix
, "<%d>", i
);
644 name1
= concat2 (name
, build_string (suffix
));
648 XSETPROCESS (val
, p
);
649 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
654 remove_process (register Lisp_Object proc
)
656 register Lisp_Object pair
;
658 pair
= Frassq (proc
, Vprocess_alist
);
659 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
661 deactivate_process (proc
);
665 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
666 doc
: /* Return t if OBJECT is a process. */)
669 return PROCESSP (object
) ? Qt
: Qnil
;
672 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
673 doc
: /* Return the process named NAME, or nil if there is none. */)
674 (register Lisp_Object name
)
679 return Fcdr (Fassoc (name
, Vprocess_alist
));
682 /* This is how commands for the user decode process arguments. It
683 accepts a process, a process name, a buffer, a buffer name, or nil.
684 Buffers denote the first process in the buffer, and nil denotes the
688 get_process (register Lisp_Object name
)
690 register Lisp_Object proc
, obj
;
693 obj
= Fget_process (name
);
695 obj
= Fget_buffer (name
);
697 error ("Process %s does not exist", SDATA (name
));
699 else if (NILP (name
))
700 obj
= Fcurrent_buffer ();
704 /* Now obj should be either a buffer object or a process object.
708 proc
= Fget_buffer_process (obj
);
710 error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj
), name
)));
722 /* Fdelete_process promises to immediately forget about the process, but in
723 reality, Emacs needs to remember those processes until they have been
724 treated by sigchld_handler; otherwise this handler would consider the
725 process as being synchronous and say that the synchronous process is
727 static Lisp_Object deleted_pid_list
;
730 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
731 doc
: /* Delete PROCESS: kill it and forget about it immediately.
732 PROCESS may be a process, a buffer, the name of a process or buffer, or
733 nil, indicating the current buffer's process. */)
734 (register Lisp_Object process
)
736 register struct Lisp_Process
*p
;
738 process
= get_process (process
);
739 p
= XPROCESS (process
);
741 p
->raw_status_new
= 0;
742 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
744 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
745 p
->tick
= ++process_tick
;
747 redisplay_preserve_echo_area (13);
749 else if (p
->infd
>= 0)
753 /* Assignment to EMACS_INT stops GCC whining about limited range
755 EMACS_INT pid
= p
->pid
;
757 /* No problem storing the pid here, as it is still in Vprocess_alist. */
758 deleted_pid_list
= Fcons (make_fixnum_or_float (pid
),
759 /* GC treated elements set to nil. */
760 Fdelq (Qnil
, deleted_pid_list
));
761 /* If the process has already signaled, remove it from the list. */
762 if (p
->raw_status_new
)
765 if (CONSP (p
->status
))
766 symbol
= XCAR (p
->status
);
767 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
769 = Fdelete (make_fixnum_or_float (pid
), deleted_pid_list
);
773 Fkill_process (process
, Qnil
);
774 /* Do this now, since remove_process will make sigchld_handler do nothing. */
776 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
777 p
->tick
= ++process_tick
;
779 redisplay_preserve_echo_area (13);
782 remove_process (process
);
786 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
787 doc
: /* Return the status of PROCESS.
788 The returned value is one of the following symbols:
789 run -- for a process that is running.
790 stop -- for a process stopped but continuable.
791 exit -- for a process that has exited.
792 signal -- for a process that has got a fatal signal.
793 open -- for a network stream connection that is open.
794 listen -- for a network stream server that is listening.
795 closed -- for a network stream connection that is closed.
796 connect -- when waiting for a non-blocking connection to complete.
797 failed -- when a non-blocking connection has failed.
798 nil -- if arg is a process name and no such process exists.
799 PROCESS may be a process, a buffer, the name of a process, or
800 nil, indicating the current buffer's process. */)
801 (register Lisp_Object process
)
803 register struct Lisp_Process
*p
;
804 register Lisp_Object status
;
806 if (STRINGP (process
))
807 process
= Fget_process (process
);
809 process
= get_process (process
);
814 p
= XPROCESS (process
);
815 if (p
->raw_status_new
)
819 status
= XCAR (status
);
820 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
822 if (EQ (status
, Qexit
))
824 else if (EQ (p
->command
, Qt
))
826 else if (EQ (status
, Qrun
))
832 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
834 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
835 If PROCESS has not yet exited or died, return 0. */)
836 (register Lisp_Object process
)
838 CHECK_PROCESS (process
);
839 if (XPROCESS (process
)->raw_status_new
)
840 update_status (XPROCESS (process
));
841 if (CONSP (XPROCESS (process
)->status
))
842 return XCAR (XCDR (XPROCESS (process
)->status
));
843 return make_number (0);
846 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
847 doc
: /* Return the process id of PROCESS.
848 This is the pid of the external process which PROCESS uses or talks to.
849 For a network connection, this value is nil. */)
850 (register Lisp_Object process
)
852 /* Assignment to EMACS_INT stops GCC whining about limited range of
856 CHECK_PROCESS (process
);
857 pid
= XPROCESS (process
)->pid
;
858 return (pid
? make_fixnum_or_float (pid
) : Qnil
);
861 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
862 doc
: /* Return the name of PROCESS, as a string.
863 This is the name of the program invoked in PROCESS,
864 possibly modified to make it unique among process names. */)
865 (register Lisp_Object process
)
867 CHECK_PROCESS (process
);
868 return XPROCESS (process
)->name
;
871 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
872 doc
: /* Return the command that was executed to start PROCESS.
873 This is a list of strings, the first string being the program executed
874 and the rest of the strings being the arguments given to it.
875 For a network or serial process, this is nil (process is running) or t
876 \(process is stopped). */)
877 (register Lisp_Object process
)
879 CHECK_PROCESS (process
);
880 return XPROCESS (process
)->command
;
883 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
884 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
885 This is the terminal that the process itself reads and writes on,
886 not the name of the pty that Emacs uses to talk with that terminal. */)
887 (register Lisp_Object process
)
889 CHECK_PROCESS (process
);
890 return XPROCESS (process
)->tty_name
;
893 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
895 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
896 (register Lisp_Object process
, Lisp_Object buffer
)
898 struct Lisp_Process
*p
;
900 CHECK_PROCESS (process
);
902 CHECK_BUFFER (buffer
);
903 p
= XPROCESS (process
);
905 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
906 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
907 setup_process_coding_systems (process
);
911 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
913 doc
: /* Return the buffer PROCESS is associated with.
914 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
915 (register Lisp_Object process
)
917 CHECK_PROCESS (process
);
918 return XPROCESS (process
)->buffer
;
921 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
923 doc
: /* Return the marker for the end of the last output from PROCESS. */)
924 (register Lisp_Object process
)
926 CHECK_PROCESS (process
);
927 return XPROCESS (process
)->mark
;
930 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
932 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
933 A value of t means stop accepting output from the process.
935 When a process has a filter, its buffer is not used for output.
936 Instead, each time it does output, the entire string of output is
937 passed to the filter.
939 The filter gets two arguments: the process and the string of output.
940 The string argument is normally a multibyte string, except:
941 - if the process' input coding system is no-conversion or raw-text,
942 it is a unibyte string (the non-converted input), or else
943 - if `default-enable-multibyte-characters' is nil, it is a unibyte
944 string (the result of converting the decoded input multibyte
945 string to unibyte with `string-make-unibyte'). */)
946 (register Lisp_Object process
, Lisp_Object filter
)
948 struct Lisp_Process
*p
;
950 CHECK_PROCESS (process
);
951 p
= XPROCESS (process
);
953 /* Don't signal an error if the process' input file descriptor
954 is closed. This could make debugging Lisp more difficult,
955 for example when doing something like
957 (setq process (start-process ...))
959 (set-process-filter process ...) */
963 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
965 FD_CLR (p
->infd
, &input_wait_mask
);
966 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
968 else if (EQ (p
->filter
, Qt
)
969 /* Network or serial process not stopped: */
970 && !EQ (p
->command
, Qt
))
972 FD_SET (p
->infd
, &input_wait_mask
);
973 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
978 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
979 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
980 setup_process_coding_systems (process
);
984 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
986 doc
: /* Returns the filter function of PROCESS; nil if none.
987 See `set-process-filter' for more info on filter functions. */)
988 (register Lisp_Object process
)
990 CHECK_PROCESS (process
);
991 return XPROCESS (process
)->filter
;
994 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
996 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
997 The sentinel is called as a function when the process changes state.
998 It gets two arguments: the process, and a string describing the change. */)
999 (register Lisp_Object process
, Lisp_Object sentinel
)
1001 struct Lisp_Process
*p
;
1003 CHECK_PROCESS (process
);
1004 p
= XPROCESS (process
);
1006 p
->sentinel
= sentinel
;
1007 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1008 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1012 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1014 doc
: /* Return the sentinel of PROCESS; nil if none.
1015 See `set-process-sentinel' for more info on sentinels. */)
1016 (register Lisp_Object process
)
1018 CHECK_PROCESS (process
);
1019 return XPROCESS (process
)->sentinel
;
1022 DEFUN ("set-process-window-size", Fset_process_window_size
,
1023 Sset_process_window_size
, 3, 3, 0,
1024 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1025 (register Lisp_Object process
, Lisp_Object height
, Lisp_Object width
)
1027 CHECK_PROCESS (process
);
1028 CHECK_NATNUM (height
);
1029 CHECK_NATNUM (width
);
1031 if (XPROCESS (process
)->infd
< 0
1032 || set_window_size (XPROCESS (process
)->infd
,
1033 XINT (height
), XINT (width
)) <= 0)
1039 DEFUN ("set-process-inherit-coding-system-flag",
1040 Fset_process_inherit_coding_system_flag
,
1041 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1042 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1043 If the second argument FLAG is non-nil, then the variable
1044 `buffer-file-coding-system' of the buffer associated with PROCESS
1045 will be bound to the value of the coding system used to decode
1048 This is useful when the coding system specified for the process buffer
1049 leaves either the character code conversion or the end-of-line conversion
1050 unspecified, or if the coding system used to decode the process output
1051 is more appropriate for saving the process buffer.
1053 Binding the variable `inherit-process-coding-system' to non-nil before
1054 starting the process is an alternative way of setting the inherit flag
1055 for the process which will run. */)
1056 (register Lisp_Object process
, Lisp_Object flag
)
1058 CHECK_PROCESS (process
);
1059 XPROCESS (process
)->inherit_coding_system_flag
= !NILP (flag
);
1063 DEFUN ("set-process-query-on-exit-flag",
1064 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1066 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1067 If the second argument FLAG is non-nil, Emacs will query the user before
1068 exiting or killing a buffer if PROCESS is running. */)
1069 (register Lisp_Object process
, Lisp_Object flag
)
1071 CHECK_PROCESS (process
);
1072 XPROCESS (process
)->kill_without_query
= NILP (flag
);
1076 DEFUN ("process-query-on-exit-flag",
1077 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1079 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1080 (register Lisp_Object process
)
1082 CHECK_PROCESS (process
);
1083 return (XPROCESS (process
)->kill_without_query
? Qnil
: Qt
);
1086 #ifdef DATAGRAM_SOCKETS
1087 INFUN (Fprocess_datagram_address
, 1);
1090 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1092 doc
: /* Return the contact info of PROCESS; t for a real child.
1093 For a network or serial connection, the value depends on the optional
1094 KEY arg. If KEY is nil, value is a cons cell of the form (HOST
1095 SERVICE) for a network connection or (PORT SPEED) for a serial
1096 connection. If KEY is t, the complete contact information for the
1097 connection is returned, else the specific value for the keyword KEY is
1098 returned. See `make-network-process' or `make-serial-process' for a
1099 list of keywords. */)
1100 (register Lisp_Object process
, Lisp_Object key
)
1102 Lisp_Object contact
;
1104 CHECK_PROCESS (process
);
1105 contact
= XPROCESS (process
)->childp
;
1107 #ifdef DATAGRAM_SOCKETS
1108 if (DATAGRAM_CONN_P (process
)
1109 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1110 contact
= Fplist_put (contact
, QCremote
,
1111 Fprocess_datagram_address (process
));
1114 if ((!NETCONN_P (process
) && !SERIALCONN_P (process
)) || EQ (key
, Qt
))
1116 if (NILP (key
) && NETCONN_P (process
))
1117 return Fcons (Fplist_get (contact
, QChost
),
1118 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1119 if (NILP (key
) && SERIALCONN_P (process
))
1120 return Fcons (Fplist_get (contact
, QCport
),
1121 Fcons (Fplist_get (contact
, QCspeed
), Qnil
));
1122 return Fplist_get (contact
, key
);
1125 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1127 doc
: /* Return the plist of PROCESS. */)
1128 (register Lisp_Object process
)
1130 CHECK_PROCESS (process
);
1131 return XPROCESS (process
)->plist
;
1134 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1136 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1137 (register Lisp_Object process
, Lisp_Object plist
)
1139 CHECK_PROCESS (process
);
1142 XPROCESS (process
)->plist
= plist
;
1146 #if 0 /* Turned off because we don't currently record this info
1147 in the process. Perhaps add it. */
1148 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1149 doc
: /* Return the connection type of PROCESS.
1150 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1151 a socket connection. */)
1152 (Lisp_Object process
)
1154 return XPROCESS (process
)->type
;
1158 DEFUN ("process-type", Fprocess_type
, Sprocess_type
, 1, 1, 0,
1159 doc
: /* Return the connection type of PROCESS.
1160 The value is either the symbol `real', `network', or `serial'.
1161 PROCESS may be a process, a buffer, the name of a process or buffer, or
1162 nil, indicating the current buffer's process. */)
1163 (Lisp_Object process
)
1166 proc
= get_process (process
);
1167 return XPROCESS (proc
)->type
;
1170 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1172 doc
: /* Convert network ADDRESS from internal format to a string.
1173 A 4 or 5 element vector represents an IPv4 address (with port number).
1174 An 8 or 9 element vector represents an IPv6 address (with port number).
1175 If optional second argument OMIT-PORT is non-nil, don't include a port
1176 number in the string, even when present in ADDRESS.
1177 Returns nil if format of ADDRESS is invalid. */)
1178 (Lisp_Object address
, Lisp_Object omit_port
)
1183 if (STRINGP (address
)) /* AF_LOCAL */
1186 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1188 register struct Lisp_Vector
*p
= XVECTOR (address
);
1189 Lisp_Object args
[10];
1192 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1194 args
[0] = build_string ("%d.%d.%d.%d");
1197 else if (p
->size
== 5)
1199 args
[0] = build_string ("%d.%d.%d.%d:%d");
1202 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1204 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1207 else if (p
->size
== 9)
1209 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1215 for (i
= 0; i
< nargs
; i
++)
1217 EMACS_INT element
= XINT (p
->contents
[i
]);
1219 if (element
< 0 || element
> 65535)
1222 if (nargs
<= 5 /* IPv4 */
1223 && i
< 4 /* host, not port */
1227 args
[i
+1] = p
->contents
[i
];
1230 return Fformat (nargs
+1, args
);
1233 if (CONSP (address
))
1235 Lisp_Object args
[2];
1236 args
[0] = build_string ("<Family %d>");
1237 args
[1] = Fcar (address
);
1238 return Fformat (2, args
);
1244 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1245 doc
: /* Return a list of all processes. */)
1248 return Fmapcar (Qcdr
, Vprocess_alist
);
1251 /* Starting asynchronous inferior processes. */
1253 static Lisp_Object
start_process_unwind (Lisp_Object proc
);
1255 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1256 doc
: /* Start a program in a subprocess. Return the process object for it.
1257 NAME is name for process. It is modified if necessary to make it unique.
1258 BUFFER is the buffer (or buffer name) to associate with the process.
1260 Process output (both standard output and standard error streams) goes
1261 at end of BUFFER, unless you specify an output stream or filter
1262 function to handle the output. BUFFER may also be nil, meaning that
1263 this process is not associated with any buffer.
1265 PROGRAM is the program file name. It is searched for in `exec-path'
1266 (which see). If nil, just associate a pty with the buffer. Remaining
1267 arguments are strings to give program as arguments.
1269 If you want to separate standard output from standard error, invoke
1270 the command through a shell and redirect one of them using the shell
1273 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1274 (size_t nargs
, register Lisp_Object
*args
)
1276 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1277 register unsigned char **new_argv
;
1279 int count
= SPECPDL_INDEX ();
1283 buffer
= Fget_buffer_create (buffer
);
1285 /* Make sure that the child will be able to chdir to the current
1286 buffer's current directory, or its unhandled equivalent. We
1287 can't just have the child check for an error when it does the
1288 chdir, since it's in a vfork.
1290 We have to GCPRO around this because Fexpand_file_name and
1291 Funhandled_file_name_directory might call a file name handling
1292 function. The argument list is protected by the caller, so all
1293 we really have to worry about is buffer. */
1295 struct gcpro gcpro1
, gcpro2
;
1297 current_dir
= BVAR (current_buffer
, directory
);
1299 GCPRO2 (buffer
, current_dir
);
1301 current_dir
= Funhandled_file_name_directory (current_dir
);
1302 if (NILP (current_dir
))
1303 /* If the file name handler says that current_dir is unreachable, use
1304 a sensible default. */
1305 current_dir
= build_string ("~/");
1306 current_dir
= expand_and_dir_to_file (current_dir
, Qnil
);
1307 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1308 report_file_error ("Setting current directory",
1309 Fcons (BVAR (current_buffer
, directory
), Qnil
));
1315 CHECK_STRING (name
);
1319 if (!NILP (program
))
1320 CHECK_STRING (program
);
1322 proc
= make_process (name
);
1323 /* If an error occurs and we can't start the process, we want to
1324 remove it from the process list. This means that each error
1325 check in create_process doesn't need to call remove_process
1326 itself; it's all taken care of here. */
1327 record_unwind_protect (start_process_unwind
, proc
);
1329 XPROCESS (proc
)->childp
= Qt
;
1330 XPROCESS (proc
)->plist
= Qnil
;
1331 XPROCESS (proc
)->type
= Qreal
;
1332 XPROCESS (proc
)->buffer
= buffer
;
1333 XPROCESS (proc
)->sentinel
= Qnil
;
1334 XPROCESS (proc
)->filter
= Qnil
;
1335 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1338 /* AKA GNUTLS_INITSTAGE(proc). */
1339 XPROCESS (proc
)->gnutls_initstage
= GNUTLS_STAGE_EMPTY
;
1340 XPROCESS (proc
)->gnutls_cred_type
= Qnil
;
1343 #ifdef ADAPTIVE_READ_BUFFERING
1344 XPROCESS (proc
)->adaptive_read_buffering
1345 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
1346 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
1349 /* Make the process marker point into the process buffer (if any). */
1350 if (BUFFERP (buffer
))
1351 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1352 BUF_ZV (XBUFFER (buffer
)),
1353 BUF_ZV_BYTE (XBUFFER (buffer
)));
1356 /* Decide coding systems for communicating with the process. Here
1357 we don't setup the structure coding_system nor pay attention to
1358 unibyte mode. They are done in create_process. */
1360 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1361 Lisp_Object coding_systems
= Qt
;
1362 Lisp_Object val
, *args2
;
1363 struct gcpro gcpro1
, gcpro2
;
1365 val
= Vcoding_system_for_read
;
1368 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1369 args2
[0] = Qstart_process
;
1370 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1371 GCPRO2 (proc
, current_dir
);
1372 if (!NILP (program
))
1373 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1375 if (CONSP (coding_systems
))
1376 val
= XCAR (coding_systems
);
1377 else if (CONSP (Vdefault_process_coding_system
))
1378 val
= XCAR (Vdefault_process_coding_system
);
1380 XPROCESS (proc
)->decode_coding_system
= val
;
1382 val
= Vcoding_system_for_write
;
1385 if (EQ (coding_systems
, Qt
))
1387 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1388 args2
[0] = Qstart_process
;
1389 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1390 GCPRO2 (proc
, current_dir
);
1391 if (!NILP (program
))
1392 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1395 if (CONSP (coding_systems
))
1396 val
= XCDR (coding_systems
);
1397 else if (CONSP (Vdefault_process_coding_system
))
1398 val
= XCDR (Vdefault_process_coding_system
);
1400 XPROCESS (proc
)->encode_coding_system
= val
;
1401 /* Note: At this momemnt, the above coding system may leave
1402 text-conversion or eol-conversion unspecified. They will be
1403 decided after we read output from the process and decode it by
1404 some coding system, or just before we actually send a text to
1409 XPROCESS (proc
)->decoding_buf
= empty_unibyte_string
;
1410 XPROCESS (proc
)->decoding_carryover
= 0;
1411 XPROCESS (proc
)->encoding_buf
= empty_unibyte_string
;
1413 XPROCESS (proc
)->inherit_coding_system_flag
1414 = !(NILP (buffer
) || !inherit_process_coding_system
);
1416 if (!NILP (program
))
1418 /* If program file name is not absolute, search our path for it.
1419 Put the name we will really use in TEM. */
1420 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1421 && !(SCHARS (program
) > 1
1422 && IS_DEVICE_SEP (SREF (program
, 1))))
1424 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1427 GCPRO4 (name
, program
, buffer
, current_dir
);
1428 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1431 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1432 tem
= Fexpand_file_name (tem
, Qnil
);
1436 if (!NILP (Ffile_directory_p (program
)))
1437 error ("Specified program for new process is a directory");
1441 /* If program file name starts with /: for quoting a magic name,
1443 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1444 && SREF (tem
, 1) == ':')
1445 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1448 Lisp_Object arg_encoding
= Qnil
;
1449 struct gcpro gcpro1
;
1452 /* Encode the file name and put it in NEW_ARGV.
1453 That's where the child will use it to execute the program. */
1454 tem
= Fcons (ENCODE_FILE (tem
), Qnil
);
1456 /* Here we encode arguments by the coding system used for sending
1457 data to the process. We don't support using different coding
1458 systems for encoding arguments and for encoding data sent to the
1461 for (i
= 3; i
< nargs
; i
++)
1463 tem
= Fcons (args
[i
], tem
);
1464 CHECK_STRING (XCAR (tem
));
1465 if (STRING_MULTIBYTE (XCAR (tem
)))
1467 if (NILP (arg_encoding
))
1468 arg_encoding
= (complement_process_encoding_system
1469 (XPROCESS (proc
)->encode_coding_system
));
1471 code_convert_string_norecord
1472 (XCAR (tem
), arg_encoding
, 1));
1479 /* Now that everything is encoded we can collect the strings into
1481 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1482 new_argv
[nargs
- 2] = 0;
1484 for (i
= nargs
- 2; i
-- != 0; )
1486 new_argv
[i
] = SDATA (XCAR (tem
));
1490 create_process (proc
, (char **) new_argv
, current_dir
);
1495 return unbind_to (count
, proc
);
1498 /* This function is the unwind_protect form for Fstart_process. If
1499 PROC doesn't have its pid set, then we know someone has signaled
1500 an error and the process wasn't started successfully, so we should
1501 remove it from the process list. */
1503 start_process_unwind (Lisp_Object proc
)
1505 if (!PROCESSP (proc
))
1508 /* Was PROC started successfully? */
1509 if (XPROCESS (proc
)->pid
== -1)
1510 remove_process (proc
);
1516 create_process_1 (struct atimer
*timer
)
1518 /* Nothing to do. */
1523 create_process (Lisp_Object process
, char **new_argv
, Lisp_Object current_dir
)
1525 int inchannel
, outchannel
;
1528 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1529 int wait_child_setup
[2];
1533 struct sigaction sigint_action
;
1534 struct sigaction sigquit_action
;
1535 struct sigaction sigpipe_action
;
1537 struct sigaction sighup_action
;
1539 /* Use volatile to protect variables from being clobbered by longjmp. */
1540 volatile int forkin
, forkout
;
1541 volatile int pty_flag
= 0;
1543 extern char **environ
;
1546 inchannel
= outchannel
= -1;
1549 if (!NILP (Vprocess_connection_type
))
1550 outchannel
= inchannel
= allocate_pty ();
1554 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1555 /* On most USG systems it does not work to open the pty's tty here,
1556 then close it and reopen it in the child. */
1558 /* Don't let this terminal become our controlling terminal
1559 (in case we don't have one). */
1560 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1562 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1565 report_file_error ("Opening pty", Qnil
);
1567 forkin
= forkout
= -1;
1568 #endif /* not USG, or USG_SUBTTY_WORKS */
1572 #endif /* HAVE_PTYS */
1577 report_file_error ("Creating pipe", Qnil
);
1583 emacs_close (inchannel
);
1584 emacs_close (forkout
);
1585 report_file_error ("Creating pipe", Qnil
);
1591 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1595 tem
= pipe (wait_child_setup
);
1597 report_file_error ("Creating pipe", Qnil
);
1598 tem
= fcntl (wait_child_setup
[1], F_GETFD
, 0);
1600 tem
= fcntl (wait_child_setup
[1], F_SETFD
, tem
| FD_CLOEXEC
);
1603 emacs_close (wait_child_setup
[0]);
1604 emacs_close (wait_child_setup
[1]);
1605 report_file_error ("Setting file descriptor flags", Qnil
);
1611 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1612 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1615 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1616 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1620 /* Record this as an active process, with its channels.
1621 As a result, child_setup will close Emacs's side of the pipes. */
1622 chan_process
[inchannel
] = process
;
1623 XPROCESS (process
)->infd
= inchannel
;
1624 XPROCESS (process
)->outfd
= outchannel
;
1626 /* Previously we recorded the tty descriptor used in the subprocess.
1627 It was only used for getting the foreground tty process, so now
1628 we just reopen the device (see emacs_get_tty_pgrp) as this is
1629 more portable (see USG_SUBTTY_WORKS above). */
1631 XPROCESS (process
)->pty_flag
= pty_flag
;
1632 XPROCESS (process
)->status
= Qrun
;
1633 setup_process_coding_systems (process
);
1635 /* Delay interrupts until we have a chance to store
1636 the new fork's pid in its process structure */
1637 sigemptyset (&blocked
);
1639 sigaddset (&blocked
, SIGCHLD
);
1641 #ifdef HAVE_WORKING_VFORK
1642 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1643 this sets the parent's signal handlers as well as the child's.
1644 So delay all interrupts whose handlers the child might munge,
1645 and record the current handlers so they can be restored later. */
1646 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1647 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1648 sigaddset (&blocked
, SIGPIPE
); sigaction (SIGPIPE
, 0, &sigpipe_action
);
1650 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1652 #endif /* HAVE_WORKING_VFORK */
1653 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1655 FD_SET (inchannel
, &input_wait_mask
);
1656 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1657 if (inchannel
> max_process_desc
)
1658 max_process_desc
= inchannel
;
1660 /* Until we store the proper pid, enable sigchld_handler
1661 to recognize an unknown pid as standing for this process.
1662 It is very important not to let this `marker' value stay
1663 in the table after this function has returned; if it does
1664 it might cause call-process to hang and subsequent asynchronous
1665 processes to get their return values scrambled. */
1666 XPROCESS (process
)->pid
= -1;
1671 /* child_setup must clobber environ on systems with true vfork.
1672 Protect it from permanent change. */
1673 char **save_environ
= environ
;
1674 volatile Lisp_Object encoded_current_dir
= ENCODE_FILE (current_dir
);
1679 #endif /* not WINDOWSNT */
1681 int xforkin
= forkin
;
1682 int xforkout
= forkout
;
1684 #if 0 /* This was probably a mistake--it duplicates code later on,
1685 but fails to handle all the cases. */
1686 /* Make sure SIGCHLD is not blocked in the child. */
1687 sigsetmask (SIGEMPTYMASK
);
1690 /* Make the pty be the controlling terminal of the process. */
1692 /* First, disconnect its current controlling terminal. */
1694 /* We tried doing setsid only if pty_flag, but it caused
1695 process_set_signal to fail on SGI when using a pipe. */
1697 /* Make the pty's terminal the controlling terminal. */
1698 if (pty_flag
&& xforkin
>= 0)
1701 /* We ignore the return value
1702 because faith@cs.unc.edu says that is necessary on Linux. */
1703 ioctl (xforkin
, TIOCSCTTY
, 0);
1706 #else /* not HAVE_SETSID */
1708 /* It's very important to call setpgrp here and no time
1709 afterwards. Otherwise, we lose our controlling tty which
1710 is set when we open the pty. */
1713 #endif /* not HAVE_SETSID */
1714 #if defined (LDISC1)
1715 if (pty_flag
&& xforkin
>= 0)
1718 tcgetattr (xforkin
, &t
);
1720 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1721 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1724 #if defined (NTTYDISC) && defined (TIOCSETD)
1725 if (pty_flag
&& xforkin
>= 0)
1727 /* Use new line discipline. */
1728 int ldisc
= NTTYDISC
;
1729 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1734 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1735 can do TIOCSPGRP only to the process's controlling tty. */
1738 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1739 I can't test it since I don't have 4.3. */
1740 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1743 ioctl (j
, TIOCNOTTY
, 0);
1747 /* In order to get a controlling terminal on some versions
1748 of BSD, it is necessary to put the process in pgrp 0
1749 before it opens the terminal. */
1757 #endif /* TIOCNOTTY */
1759 #if !defined (DONT_REOPEN_PTY)
1760 /*** There is a suggestion that this ought to be a
1761 conditional on TIOCSPGRP,
1762 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1763 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1764 that system does seem to need this code, even though
1765 both HAVE_SETSID and TIOCSCTTY are defined. */
1766 /* Now close the pty (if we had it open) and reopen it.
1767 This makes the pty the controlling terminal of the subprocess. */
1771 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1774 emacs_close (xforkin
);
1775 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
1779 emacs_write (1, "Couldn't open the pty terminal ", 31);
1780 emacs_write (1, pty_name
, strlen (pty_name
));
1781 emacs_write (1, "\n", 1);
1786 #endif /* not DONT_REOPEN_PTY */
1788 #ifdef SETUP_SLAVE_PTY
1793 #endif /* SETUP_SLAVE_PTY */
1795 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1796 Now reenable it in the child, so it will die when we want it to. */
1798 signal (SIGHUP
, SIG_DFL
);
1800 #endif /* HAVE_PTYS */
1802 signal (SIGINT
, SIG_DFL
);
1803 signal (SIGQUIT
, SIG_DFL
);
1804 /* GConf causes us to ignore SIGPIPE, make sure it is restored
1806 signal (SIGPIPE
, SIG_DFL
);
1808 /* Stop blocking signals in the child. */
1809 sigprocmask (SIG_SETMASK
, &procmask
, 0);
1812 child_setup_tty (xforkout
);
1814 pid
= child_setup (xforkin
, xforkout
, xforkout
,
1815 new_argv
, 1, encoded_current_dir
);
1816 #else /* not WINDOWSNT */
1818 emacs_close (wait_child_setup
[0]);
1820 child_setup (xforkin
, xforkout
, xforkout
,
1821 new_argv
, 1, encoded_current_dir
);
1822 #endif /* not WINDOWSNT */
1824 environ
= save_environ
;
1829 /* This runs in the Emacs process. */
1833 emacs_close (forkin
);
1834 if (forkin
!= forkout
&& forkout
>= 0)
1835 emacs_close (forkout
);
1839 /* vfork succeeded. */
1840 XPROCESS (process
)->pid
= pid
;
1843 register_child (pid
, inchannel
);
1844 #endif /* WINDOWSNT */
1846 /* If the subfork execv fails, and it exits,
1847 this close hangs. I don't know why.
1848 So have an interrupt jar it loose. */
1850 struct atimer
*timer
;
1854 EMACS_SET_SECS_USECS (offset
, 1, 0);
1855 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
1858 emacs_close (forkin
);
1860 cancel_atimer (timer
);
1864 if (forkin
!= forkout
&& forkout
>= 0)
1865 emacs_close (forkout
);
1869 XPROCESS (process
)->tty_name
= build_string (pty_name
);
1872 XPROCESS (process
)->tty_name
= Qnil
;
1874 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1875 /* Wait for child_setup to complete in case that vfork is
1876 actually defined as fork. The descriptor wait_child_setup[1]
1877 of a pipe is closed at the child side either by close-on-exec
1878 on successful execvp or the _exit call in child_setup. */
1882 emacs_close (wait_child_setup
[1]);
1883 emacs_read (wait_child_setup
[0], &dummy
, 1);
1884 emacs_close (wait_child_setup
[0]);
1889 /* Restore the signal state whether vfork succeeded or not.
1890 (We will signal an error, below, if it failed.) */
1891 #ifdef HAVE_WORKING_VFORK
1892 /* Restore the parent's signal handlers. */
1893 sigaction (SIGINT
, &sigint_action
, 0);
1894 sigaction (SIGQUIT
, &sigquit_action
, 0);
1895 sigaction (SIGPIPE
, &sigpipe_action
, 0);
1897 sigaction (SIGHUP
, &sighup_action
, 0);
1899 #endif /* HAVE_WORKING_VFORK */
1900 /* Stop blocking signals in the parent. */
1901 sigprocmask (SIG_SETMASK
, &procmask
, 0);
1903 /* Now generate the error if vfork failed. */
1905 report_file_error ("Doing vfork", Qnil
);
1909 create_pty (Lisp_Object process
)
1911 int inchannel
, outchannel
;
1914 inchannel
= outchannel
= -1;
1917 if (!NILP (Vprocess_connection_type
))
1918 outchannel
= inchannel
= allocate_pty ();
1922 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1923 /* On most USG systems it does not work to open the pty's tty here,
1924 then close it and reopen it in the child. */
1926 /* Don't let this terminal become our controlling terminal
1927 (in case we don't have one). */
1928 int forkout
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1930 int forkout
= emacs_open (pty_name
, O_RDWR
, 0);
1933 report_file_error ("Opening pty", Qnil
);
1934 #if defined (DONT_REOPEN_PTY)
1935 /* In the case that vfork is defined as fork, the parent process
1936 (Emacs) may send some data before the child process completes
1937 tty options setup. So we setup tty before forking. */
1938 child_setup_tty (forkout
);
1939 #endif /* DONT_REOPEN_PTY */
1940 #endif /* not USG, or USG_SUBTTY_WORKS */
1943 #endif /* HAVE_PTYS */
1946 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1947 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1950 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1951 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1955 /* Record this as an active process, with its channels.
1956 As a result, child_setup will close Emacs's side of the pipes. */
1957 chan_process
[inchannel
] = process
;
1958 XPROCESS (process
)->infd
= inchannel
;
1959 XPROCESS (process
)->outfd
= outchannel
;
1961 /* Previously we recorded the tty descriptor used in the subprocess.
1962 It was only used for getting the foreground tty process, so now
1963 we just reopen the device (see emacs_get_tty_pgrp) as this is
1964 more portable (see USG_SUBTTY_WORKS above). */
1966 XPROCESS (process
)->pty_flag
= pty_flag
;
1967 XPROCESS (process
)->status
= Qrun
;
1968 setup_process_coding_systems (process
);
1970 FD_SET (inchannel
, &input_wait_mask
);
1971 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1972 if (inchannel
> max_process_desc
)
1973 max_process_desc
= inchannel
;
1975 XPROCESS (process
)->pid
= -2;
1978 XPROCESS (process
)->tty_name
= build_string (pty_name
);
1981 XPROCESS (process
)->tty_name
= Qnil
;
1985 /* Convert an internal struct sockaddr to a lisp object (vector or string).
1986 The address family of sa is not included in the result. */
1989 conv_sockaddr_to_lisp (struct sockaddr
*sa
, int len
)
1991 Lisp_Object address
;
1994 register struct Lisp_Vector
*p
;
1996 /* Workaround for a bug in getsockname on BSD: Names bound to
1997 sockets in the UNIX domain are inaccessible; getsockname returns
1998 a zero length name. */
1999 if (len
< offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
))
2000 return empty_unibyte_string
;
2002 switch (sa
->sa_family
)
2006 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2007 len
= sizeof (sin
->sin_addr
) + 1;
2008 address
= Fmake_vector (make_number (len
), Qnil
);
2009 p
= XVECTOR (address
);
2010 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2011 cp
= (unsigned char *) &sin
->sin_addr
;
2017 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2018 uint16_t *ip6
= (uint16_t *) &sin6
->sin6_addr
;
2019 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2020 address
= Fmake_vector (make_number (len
), Qnil
);
2021 p
= XVECTOR (address
);
2022 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2023 for (i
= 0; i
< len
; i
++)
2024 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2028 #ifdef HAVE_LOCAL_SOCKETS
2031 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2032 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2033 if (sockun
->sun_path
[i
] == 0)
2035 return make_unibyte_string (sockun
->sun_path
, i
);
2039 len
-= offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
);
2040 address
= Fcons (make_number (sa
->sa_family
),
2041 Fmake_vector (make_number (len
), Qnil
));
2042 p
= XVECTOR (XCDR (address
));
2043 cp
= (unsigned char *) &sa
->sa_family
+ sizeof (sa
->sa_family
);
2049 p
->contents
[i
++] = make_number (*cp
++);
2055 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2058 get_lisp_to_sockaddr_size (Lisp_Object address
, int *familyp
)
2060 register struct Lisp_Vector
*p
;
2062 if (VECTORP (address
))
2064 p
= XVECTOR (address
);
2068 return sizeof (struct sockaddr_in
);
2071 else if (p
->size
== 9)
2073 *familyp
= AF_INET6
;
2074 return sizeof (struct sockaddr_in6
);
2078 #ifdef HAVE_LOCAL_SOCKETS
2079 else if (STRINGP (address
))
2081 *familyp
= AF_LOCAL
;
2082 return sizeof (struct sockaddr_un
);
2085 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2087 struct sockaddr
*sa
;
2088 *familyp
= XINT (XCAR (address
));
2089 p
= XVECTOR (XCDR (address
));
2090 return p
->size
+ sizeof (sa
->sa_family
);
2095 /* Convert an address object (vector or string) to an internal sockaddr.
2097 The address format has been basically validated by
2098 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2099 it could have come from user data. So if FAMILY is not valid,
2100 we return after zeroing *SA. */
2103 conv_lisp_to_sockaddr (int family
, Lisp_Object address
, struct sockaddr
*sa
, int len
)
2105 register struct Lisp_Vector
*p
;
2106 register unsigned char *cp
= NULL
;
2109 memset (sa
, 0, len
);
2111 if (VECTORP (address
))
2113 p
= XVECTOR (address
);
2114 if (family
== AF_INET
)
2116 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2117 len
= sizeof (sin
->sin_addr
) + 1;
2118 i
= XINT (p
->contents
[--len
]);
2119 sin
->sin_port
= htons (i
);
2120 cp
= (unsigned char *)&sin
->sin_addr
;
2121 sa
->sa_family
= family
;
2124 else if (family
== AF_INET6
)
2126 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2127 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2128 len
= sizeof (sin6
->sin6_addr
) + 1;
2129 i
= XINT (p
->contents
[--len
]);
2130 sin6
->sin6_port
= htons (i
);
2131 for (i
= 0; i
< len
; i
++)
2132 if (INTEGERP (p
->contents
[i
]))
2134 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2137 sa
->sa_family
= family
;
2144 else if (STRINGP (address
))
2146 #ifdef HAVE_LOCAL_SOCKETS
2147 if (family
== AF_LOCAL
)
2149 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2150 cp
= SDATA (address
);
2151 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2152 sockun
->sun_path
[i
] = *cp
++;
2153 sa
->sa_family
= family
;
2160 p
= XVECTOR (XCDR (address
));
2161 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2164 for (i
= 0; i
< len
; i
++)
2165 if (INTEGERP (p
->contents
[i
]))
2166 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2169 #ifdef DATAGRAM_SOCKETS
2170 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2172 doc
: /* Get the current datagram address associated with PROCESS. */)
2173 (Lisp_Object process
)
2177 CHECK_PROCESS (process
);
2179 if (!DATAGRAM_CONN_P (process
))
2182 channel
= XPROCESS (process
)->infd
;
2183 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2184 datagram_address
[channel
].len
);
2187 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2189 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2190 Returns nil upon error setting address, ADDRESS otherwise. */)
2191 (Lisp_Object process
, Lisp_Object address
)
2196 CHECK_PROCESS (process
);
2198 if (!DATAGRAM_CONN_P (process
))
2201 channel
= XPROCESS (process
)->infd
;
2203 len
= get_lisp_to_sockaddr_size (address
, &family
);
2204 if (datagram_address
[channel
].len
!= len
)
2206 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2212 static const struct socket_options
{
2213 /* The name of this option. Should be lowercase version of option
2214 name without SO_ prefix. */
2216 /* Option level SOL_... */
2218 /* Option number SO_... */
2220 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2221 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2222 } socket_options
[] =
2224 #ifdef SO_BINDTODEVICE
2225 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2228 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2231 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2234 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2237 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2240 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2243 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2246 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2248 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2251 /* Set option OPT to value VAL on socket S.
2253 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2254 Signals an error if setting a known option fails.
2258 set_socket_option (int s
, Lisp_Object opt
, Lisp_Object val
)
2261 const struct socket_options
*sopt
;
2266 name
= SSDATA (SYMBOL_NAME (opt
));
2267 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2268 if (strcmp (name
, sopt
->name
) == 0)
2271 switch (sopt
->opttype
)
2276 optval
= NILP (val
) ? 0 : 1;
2277 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2278 &optval
, sizeof (optval
));
2286 optval
= XINT (val
);
2288 error ("Bad option value for %s", name
);
2289 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2290 &optval
, sizeof (optval
));
2294 #ifdef SO_BINDTODEVICE
2297 char devname
[IFNAMSIZ
+1];
2299 /* This is broken, at least in the Linux 2.4 kernel.
2300 To unbind, the arg must be a zero integer, not the empty string.
2301 This should work on all systems. KFS. 2003-09-23. */
2302 memset (devname
, 0, sizeof devname
);
2305 char *arg
= SSDATA (val
);
2306 int len
= min (strlen (arg
), IFNAMSIZ
);
2307 memcpy (devname
, arg
, len
);
2309 else if (!NILP (val
))
2310 error ("Bad option value for %s", name
);
2311 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2320 struct linger linger
;
2323 linger
.l_linger
= 0;
2325 linger
.l_linger
= XINT (val
);
2327 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2328 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2329 &linger
, sizeof (linger
));
2339 report_file_error ("Cannot set network option",
2340 Fcons (opt
, Fcons (val
, Qnil
)));
2341 return (1 << sopt
->optbit
);
2345 DEFUN ("set-network-process-option",
2346 Fset_network_process_option
, Sset_network_process_option
,
2348 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2349 See `make-network-process' for a list of options and values.
2350 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2351 OPTION is not a supported option, return nil instead; otherwise return t. */)
2352 (Lisp_Object process
, Lisp_Object option
, Lisp_Object value
, Lisp_Object no_error
)
2355 struct Lisp_Process
*p
;
2357 CHECK_PROCESS (process
);
2358 p
= XPROCESS (process
);
2359 if (!NETCONN1_P (p
))
2360 error ("Process is not a network process");
2364 error ("Process is not running");
2366 if (set_socket_option (s
, option
, value
))
2368 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2372 if (NILP (no_error
))
2373 error ("Unknown or unsupported option");
2379 DEFUN ("serial-process-configure",
2380 Fserial_process_configure
,
2381 Sserial_process_configure
,
2383 doc
: /* Configure speed, bytesize, etc. of a serial process.
2385 Arguments are specified as keyword/argument pairs. Attributes that
2386 are not given are re-initialized from the process's current
2387 configuration (available via the function `process-contact') or set to
2388 reasonable default values. The following arguments are defined:
2394 -- Any of these arguments can be given to identify the process that is
2395 to be configured. If none of these arguments is given, the current
2396 buffer's process is used.
2398 :speed SPEED -- SPEED is the speed of the serial port in bits per
2399 second, also called baud rate. Any value can be given for SPEED, but
2400 most serial ports work only at a few defined values between 1200 and
2401 115200, with 9600 being the most common value. If SPEED is nil, the
2402 serial port is not configured any further, i.e., all other arguments
2403 are ignored. This may be useful for special serial ports such as
2404 Bluetooth-to-serial converters which can only be configured through AT
2405 commands. A value of nil for SPEED can be used only when passed
2406 through `make-serial-process' or `serial-term'.
2408 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2409 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2411 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2412 `odd' (use odd parity), or the symbol `even' (use even parity). If
2413 PARITY is not given, no parity is used.
2415 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2416 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2417 is not given or nil, 1 stopbit is used.
2419 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2420 flowcontrol to be used, which is either nil (don't use flowcontrol),
2421 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2422 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2423 flowcontrol is used.
2425 `serial-process-configure' is called by `make-serial-process' for the
2426 initial configuration of the serial port.
2430 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2432 \(serial-process-configure
2433 :buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)
2435 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2437 usage: (serial-process-configure &rest ARGS) */)
2438 (size_t nargs
, Lisp_Object
*args
)
2440 struct Lisp_Process
*p
;
2441 Lisp_Object contact
= Qnil
;
2442 Lisp_Object proc
= Qnil
;
2443 struct gcpro gcpro1
;
2445 contact
= Flist (nargs
, args
);
2448 proc
= Fplist_get (contact
, QCprocess
);
2450 proc
= Fplist_get (contact
, QCname
);
2452 proc
= Fplist_get (contact
, QCbuffer
);
2454 proc
= Fplist_get (contact
, QCport
);
2455 proc
= get_process (proc
);
2456 p
= XPROCESS (proc
);
2457 if (!EQ (p
->type
, Qserial
))
2458 error ("Not a serial process");
2460 if (NILP (Fplist_get (p
->childp
, QCspeed
)))
2466 serial_configure (p
, contact
);
2472 /* Used by make-serial-process to recover from errors. */
2474 make_serial_process_unwind (Lisp_Object proc
)
2476 if (!PROCESSP (proc
))
2478 remove_process (proc
);
2482 DEFUN ("make-serial-process", Fmake_serial_process
, Smake_serial_process
,
2484 doc
: /* Create and return a serial port process.
2486 In Emacs, serial port connections are represented by process objects,
2487 so input and output work as for subprocesses, and `delete-process'
2488 closes a serial port connection. However, a serial process has no
2489 process id, it cannot be signaled, and the status codes are different
2490 from normal processes.
2492 `make-serial-process' creates a process and a buffer, on which you
2493 probably want to use `process-send-string'. Try \\[serial-term] for
2494 an interactive terminal. See below for examples.
2496 Arguments are specified as keyword/argument pairs. The following
2497 arguments are defined:
2499 :port PORT -- (mandatory) PORT is the path or name of the serial port.
2500 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
2501 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
2502 the backslashes in strings).
2504 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
2505 which is called by `make-serial-process'.
2507 :name NAME -- NAME is the name of the process. If NAME is not given,
2508 the value of PORT is used.
2510 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2511 with the process. Process output goes at the end of that buffer,
2512 unless you specify an output stream or filter function to handle the
2513 output. If BUFFER is not given, the value of NAME is used.
2515 :coding CODING -- If CODING is a symbol, it specifies the coding
2516 system used for both reading and writing for this process. If CODING
2517 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2518 ENCODING is used for writing.
2520 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2521 the process is running. If BOOL is not given, query before exiting.
2523 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
2524 In the stopped state, a serial process does not accept incoming data,
2525 but you can send outgoing data. The stopped state is cleared by
2526 `continue-process' and set by `stop-process'.
2528 :filter FILTER -- Install FILTER as the process filter.
2530 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2532 :plist PLIST -- Install PLIST as the initial plist of the process.
2539 -- These arguments are handled by `serial-process-configure', which is
2540 called by `make-serial-process'.
2542 The original argument list, possibly modified by later configuration,
2543 is available via the function `process-contact'.
2547 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
2549 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
2551 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity 'odd)
2553 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
2555 usage: (make-serial-process &rest ARGS) */)
2556 (size_t nargs
, Lisp_Object
*args
)
2559 Lisp_Object proc
, contact
, port
;
2560 struct Lisp_Process
*p
;
2561 struct gcpro gcpro1
;
2562 Lisp_Object name
, buffer
;
2563 Lisp_Object tem
, val
;
2564 int specpdl_count
= -1;
2569 contact
= Flist (nargs
, args
);
2572 port
= Fplist_get (contact
, QCport
);
2574 error ("No port specified");
2575 CHECK_STRING (port
);
2577 if (NILP (Fplist_member (contact
, QCspeed
)))
2578 error (":speed not specified");
2579 if (!NILP (Fplist_get (contact
, QCspeed
)))
2580 CHECK_NUMBER (Fplist_get (contact
, QCspeed
));
2582 name
= Fplist_get (contact
, QCname
);
2585 CHECK_STRING (name
);
2586 proc
= make_process (name
);
2587 specpdl_count
= SPECPDL_INDEX ();
2588 record_unwind_protect (make_serial_process_unwind
, proc
);
2589 p
= XPROCESS (proc
);
2591 fd
= serial_open (SSDATA (port
));
2594 if (fd
> max_process_desc
)
2595 max_process_desc
= fd
;
2596 chan_process
[fd
] = proc
;
2598 buffer
= Fplist_get (contact
, QCbuffer
);
2601 buffer
= Fget_buffer_create (buffer
);
2604 p
->childp
= contact
;
2605 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
2607 p
->sentinel
= Fplist_get (contact
, QCsentinel
);
2608 p
->filter
= Fplist_get (contact
, QCfilter
);
2610 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
2611 p
->kill_without_query
= 1;
2612 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
2616 if (!EQ (p
->command
, Qt
))
2618 FD_SET (fd
, &input_wait_mask
);
2619 FD_SET (fd
, &non_keyboard_wait_mask
);
2622 if (BUFFERP (buffer
))
2624 set_marker_both (p
->mark
, buffer
,
2625 BUF_ZV (XBUFFER (buffer
)),
2626 BUF_ZV_BYTE (XBUFFER (buffer
)));
2629 tem
= Fplist_member (contact
, QCcoding
);
2630 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
2636 val
= XCAR (XCDR (tem
));
2640 else if (!NILP (Vcoding_system_for_read
))
2641 val
= Vcoding_system_for_read
;
2642 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2643 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2645 p
->decode_coding_system
= val
;
2650 val
= XCAR (XCDR (tem
));
2654 else if (!NILP (Vcoding_system_for_write
))
2655 val
= Vcoding_system_for_write
;
2656 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2657 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2659 p
->encode_coding_system
= val
;
2661 setup_process_coding_systems (proc
);
2662 p
->decoding_buf
= empty_unibyte_string
;
2663 p
->decoding_carryover
= 0;
2664 p
->encoding_buf
= empty_unibyte_string
;
2665 p
->inherit_coding_system_flag
2666 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
2668 Fserial_process_configure (nargs
, args
);
2670 specpdl_ptr
= specpdl
+ specpdl_count
;
2676 /* Create a network stream/datagram client/server process. Treated
2677 exactly like a normal process when reading and writing. Primary
2678 differences are in status display and process deletion. A network
2679 connection has no PID; you cannot signal it. All you can do is
2680 stop/continue it and deactivate/close it via delete-process */
2682 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2684 doc
: /* Create and return a network server or client process.
2686 In Emacs, network connections are represented by process objects, so
2687 input and output work as for subprocesses and `delete-process' closes
2688 a network connection. However, a network process has no process id,
2689 it cannot be signaled, and the status codes are different from normal
2692 Arguments are specified as keyword/argument pairs. The following
2693 arguments are defined:
2695 :name NAME -- NAME is name for process. It is modified if necessary
2698 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2699 with the process. Process output goes at end of that buffer, unless
2700 you specify an output stream or filter function to handle the output.
2701 BUFFER may be also nil, meaning that this process is not associated
2704 :host HOST -- HOST is name of the host to connect to, or its IP
2705 address. The symbol `local' specifies the local host. If specified
2706 for a server process, it must be a valid name or address for the local
2707 host, and only clients connecting to that address will be accepted.
2709 :service SERVICE -- SERVICE is name of the service desired, or an
2710 integer specifying a port number to connect to. If SERVICE is t,
2711 a random port number is selected for the server. (If Emacs was
2712 compiled with getaddrinfo, a port number can also be specified as a
2713 string, e.g. "80", as well as an integer. This is not portable.)
2715 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2716 stream type connection, `datagram' creates a datagram type connection,
2717 `seqpacket' creates a reliable datagram connection.
2719 :family FAMILY -- FAMILY is the address (and protocol) family for the
2720 service specified by HOST and SERVICE. The default (nil) is to use
2721 whatever address family (IPv4 or IPv6) that is defined for the host
2722 and port number specified by HOST and SERVICE. Other address families
2724 local -- for a local (i.e. UNIX) address specified by SERVICE.
2725 ipv4 -- use IPv4 address family only.
2726 ipv6 -- use IPv6 address family only.
2728 :local ADDRESS -- ADDRESS is the local address used for the connection.
2729 This parameter is ignored when opening a client process. When specified
2730 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2732 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2733 connection. This parameter is ignored when opening a stream server
2734 process. For a datagram server process, it specifies the initial
2735 setting of the remote datagram address. When specified for a client
2736 process, the FAMILY, HOST, and SERVICE args are ignored.
2738 The format of ADDRESS depends on the address family:
2739 - An IPv4 address is represented as an vector of integers [A B C D P]
2740 corresponding to numeric IP address A.B.C.D and port number P.
2741 - A local address is represented as a string with the address in the
2742 local address space.
2743 - An "unsupported family" address is represented by a cons (F . AV)
2744 where F is the family number and AV is a vector containing the socket
2745 address data with one element per address data byte. Do not rely on
2746 this format in portable code, as it may depend on implementation
2747 defined constants, data sizes, and data structure alignment.
2749 :coding CODING -- If CODING is a symbol, it specifies the coding
2750 system used for both reading and writing for this process. If CODING
2751 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2752 ENCODING is used for writing.
2754 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2755 return without waiting for the connection to complete; instead, the
2756 sentinel function will be called with second arg matching "open" (if
2757 successful) or "failed" when the connect completes. Default is to use
2758 a blocking connect (i.e. wait) for stream type connections.
2760 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2761 running when Emacs is exited.
2763 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2764 In the stopped state, a server process does not accept new
2765 connections, and a client process does not handle incoming traffic.
2766 The stopped state is cleared by `continue-process' and set by
2769 :filter FILTER -- Install FILTER as the process filter.
2771 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2772 process filter are multibyte, otherwise they are unibyte.
2773 If this keyword is not specified, the strings are multibyte if
2774 `default-enable-multibyte-characters' is non-nil.
2776 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2778 :log LOG -- Install LOG as the server process log function. This
2779 function is called when the server accepts a network connection from a
2780 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2781 is the server process, CLIENT is the new process for the connection,
2782 and MESSAGE is a string.
2784 :plist PLIST -- Install PLIST as the new process' initial plist.
2786 :server QLEN -- if QLEN is non-nil, create a server process for the
2787 specified FAMILY, SERVICE, and connection type (stream or datagram).
2788 If QLEN is an integer, it is used as the max. length of the server's
2789 pending connection queue (also known as the backlog); the default
2790 queue length is 5. Default is to create a client process.
2792 The following network options can be specified for this connection:
2794 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2795 :dontroute BOOL -- Only send to directly connected hosts.
2796 :keepalive BOOL -- Send keep-alive messages on network stream.
2797 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2798 :oobinline BOOL -- Place out-of-band data in receive data stream.
2799 :priority INT -- Set protocol defined priority for sent packets.
2800 :reuseaddr BOOL -- Allow reusing a recently used local address
2801 (this is allowed by default for a server process).
2802 :bindtodevice NAME -- bind to interface NAME. Using this may require
2803 special privileges on some systems.
2805 Consult the relevant system programmer's manual pages for more
2806 information on using these options.
2809 A server process will listen for and accept connections from clients.
2810 When a client connection is accepted, a new network process is created
2811 for the connection with the following parameters:
2813 - The client's process name is constructed by concatenating the server
2814 process' NAME and a client identification string.
2815 - If the FILTER argument is non-nil, the client process will not get a
2816 separate process buffer; otherwise, the client's process buffer is a newly
2817 created buffer named after the server process' BUFFER name or process
2818 NAME concatenated with the client identification string.
2819 - The connection type and the process filter and sentinel parameters are
2820 inherited from the server process' TYPE, FILTER and SENTINEL.
2821 - The client process' contact info is set according to the client's
2822 addressing information (typically an IP address and a port number).
2823 - The client process' plist is initialized from the server's plist.
2825 Notice that the FILTER and SENTINEL args are never used directly by
2826 the server process. Also, the BUFFER argument is not used directly by
2827 the server process, but via the optional :log function, accepted (and
2828 failed) connections may be logged in the server process' buffer.
2830 The original argument list, modified with the actual connection
2831 information, is available via the `process-contact' function.
2833 usage: (make-network-process &rest ARGS) */)
2834 (size_t nargs
, Lisp_Object
*args
)
2837 Lisp_Object contact
;
2838 struct Lisp_Process
*p
;
2839 #ifdef HAVE_GETADDRINFO
2840 struct addrinfo ai
, *res
, *lres
;
2841 struct addrinfo hints
;
2842 const char *portstring
;
2844 #else /* HAVE_GETADDRINFO */
2845 struct _emacs_addrinfo
2851 struct sockaddr
*ai_addr
;
2852 struct _emacs_addrinfo
*ai_next
;
2854 #endif /* HAVE_GETADDRINFO */
2855 struct sockaddr_in address_in
;
2856 #ifdef HAVE_LOCAL_SOCKETS
2857 struct sockaddr_un address_un
;
2862 int s
= -1, outch
, inch
;
2863 struct gcpro gcpro1
;
2864 int count
= SPECPDL_INDEX ();
2866 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2868 Lisp_Object name
, buffer
, host
, service
, address
;
2869 Lisp_Object filter
, sentinel
;
2870 int is_non_blocking_client
= 0;
2871 int is_server
= 0, backlog
= 5;
2878 /* Save arguments for process-contact and clone-process. */
2879 contact
= Flist (nargs
, args
);
2883 /* Ensure socket support is loaded if available. */
2884 init_winsock (TRUE
);
2887 /* :type TYPE (nil: stream, datagram */
2888 tem
= Fplist_get (contact
, QCtype
);
2890 socktype
= SOCK_STREAM
;
2891 #ifdef DATAGRAM_SOCKETS
2892 else if (EQ (tem
, Qdatagram
))
2893 socktype
= SOCK_DGRAM
;
2895 #ifdef HAVE_SEQPACKET
2896 else if (EQ (tem
, Qseqpacket
))
2897 socktype
= SOCK_SEQPACKET
;
2900 error ("Unsupported connection type");
2903 tem
= Fplist_get (contact
, QCserver
);
2906 /* Don't support network sockets when non-blocking mode is
2907 not available, since a blocked Emacs is not useful. */
2908 #if !defined(O_NONBLOCK) && !defined(O_NDELAY)
2909 error ("Network servers not supported");
2913 backlog
= XINT (tem
);
2917 /* Make QCaddress an alias for :local (server) or :remote (client). */
2918 QCaddress
= is_server
? QClocal
: QCremote
;
2921 if (!is_server
&& socktype
!= SOCK_DGRAM
2922 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2924 #ifndef NON_BLOCKING_CONNECT
2925 error ("Non-blocking connect not supported");
2927 is_non_blocking_client
= 1;
2931 name
= Fplist_get (contact
, QCname
);
2932 buffer
= Fplist_get (contact
, QCbuffer
);
2933 filter
= Fplist_get (contact
, QCfilter
);
2934 sentinel
= Fplist_get (contact
, QCsentinel
);
2936 CHECK_STRING (name
);
2938 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2939 ai
.ai_socktype
= socktype
;
2944 /* :local ADDRESS or :remote ADDRESS */
2945 address
= Fplist_get (contact
, QCaddress
);
2946 if (!NILP (address
))
2948 host
= service
= Qnil
;
2950 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2951 error ("Malformed :address");
2952 ai
.ai_family
= family
;
2953 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2954 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2958 /* :family FAMILY -- nil (for Inet), local, or integer. */
2959 tem
= Fplist_get (contact
, QCfamily
);
2962 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
2968 #ifdef HAVE_LOCAL_SOCKETS
2969 else if (EQ (tem
, Qlocal
))
2973 else if (EQ (tem
, Qipv6
))
2976 else if (EQ (tem
, Qipv4
))
2978 else if (INTEGERP (tem
))
2979 family
= XINT (tem
);
2981 error ("Unknown address family");
2983 ai
.ai_family
= family
;
2985 /* :service SERVICE -- string, integer (port number), or t (random port). */
2986 service
= Fplist_get (contact
, QCservice
);
2988 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2989 host
= Fplist_get (contact
, QChost
);
2992 if (EQ (host
, Qlocal
))
2993 /* Depending on setup, "localhost" may map to different IPv4 and/or
2994 IPv6 addresses, so it's better to be explicit. (Bug#6781) */
2995 host
= build_string ("127.0.0.1");
2996 CHECK_STRING (host
);
2999 #ifdef HAVE_LOCAL_SOCKETS
3000 if (family
== AF_LOCAL
)
3004 message (":family local ignores the :host \"%s\" property",
3006 contact
= Fplist_put (contact
, QChost
, Qnil
);
3009 CHECK_STRING (service
);
3010 memset (&address_un
, 0, sizeof address_un
);
3011 address_un
.sun_family
= AF_LOCAL
;
3012 strncpy (address_un
.sun_path
, SSDATA (service
), sizeof address_un
.sun_path
);
3013 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
3014 ai
.ai_addrlen
= sizeof address_un
;
3019 /* Slow down polling to every ten seconds.
3020 Some kernels have a bug which causes retrying connect to fail
3021 after a connect. Polling can interfere with gethostbyname too. */
3022 #ifdef POLL_FOR_INPUT
3023 if (socktype
!= SOCK_DGRAM
)
3025 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
3026 bind_polling_period (10);
3030 #ifdef HAVE_GETADDRINFO
3031 /* If we have a host, use getaddrinfo to resolve both host and service.
3032 Otherwise, use getservbyname to lookup the service. */
3036 /* SERVICE can either be a string or int.
3037 Convert to a C string for later use by getaddrinfo. */
3038 if (EQ (service
, Qt
))
3040 else if (INTEGERP (service
))
3042 sprintf (portbuf
, "%ld", (long) XINT (service
));
3043 portstring
= portbuf
;
3047 CHECK_STRING (service
);
3048 portstring
= SSDATA (service
);
3053 memset (&hints
, 0, sizeof (hints
));
3055 hints
.ai_family
= family
;
3056 hints
.ai_socktype
= socktype
;
3057 hints
.ai_protocol
= 0;
3059 #ifdef HAVE_RES_INIT
3063 ret
= getaddrinfo (SSDATA (host
), portstring
, &hints
, &res
);
3065 #ifdef HAVE_GAI_STRERROR
3066 error ("%s/%s %s", SSDATA (host
), portstring
, gai_strerror (ret
));
3068 error ("%s/%s getaddrinfo error %d", SSDATA (host
), portstring
, ret
);
3074 #endif /* HAVE_GETADDRINFO */
3076 /* We end up here if getaddrinfo is not defined, or in case no hostname
3077 has been specified (e.g. for a local server process). */
3079 if (EQ (service
, Qt
))
3081 else if (INTEGERP (service
))
3082 port
= htons ((unsigned short) XINT (service
));
3085 struct servent
*svc_info
;
3086 CHECK_STRING (service
);
3087 svc_info
= getservbyname (SSDATA (service
),
3088 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3090 error ("Unknown service: %s", SDATA (service
));
3091 port
= svc_info
->s_port
;
3094 memset (&address_in
, 0, sizeof address_in
);
3095 address_in
.sin_family
= family
;
3096 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3097 address_in
.sin_port
= port
;
3099 #ifndef HAVE_GETADDRINFO
3102 struct hostent
*host_info_ptr
;
3104 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3105 as it may `hang' Emacs for a very long time. */
3109 #ifdef HAVE_RES_INIT
3113 host_info_ptr
= gethostbyname (SDATA (host
));
3118 memcpy (&address_in
.sin_addr
, host_info_ptr
->h_addr
,
3119 host_info_ptr
->h_length
);
3120 family
= host_info_ptr
->h_addrtype
;
3121 address_in
.sin_family
= family
;
3124 /* Attempt to interpret host as numeric inet address */
3126 unsigned long numeric_addr
;
3127 numeric_addr
= inet_addr (SSDATA (host
));
3128 if (numeric_addr
== -1)
3129 error ("Unknown host \"%s\"", SDATA (host
));
3131 memcpy (&address_in
.sin_addr
, &numeric_addr
,
3132 sizeof (address_in
.sin_addr
));
3136 #endif /* not HAVE_GETADDRINFO */
3138 ai
.ai_family
= family
;
3139 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3140 ai
.ai_addrlen
= sizeof address_in
;
3144 /* Do this in case we never enter the for-loop below. */
3145 count1
= SPECPDL_INDEX ();
3148 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3157 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3164 #ifdef DATAGRAM_SOCKETS
3165 if (!is_server
&& socktype
== SOCK_DGRAM
)
3167 #endif /* DATAGRAM_SOCKETS */
3169 #ifdef NON_BLOCKING_CONNECT
3170 if (is_non_blocking_client
)
3173 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3175 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3187 /* Make us close S if quit. */
3188 record_unwind_protect (close_file_unwind
, make_number (s
));
3190 /* Parse network options in the arg list.
3191 We simply ignore anything which isn't a known option (including other keywords).
3192 An error is signaled if setting a known option fails. */
3193 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3194 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3198 /* Configure as a server socket. */
3200 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3201 explicit :reuseaddr key to override this. */
3202 #ifdef HAVE_LOCAL_SOCKETS
3203 if (family
!= AF_LOCAL
)
3205 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3208 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3209 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3212 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3213 report_file_error ("Cannot bind server socket", Qnil
);
3215 #ifdef HAVE_GETSOCKNAME
3216 if (EQ (service
, Qt
))
3218 struct sockaddr_in sa1
;
3219 socklen_t len1
= sizeof (sa1
);
3220 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3222 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3223 service
= make_number (ntohs (sa1
.sin_port
));
3224 contact
= Fplist_put (contact
, QCservice
, service
);
3229 if (socktype
!= SOCK_DGRAM
&& listen (s
, backlog
))
3230 report_file_error ("Cannot listen on server socket", Qnil
);
3238 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3241 if (ret
== 0 || xerrno
== EISCONN
)
3243 /* The unwind-protect will be discarded afterwards.
3244 Likewise for immediate_quit. */
3248 #ifdef NON_BLOCKING_CONNECT
3250 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3254 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3261 if (xerrno
== EINTR
)
3263 /* Unlike most other syscalls connect() cannot be called
3264 again. (That would return EALREADY.) The proper way to
3265 wait for completion is select(). */
3273 sc
= select (s
+ 1, (SELECT_TYPE
*)0, &fdset
, (SELECT_TYPE
*)0,
3280 report_file_error ("select failed", Qnil
);
3284 len
= sizeof xerrno
;
3285 eassert (FD_ISSET (s
, &fdset
));
3286 if (getsockopt (s
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &len
) == -1)
3287 report_file_error ("getsockopt failed", Qnil
);
3289 errno
= xerrno
, report_file_error ("error during connect", Qnil
);
3293 #endif /* !WINDOWSNT */
3297 /* Discard the unwind protect closing S. */
3298 specpdl_ptr
= specpdl
+ count1
;
3303 if (xerrno
== EINTR
)
3310 #ifdef DATAGRAM_SOCKETS
3311 if (socktype
== SOCK_DGRAM
)
3313 if (datagram_address
[s
].sa
)
3315 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3316 datagram_address
[s
].len
= lres
->ai_addrlen
;
3320 memset (datagram_address
[s
].sa
, 0, lres
->ai_addrlen
);
3321 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3324 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3325 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3326 conv_lisp_to_sockaddr (rfamily
, remote
,
3327 datagram_address
[s
].sa
, rlen
);
3331 memcpy (datagram_address
[s
].sa
, lres
->ai_addr
, lres
->ai_addrlen
);
3334 contact
= Fplist_put (contact
, QCaddress
,
3335 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3336 #ifdef HAVE_GETSOCKNAME
3339 struct sockaddr_in sa1
;
3340 socklen_t len1
= sizeof (sa1
);
3341 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3342 contact
= Fplist_put (contact
, QClocal
,
3343 conv_sockaddr_to_lisp ((struct sockaddr
*)&sa1
, len1
));
3350 #ifdef HAVE_GETADDRINFO
3359 /* Discard the unwind protect for closing S, if any. */
3360 specpdl_ptr
= specpdl
+ count1
;
3362 /* Unwind bind_polling_period and request_sigio. */
3363 unbind_to (count
, Qnil
);
3367 /* If non-blocking got this far - and failed - assume non-blocking is
3368 not supported after all. This is probably a wrong assumption, but
3369 the normal blocking calls to open-network-stream handles this error
3371 if (is_non_blocking_client
)
3376 report_file_error ("make server process failed", contact
);
3378 report_file_error ("make client process failed", contact
);
3385 buffer
= Fget_buffer_create (buffer
);
3386 proc
= make_process (name
);
3388 chan_process
[inch
] = proc
;
3391 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3394 fcntl (inch
, F_SETFL
, O_NDELAY
);
3398 p
= XPROCESS (proc
);
3400 p
->childp
= contact
;
3401 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3405 p
->sentinel
= sentinel
;
3407 p
->log
= Fplist_get (contact
, QClog
);
3408 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3409 p
->kill_without_query
= 1;
3410 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3415 if (is_server
&& socktype
!= SOCK_DGRAM
)
3416 p
->status
= Qlisten
;
3418 /* Make the process marker point into the process buffer (if any). */
3419 if (BUFFERP (buffer
))
3420 set_marker_both (p
->mark
, buffer
,
3421 BUF_ZV (XBUFFER (buffer
)),
3422 BUF_ZV_BYTE (XBUFFER (buffer
)));
3424 #ifdef NON_BLOCKING_CONNECT
3425 if (is_non_blocking_client
)
3427 /* We may get here if connect did succeed immediately. However,
3428 in that case, we still need to signal this like a non-blocking
3430 p
->status
= Qconnect
;
3431 if (!FD_ISSET (inch
, &connect_wait_mask
))
3433 FD_SET (inch
, &connect_wait_mask
);
3434 FD_SET (inch
, &write_mask
);
3435 num_pending_connects
++;
3440 /* A server may have a client filter setting of Qt, but it must
3441 still listen for incoming connects unless it is stopped. */
3442 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3443 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3445 FD_SET (inch
, &input_wait_mask
);
3446 FD_SET (inch
, &non_keyboard_wait_mask
);
3449 if (inch
> max_process_desc
)
3450 max_process_desc
= inch
;
3452 tem
= Fplist_member (contact
, QCcoding
);
3453 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3454 tem
= Qnil
; /* No error message (too late!). */
3457 /* Setup coding systems for communicating with the network stream. */
3458 struct gcpro inner_gcpro1
;
3459 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3460 Lisp_Object coding_systems
= Qt
;
3461 Lisp_Object fargs
[5], val
;
3465 val
= XCAR (XCDR (tem
));
3469 else if (!NILP (Vcoding_system_for_read
))
3470 val
= Vcoding_system_for_read
;
3471 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
3472 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
3473 /* We dare not decode end-of-line format by setting VAL to
3474 Qraw_text, because the existing Emacs Lisp libraries
3475 assume that they receive bare code including a sequene of
3480 if (NILP (host
) || NILP (service
))
3481 coding_systems
= Qnil
;
3484 fargs
[0] = Qopen_network_stream
, fargs
[1] = name
,
3485 fargs
[2] = buffer
, fargs
[3] = host
, fargs
[4] = service
;
3486 GCPRO1_VAR (proc
, inner_gcpro
);
3487 coding_systems
= Ffind_operation_coding_system (5, fargs
);
3488 UNGCPRO_VAR (inner_gcpro
);
3490 if (CONSP (coding_systems
))
3491 val
= XCAR (coding_systems
);
3492 else if (CONSP (Vdefault_process_coding_system
))
3493 val
= XCAR (Vdefault_process_coding_system
);
3497 p
->decode_coding_system
= val
;
3501 val
= XCAR (XCDR (tem
));
3505 else if (!NILP (Vcoding_system_for_write
))
3506 val
= Vcoding_system_for_write
;
3507 else if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3511 if (EQ (coding_systems
, Qt
))
3513 if (NILP (host
) || NILP (service
))
3514 coding_systems
= Qnil
;
3517 fargs
[0] = Qopen_network_stream
, fargs
[1] = name
,
3518 fargs
[2] = buffer
, fargs
[3] = host
, fargs
[4] = service
;
3519 GCPRO1_VAR (proc
, inner_gcpro
);
3520 coding_systems
= Ffind_operation_coding_system (5, fargs
);
3521 UNGCPRO_VAR (inner_gcpro
);
3524 if (CONSP (coding_systems
))
3525 val
= XCDR (coding_systems
);
3526 else if (CONSP (Vdefault_process_coding_system
))
3527 val
= XCDR (Vdefault_process_coding_system
);
3531 p
->encode_coding_system
= val
;
3533 setup_process_coding_systems (proc
);
3535 p
->decoding_buf
= empty_unibyte_string
;
3536 p
->decoding_carryover
= 0;
3537 p
->encoding_buf
= empty_unibyte_string
;
3539 p
->inherit_coding_system_flag
3540 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
3547 #if defined(HAVE_NET_IF_H)
3550 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3551 doc
: /* Return an alist of all network interfaces and their network address.
3552 Each element is a cons, the car of which is a string containing the
3553 interface name, and the cdr is the network address in internal
3554 format; see the description of ADDRESS in `make-network-process'. */)
3557 struct ifconf ifconf
;
3558 struct ifreq
*ifreqs
= NULL
;
3563 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3569 buf_size
= ifaces
* sizeof (ifreqs
[0]);
3570 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3577 ifconf
.ifc_len
= buf_size
;
3578 ifconf
.ifc_req
= ifreqs
;
3579 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3585 if (ifconf
.ifc_len
== buf_size
)
3589 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3592 while (--ifaces
>= 0)
3594 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3595 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3596 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3598 memcpy (namebuf
, ifq
->ifr_name
, sizeof (ifq
->ifr_name
));
3599 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3600 res
= Fcons (Fcons (build_string (namebuf
),
3601 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3602 sizeof (struct sockaddr
))),
3608 #endif /* SIOCGIFCONF */
3610 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3614 const char *flag_sym
;
3617 static const struct ifflag_def ifflag_table
[] = {
3621 #ifdef IFF_BROADCAST
3622 { IFF_BROADCAST
, "broadcast" },
3625 { IFF_DEBUG
, "debug" },
3628 { IFF_LOOPBACK
, "loopback" },
3630 #ifdef IFF_POINTOPOINT
3631 { IFF_POINTOPOINT
, "pointopoint" },
3634 { IFF_RUNNING
, "running" },
3637 { IFF_NOARP
, "noarp" },
3640 { IFF_PROMISC
, "promisc" },
3642 #ifdef IFF_NOTRAILERS
3643 { IFF_NOTRAILERS
, "notrailers" },
3646 { IFF_ALLMULTI
, "allmulti" },
3649 { IFF_MASTER
, "master" },
3652 { IFF_SLAVE
, "slave" },
3654 #ifdef IFF_MULTICAST
3655 { IFF_MULTICAST
, "multicast" },
3658 { IFF_PORTSEL
, "portsel" },
3660 #ifdef IFF_AUTOMEDIA
3661 { IFF_AUTOMEDIA
, "automedia" },
3664 { IFF_DYNAMIC
, "dynamic" },
3667 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3670 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3673 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3676 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3679 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3684 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3685 doc
: /* Return information about network interface named IFNAME.
3686 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3687 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3688 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3689 FLAGS is the current flags of the interface. */)
3690 (Lisp_Object ifname
)
3693 Lisp_Object res
= Qnil
;
3698 CHECK_STRING (ifname
);
3700 memset (rq
.ifr_name
, 0, sizeof rq
.ifr_name
);
3701 strncpy (rq
.ifr_name
, SSDATA (ifname
), sizeof (rq
.ifr_name
));
3703 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3708 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3709 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3711 int flags
= rq
.ifr_flags
;
3712 const struct ifflag_def
*fp
;
3716 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3718 if (flags
& fp
->flag_bit
)
3720 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3721 flags
-= fp
->flag_bit
;
3724 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3726 if (flags
& (1 << fnum
))
3728 elt
= Fcons (make_number (fnum
), elt
);
3733 res
= Fcons (elt
, res
);
3736 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3737 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3739 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3740 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3744 for (n
= 0; n
< 6; n
++)
3745 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3746 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3749 res
= Fcons (elt
, res
);
3752 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
3753 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3756 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3757 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3759 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3763 res
= Fcons (elt
, res
);
3766 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3767 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3770 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3773 res
= Fcons (elt
, res
);
3776 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3777 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3780 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3783 res
= Fcons (elt
, res
);
3787 return any
? res
: Qnil
;
3790 #endif /* defined(HAVE_NET_IF_H) */
3792 /* Turn off input and output for process PROC. */
3795 deactivate_process (Lisp_Object proc
)
3797 register int inchannel
, outchannel
;
3798 register struct Lisp_Process
*p
= XPROCESS (proc
);
3800 inchannel
= p
->infd
;
3801 outchannel
= p
->outfd
;
3803 #ifdef ADAPTIVE_READ_BUFFERING
3804 if (p
->read_output_delay
> 0)
3806 if (--process_output_delay_count
< 0)
3807 process_output_delay_count
= 0;
3808 p
->read_output_delay
= 0;
3809 p
->read_output_skip
= 0;
3815 /* Beware SIGCHLD hereabouts. */
3816 flush_pending_output (inchannel
);
3817 emacs_close (inchannel
);
3818 if (outchannel
>= 0 && outchannel
!= inchannel
)
3819 emacs_close (outchannel
);
3823 #ifdef DATAGRAM_SOCKETS
3824 if (DATAGRAM_CHAN_P (inchannel
))
3826 xfree (datagram_address
[inchannel
].sa
);
3827 datagram_address
[inchannel
].sa
= 0;
3828 datagram_address
[inchannel
].len
= 0;
3831 chan_process
[inchannel
] = Qnil
;
3832 FD_CLR (inchannel
, &input_wait_mask
);
3833 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3834 #ifdef NON_BLOCKING_CONNECT
3835 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3837 FD_CLR (inchannel
, &connect_wait_mask
);
3838 FD_CLR (inchannel
, &write_mask
);
3839 if (--num_pending_connects
< 0)
3843 if (inchannel
== max_process_desc
)
3846 /* We just closed the highest-numbered process input descriptor,
3847 so recompute the highest-numbered one now. */
3848 max_process_desc
= 0;
3849 for (i
= 0; i
< MAXDESC
; i
++)
3850 if (!NILP (chan_process
[i
]))
3851 max_process_desc
= i
;
3857 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3859 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3860 It is read into the process' buffers or given to their filter functions.
3861 Non-nil arg PROCESS means do not return until some output has been received
3864 Non-nil second arg SECONDS and third arg MILLISEC are number of seconds
3865 and milliseconds to wait; return after that much time whether or not
3866 there is any subprocess output. If SECONDS is a floating point number,
3867 it specifies a fractional number of seconds to wait.
3868 The MILLISEC argument is obsolete and should be avoided.
3870 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3871 from PROCESS, suspending reading output from other processes.
3872 If JUST-THIS-ONE is an integer, don't run any timers either.
3873 Return non-nil if we received any output before the timeout expired. */)
3874 (register Lisp_Object process
, Lisp_Object seconds
, Lisp_Object millisec
, Lisp_Object just_this_one
)
3876 int secs
, usecs
= 0;
3878 if (! NILP (process
))
3879 CHECK_PROCESS (process
);
3881 just_this_one
= Qnil
;
3883 if (!NILP (millisec
))
3884 { /* Obsolete calling convention using integers rather than floats. */
3885 CHECK_NUMBER (millisec
);
3887 seconds
= make_float (XINT (millisec
) / 1000.0);
3890 CHECK_NUMBER (seconds
);
3891 seconds
= make_float (XINT (millisec
) / 1000.0 + XINT (seconds
));
3895 if (!NILP (seconds
))
3897 if (INTEGERP (seconds
))
3898 secs
= XINT (seconds
);
3899 else if (FLOATP (seconds
))
3901 double timeout
= XFLOAT_DATA (seconds
);
3902 secs
= (int) timeout
;
3903 usecs
= (int) ((timeout
- (double) secs
) * 1000000);
3906 wrong_type_argument (Qnumberp
, seconds
);
3908 if (secs
< 0 || (secs
== 0 && usecs
== 0))
3909 secs
= -1, usecs
= 0;
3912 secs
= NILP (process
) ? -1 : 0;
3915 (wait_reading_process_output (secs
, usecs
, 0, 0,
3917 !NILP (process
) ? XPROCESS (process
) : NULL
,
3918 NILP (just_this_one
) ? 0 :
3919 !INTEGERP (just_this_one
) ? 1 : -1)
3923 /* Accept a connection for server process SERVER on CHANNEL. */
3925 static int connect_counter
= 0;
3928 server_accept_connection (Lisp_Object server
, int channel
)
3930 Lisp_Object proc
, caller
, name
, buffer
;
3931 Lisp_Object contact
, host
, service
;
3932 struct Lisp_Process
*ps
= XPROCESS (server
);
3933 struct Lisp_Process
*p
;
3937 struct sockaddr_in in
;
3939 struct sockaddr_in6 in6
;
3941 #ifdef HAVE_LOCAL_SOCKETS
3942 struct sockaddr_un un
;
3945 socklen_t len
= sizeof saddr
;
3947 s
= accept (channel
, &saddr
.sa
, &len
);
3956 if (code
== EWOULDBLOCK
)
3960 if (!NILP (ps
->log
))
3961 call3 (ps
->log
, server
, Qnil
,
3962 concat3 (build_string ("accept failed with code"),
3963 Fnumber_to_string (make_number (code
)),
3964 build_string ("\n")));
3970 /* Setup a new process to handle the connection. */
3972 /* Generate a unique identification of the caller, and build contact
3973 information for this process. */
3976 switch (saddr
.sa
.sa_family
)
3980 Lisp_Object args
[5];
3981 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
3982 args
[0] = build_string ("%d.%d.%d.%d");
3983 args
[1] = make_number (*ip
++);
3984 args
[2] = make_number (*ip
++);
3985 args
[3] = make_number (*ip
++);
3986 args
[4] = make_number (*ip
++);
3987 host
= Fformat (5, args
);
3988 service
= make_number (ntohs (saddr
.in
.sin_port
));
3990 args
[0] = build_string (" <%s:%d>");
3993 caller
= Fformat (3, args
);
4000 Lisp_Object args
[9];
4001 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4003 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4004 for (i
= 0; i
< 8; i
++)
4005 args
[i
+1] = make_number (ntohs (ip6
[i
]));
4006 host
= Fformat (9, args
);
4007 service
= make_number (ntohs (saddr
.in
.sin_port
));
4009 args
[0] = build_string (" <[%s]:%d>");
4012 caller
= Fformat (3, args
);
4017 #ifdef HAVE_LOCAL_SOCKETS
4021 caller
= Fnumber_to_string (make_number (connect_counter
));
4022 caller
= concat3 (build_string (" <"), caller
, build_string (">"));
4026 /* Create a new buffer name for this process if it doesn't have a
4027 filter. The new buffer name is based on the buffer name or
4028 process name of the server process concatenated with the caller
4031 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4035 buffer
= ps
->buffer
;
4037 buffer
= Fbuffer_name (buffer
);
4042 buffer
= concat2 (buffer
, caller
);
4043 buffer
= Fget_buffer_create (buffer
);
4047 /* Generate a unique name for the new server process. Combine the
4048 server process name with the caller identification. */
4050 name
= concat2 (ps
->name
, caller
);
4051 proc
= make_process (name
);
4053 chan_process
[s
] = proc
;
4056 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4059 fcntl (s
, F_SETFL
, O_NDELAY
);
4063 p
= XPROCESS (proc
);
4065 /* Build new contact information for this setup. */
4066 contact
= Fcopy_sequence (ps
->childp
);
4067 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4068 contact
= Fplist_put (contact
, QChost
, host
);
4069 if (!NILP (service
))
4070 contact
= Fplist_put (contact
, QCservice
, service
);
4071 contact
= Fplist_put (contact
, QCremote
,
4072 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4073 #ifdef HAVE_GETSOCKNAME
4075 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4076 contact
= Fplist_put (contact
, QClocal
,
4077 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4080 p
->childp
= contact
;
4081 p
->plist
= Fcopy_sequence (ps
->plist
);
4085 p
->sentinel
= ps
->sentinel
;
4086 p
->filter
= ps
->filter
;
4093 /* Client processes for accepted connections are not stopped initially. */
4094 if (!EQ (p
->filter
, Qt
))
4096 FD_SET (s
, &input_wait_mask
);
4097 FD_SET (s
, &non_keyboard_wait_mask
);
4100 if (s
> max_process_desc
)
4101 max_process_desc
= s
;
4103 /* Setup coding system for new process based on server process.
4104 This seems to be the proper thing to do, as the coding system
4105 of the new process should reflect the settings at the time the
4106 server socket was opened; not the current settings. */
4108 p
->decode_coding_system
= ps
->decode_coding_system
;
4109 p
->encode_coding_system
= ps
->encode_coding_system
;
4110 setup_process_coding_systems (proc
);
4112 p
->decoding_buf
= empty_unibyte_string
;
4113 p
->decoding_carryover
= 0;
4114 p
->encoding_buf
= empty_unibyte_string
;
4116 p
->inherit_coding_system_flag
4117 = (NILP (buffer
) ? 0 : ps
->inherit_coding_system_flag
);
4119 if (!NILP (ps
->log
))
4120 call3 (ps
->log
, server
, proc
,
4121 concat3 (build_string ("accept from "),
4122 (STRINGP (host
) ? host
: build_string ("-")),
4123 build_string ("\n")));
4125 if (!NILP (p
->sentinel
))
4126 exec_sentinel (proc
,
4127 concat3 (build_string ("open from "),
4128 (STRINGP (host
) ? host
: build_string ("-")),
4129 build_string ("\n")));
4132 /* This variable is different from waiting_for_input in keyboard.c.
4133 It is used to communicate to a lisp process-filter/sentinel (via the
4134 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4135 for user-input when that process-filter was called.
4136 waiting_for_input cannot be used as that is by definition 0 when
4137 lisp code is being evalled.
4138 This is also used in record_asynch_buffer_change.
4139 For that purpose, this must be 0
4140 when not inside wait_reading_process_output. */
4141 static int waiting_for_user_input_p
;
4144 wait_reading_process_output_unwind (Lisp_Object data
)
4146 waiting_for_user_input_p
= XINT (data
);
4150 /* This is here so breakpoints can be put on it. */
4152 wait_reading_process_output_1 (void)
4156 /* Use a wrapper around select to work around a bug in gdb 5.3.
4157 Normally, the wrapper is optimized away by inlining.
4159 If emacs is stopped inside select, the gdb backtrace doesn't
4160 show the function which called select, so it is practically
4161 impossible to step through wait_reading_process_output. */
4165 select_wrapper (int n
, fd_set
*rfd
, fd_set
*wfd
, fd_set
*xfd
, struct timeval
*tmo
)
4167 return select (n
, rfd
, wfd
, xfd
, tmo
);
4169 #define select select_wrapper
4172 /* Read and dispose of subprocess output while waiting for timeout to
4173 elapse and/or keyboard input to be available.
4176 timeout in seconds, or
4177 zero for no limit, or
4178 -1 means gobble data immediately available but don't wait for any.
4181 an additional duration to wait, measured in microseconds.
4182 If this is nonzero and time_limit is 0, then the timeout
4183 consists of MICROSECS only.
4185 READ_KBD is a lisp value:
4186 0 to ignore keyboard input, or
4187 1 to return when input is available, or
4188 -1 meaning caller will actually read the input, so don't throw to
4189 the quit handler, or
4191 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4192 output that arrives.
4194 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4195 (and gobble terminal input into the buffer if any arrives).
4197 If WAIT_PROC is specified, wait until something arrives from that
4198 process. The return value is true if we read some input from
4201 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4202 (suspending output from other processes). A negative value
4203 means don't run any timers either.
4205 If WAIT_PROC is specified, then the function returns true if we
4206 received input from that process before the timeout elapsed.
4207 Otherwise, return true if we received input from any process. */
4210 wait_reading_process_output (int time_limit
, int microsecs
, int read_kbd
,
4212 Lisp_Object wait_for_cell
,
4213 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
4215 register int channel
, nfds
;
4216 SELECT_TYPE Available
;
4217 SELECT_TYPE Writeok
;
4219 int check_delay
, no_avail
;
4222 EMACS_TIME timeout
, end_time
;
4223 int wait_channel
= -1;
4224 int got_some_input
= 0;
4225 int count
= SPECPDL_INDEX ();
4227 FD_ZERO (&Available
);
4230 if (time_limit
== 0 && microsecs
== 0 && wait_proc
&& !NILP (Vinhibit_quit
)
4231 && !(CONSP (wait_proc
->status
) && EQ (XCAR (wait_proc
->status
), Qexit
)))
4232 message ("Blocking call to accept-process-output with quit inhibited!!");
4234 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4235 if (wait_proc
!= NULL
)
4236 wait_channel
= wait_proc
->infd
;
4238 record_unwind_protect (wait_reading_process_output_unwind
,
4239 make_number (waiting_for_user_input_p
));
4240 waiting_for_user_input_p
= read_kbd
;
4242 /* Since we may need to wait several times,
4243 compute the absolute time to return at. */
4244 if (time_limit
|| microsecs
)
4246 EMACS_GET_TIME (end_time
);
4247 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4248 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4253 int timeout_reduced_for_timers
= 0;
4255 /* If calling from keyboard input, do not quit
4256 since we want to return C-g as an input character.
4257 Otherwise, do pending quit if requested. */
4262 process_pending_signals ();
4265 /* Exit now if the cell we're waiting for became non-nil. */
4266 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4269 /* Compute time from now till when time limit is up */
4270 /* Exit if already run out */
4271 if (time_limit
== -1)
4273 /* -1 specified for timeout means
4274 gobble output available now
4275 but don't wait at all. */
4277 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4279 else if (time_limit
|| microsecs
)
4281 EMACS_GET_TIME (timeout
);
4282 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4283 if (EMACS_TIME_NEG_P (timeout
))
4288 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4291 /* Normally we run timers here.
4292 But not if wait_for_cell; in those cases,
4293 the wait is supposed to be short,
4294 and those callers cannot handle running arbitrary Lisp code here. */
4295 if (NILP (wait_for_cell
)
4296 && just_wait_proc
>= 0)
4298 EMACS_TIME timer_delay
;
4302 int old_timers_run
= timers_run
;
4303 struct buffer
*old_buffer
= current_buffer
;
4304 Lisp_Object old_window
= selected_window
;
4306 timer_delay
= timer_check ();
4308 /* If a timer has run, this might have changed buffers
4309 an alike. Make read_key_sequence aware of that. */
4310 if (timers_run
!= old_timers_run
4311 && (old_buffer
!= current_buffer
4312 || !EQ (old_window
, selected_window
))
4313 && waiting_for_user_input_p
== -1)
4314 record_asynch_buffer_change ();
4316 if (timers_run
!= old_timers_run
&& do_display
)
4317 /* We must retry, since a timer may have requeued itself
4318 and that could alter the time_delay. */
4319 redisplay_preserve_echo_area (9);
4323 while (!detect_input_pending ());
4325 /* If there is unread keyboard input, also return. */
4327 && requeued_events_pending_p ())
4330 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4332 EMACS_TIME difference
;
4333 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4334 if (EMACS_TIME_NEG_P (difference
))
4336 timeout
= timer_delay
;
4337 timeout_reduced_for_timers
= 1;
4340 /* If time_limit is -1, we are not going to wait at all. */
4341 else if (time_limit
!= -1)
4343 /* This is so a breakpoint can be put here. */
4344 wait_reading_process_output_1 ();
4348 /* Cause C-g and alarm signals to take immediate action,
4349 and cause input available signals to zero out timeout.
4351 It is important that we do this before checking for process
4352 activity. If we get a SIGCHLD after the explicit checks for
4353 process activity, timeout is the only way we will know. */
4355 set_waiting_for_input (&timeout
);
4357 /* If status of something has changed, and no input is
4358 available, notify the user of the change right away. After
4359 this explicit check, we'll let the SIGCHLD handler zap
4360 timeout to get our attention. */
4361 if (update_tick
!= process_tick
)
4366 if (kbd_on_hold_p ())
4369 Atemp
= input_wait_mask
;
4372 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4373 if ((select (max (max_process_desc
, max_input_desc
) + 1,
4375 #ifdef NON_BLOCKING_CONNECT
4376 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4380 (SELECT_TYPE
*)0, &timeout
)
4383 /* It's okay for us to do this and then continue with
4384 the loop, since timeout has already been zeroed out. */
4385 clear_waiting_for_input ();
4386 status_notify (NULL
);
4387 if (do_display
) redisplay_preserve_echo_area (13);
4391 /* Don't wait for output from a non-running process. Just
4392 read whatever data has already been received. */
4393 if (wait_proc
&& wait_proc
->raw_status_new
)
4394 update_status (wait_proc
);
4396 && ! EQ (wait_proc
->status
, Qrun
)
4397 && ! EQ (wait_proc
->status
, Qconnect
))
4399 int nread
, total_nread
= 0;
4401 clear_waiting_for_input ();
4402 XSETPROCESS (proc
, wait_proc
);
4404 /* Read data from the process, until we exhaust it. */
4405 while (wait_proc
->infd
>= 0)
4407 nread
= read_process_output (proc
, wait_proc
->infd
);
4414 total_nread
+= nread
;
4418 else if (nread
== -1 && EIO
== errno
)
4422 else if (nread
== -1 && EAGAIN
== errno
)
4426 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4430 if (total_nread
> 0 && do_display
)
4431 redisplay_preserve_echo_area (10);
4436 /* Wait till there is something to do */
4438 if (wait_proc
&& just_wait_proc
)
4440 if (wait_proc
->infd
< 0) /* Terminated */
4442 FD_SET (wait_proc
->infd
, &Available
);
4446 else if (!NILP (wait_for_cell
))
4448 Available
= non_process_wait_mask
;
4455 Available
= non_keyboard_wait_mask
;
4457 Available
= input_wait_mask
;
4458 Writeok
= write_mask
;
4459 #ifdef SELECT_CANT_DO_WRITE_MASK
4464 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4467 /* If frame size has changed or the window is newly mapped,
4468 redisplay now, before we start to wait. There is a race
4469 condition here; if a SIGIO arrives between now and the select
4470 and indicates that a frame is trashed, the select may block
4471 displaying a trashed screen. */
4472 if (frame_garbaged
&& do_display
)
4474 clear_waiting_for_input ();
4475 redisplay_preserve_echo_area (11);
4477 set_waiting_for_input (&timeout
);
4481 if (read_kbd
&& detect_input_pending ())
4489 #ifdef ADAPTIVE_READ_BUFFERING
4490 /* Set the timeout for adaptive read buffering if any
4491 process has non-zero read_output_skip and non-zero
4492 read_output_delay, and we are not reading output for a
4493 specific wait_channel. It is not executed if
4494 Vprocess_adaptive_read_buffering is nil. */
4495 if (process_output_skip
&& check_delay
> 0)
4497 int usecs
= EMACS_USECS (timeout
);
4498 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4499 usecs
= READ_OUTPUT_DELAY_MAX
;
4500 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4502 proc
= chan_process
[channel
];
4505 /* Find minimum non-zero read_output_delay among the
4506 processes with non-zero read_output_skip. */
4507 if (XPROCESS (proc
)->read_output_delay
> 0)
4510 if (!XPROCESS (proc
)->read_output_skip
)
4512 FD_CLR (channel
, &Available
);
4513 XPROCESS (proc
)->read_output_skip
= 0;
4514 if (XPROCESS (proc
)->read_output_delay
< usecs
)
4515 usecs
= XPROCESS (proc
)->read_output_delay
;
4518 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4519 process_output_skip
= 0;
4522 #if defined (USE_GTK) || defined (HAVE_GCONF)
4524 #elif defined (HAVE_NS)
4529 (max (max_process_desc
, max_input_desc
) + 1,
4531 (check_write
? &Writeok
: (SELECT_TYPE
*)0),
4532 (SELECT_TYPE
*)0, &timeout
);
4537 /* Make C-g and alarm signals set flags again */
4538 clear_waiting_for_input ();
4540 /* If we woke up due to SIGWINCH, actually change size now. */
4541 do_pending_window_change (0);
4543 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4544 /* We wanted the full specified time, so return now. */
4548 if (xerrno
== EINTR
)
4550 else if (xerrno
== EBADF
)
4553 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4554 the child's closure of the pts gives the parent a SIGHUP, and
4555 the ptc file descriptor is automatically closed,
4556 yielding EBADF here or at select() call above.
4557 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4558 in m/ibmrt-aix.h), and here we just ignore the select error.
4559 Cleanup occurs c/o status_notify after SIGCLD. */
4560 no_avail
= 1; /* Cannot depend on values returned */
4566 error ("select error: %s", emacs_strerror (xerrno
));
4571 FD_ZERO (&Available
);
4575 #if 0 /* When polling is used, interrupt_input is 0,
4576 so get_input_pending should read the input.
4577 So this should not be needed. */
4578 /* If we are using polling for input,
4579 and we see input available, make it get read now.
4580 Otherwise it might not actually get read for a second.
4581 And on hpux, since we turn off polling in wait_reading_process_output,
4582 it might never get read at all if we don't spend much time
4583 outside of wait_reading_process_output. */
4584 if (read_kbd
&& interrupt_input
4585 && keyboard_bit_set (&Available
)
4586 && input_polling_used ())
4587 kill (getpid (), SIGALRM
);
4590 /* Check for keyboard input */
4591 /* If there is any, return immediately
4592 to give it higher priority than subprocesses */
4596 int old_timers_run
= timers_run
;
4597 struct buffer
*old_buffer
= current_buffer
;
4598 Lisp_Object old_window
= selected_window
;
4601 if (detect_input_pending_run_timers (do_display
))
4603 swallow_events (do_display
);
4604 if (detect_input_pending_run_timers (do_display
))
4608 /* If a timer has run, this might have changed buffers
4609 an alike. Make read_key_sequence aware of that. */
4610 if (timers_run
!= old_timers_run
4611 && waiting_for_user_input_p
== -1
4612 && (old_buffer
!= current_buffer
4613 || !EQ (old_window
, selected_window
)))
4614 record_asynch_buffer_change ();
4620 /* If there is unread keyboard input, also return. */
4622 && requeued_events_pending_p ())
4625 /* If we are not checking for keyboard input now,
4626 do process events (but don't run any timers).
4627 This is so that X events will be processed.
4628 Otherwise they may have to wait until polling takes place.
4629 That would causes delays in pasting selections, for example.
4631 (We used to do this only if wait_for_cell.) */
4632 if (read_kbd
== 0 && detect_input_pending ())
4634 swallow_events (do_display
);
4635 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4636 if (detect_input_pending ())
4641 /* Exit now if the cell we're waiting for became non-nil. */
4642 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4646 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4647 go read it. This can happen with X on BSD after logging out.
4648 In that case, there really is no input and no SIGIO,
4649 but select says there is input. */
4651 if (read_kbd
&& interrupt_input
4652 && keyboard_bit_set (&Available
) && ! noninteractive
)
4653 kill (getpid (), SIGIO
);
4657 got_some_input
|= nfds
> 0;
4659 /* If checking input just got us a size-change event from X,
4660 obey it now if we should. */
4661 if (read_kbd
|| ! NILP (wait_for_cell
))
4662 do_pending_window_change (0);
4664 /* Check for data from a process. */
4665 if (no_avail
|| nfds
== 0)
4668 for (channel
= 0; channel
<= max_input_desc
; ++channel
)
4670 struct fd_callback_data
*d
= &fd_callback_info
[channel
];
4671 if (FD_ISSET (channel
, &Available
)
4673 && (d
->condition
& FOR_READ
) != 0)
4674 d
->func (channel
, d
->data
, 1);
4675 if (FD_ISSET (channel
, &write_mask
)
4677 && (d
->condition
& FOR_WRITE
) != 0)
4678 d
->func (channel
, d
->data
, 0);
4681 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4683 if (FD_ISSET (channel
, &Available
)
4684 && FD_ISSET (channel
, &non_keyboard_wait_mask
)
4685 && !FD_ISSET (channel
, &non_process_wait_mask
))
4689 /* If waiting for this channel, arrange to return as
4690 soon as no more input to be processed. No more
4692 if (wait_channel
== channel
)
4698 proc
= chan_process
[channel
];
4702 /* If this is a server stream socket, accept connection. */
4703 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4705 server_accept_connection (proc
, channel
);
4709 /* Read data from the process, starting with our
4710 buffered-ahead character if we have one. */
4712 nread
= read_process_output (proc
, channel
);
4715 /* Since read_process_output can run a filter,
4716 which can call accept-process-output,
4717 don't try to read from any other processes
4718 before doing the select again. */
4719 FD_ZERO (&Available
);
4722 redisplay_preserve_echo_area (12);
4725 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4728 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4729 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4731 else if (nread
== -1 && errno
== EAGAIN
)
4735 else if (nread
== -1 && errno
== EAGAIN
)
4737 /* Note that we cannot distinguish between no input
4738 available now and a closed pipe.
4739 With luck, a closed pipe will be accompanied by
4740 subprocess termination and SIGCHLD. */
4741 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
4743 #endif /* O_NDELAY */
4744 #endif /* O_NONBLOCK */
4746 /* On some OSs with ptys, when the process on one end of
4747 a pty exits, the other end gets an error reading with
4748 errno = EIO instead of getting an EOF (0 bytes read).
4749 Therefore, if we get an error reading and errno =
4750 EIO, just continue, because the child process has
4751 exited and should clean itself up soon (e.g. when we
4754 However, it has been known to happen that the SIGCHLD
4755 got lost. So raise the signal again just in case.
4757 else if (nread
== -1 && errno
== EIO
)
4759 /* Clear the descriptor now, so we only raise the
4760 signal once. Don't do this if `process' is only
4762 if (XPROCESS (proc
)->pid
!= -2)
4764 FD_CLR (channel
, &input_wait_mask
);
4765 FD_CLR (channel
, &non_keyboard_wait_mask
);
4767 kill (getpid (), SIGCHLD
);
4770 #endif /* HAVE_PTYS */
4771 /* If we can detect process termination, don't consider the process
4772 gone just because its pipe is closed. */
4774 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
4779 /* Preserve status of processes already terminated. */
4780 XPROCESS (proc
)->tick
= ++process_tick
;
4781 deactivate_process (proc
);
4782 if (XPROCESS (proc
)->raw_status_new
)
4783 update_status (XPROCESS (proc
));
4784 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4785 XPROCESS (proc
)->status
4786 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4789 #ifdef NON_BLOCKING_CONNECT
4790 if (FD_ISSET (channel
, &Writeok
)
4791 && FD_ISSET (channel
, &connect_wait_mask
))
4793 struct Lisp_Process
*p
;
4795 FD_CLR (channel
, &connect_wait_mask
);
4796 FD_CLR (channel
, &write_mask
);
4797 if (--num_pending_connects
< 0)
4800 proc
= chan_process
[channel
];
4804 p
= XPROCESS (proc
);
4807 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4808 So only use it on systems where it is known to work. */
4810 socklen_t xlen
= sizeof (xerrno
);
4811 if (getsockopt (channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4816 struct sockaddr pname
;
4817 int pnamelen
= sizeof (pname
);
4819 /* If connection failed, getpeername will fail. */
4821 if (getpeername (channel
, &pname
, &pnamelen
) < 0)
4823 /* Obtain connect failure code through error slippage. */
4826 if (errno
== ENOTCONN
&& read (channel
, &dummy
, 1) < 0)
4833 p
->tick
= ++process_tick
;
4834 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4835 deactivate_process (proc
);
4840 /* Execute the sentinel here. If we had relied on
4841 status_notify to do it later, it will read input
4842 from the process before calling the sentinel. */
4843 exec_sentinel (proc
, build_string ("open\n"));
4844 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4846 FD_SET (p
->infd
, &input_wait_mask
);
4847 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
4851 #endif /* NON_BLOCKING_CONNECT */
4852 } /* end for each file descriptor */
4853 } /* end while exit conditions not met */
4855 unbind_to (count
, Qnil
);
4857 /* If calling from keyboard input, do not quit
4858 since we want to return C-g as an input character.
4859 Otherwise, do pending quit if requested. */
4862 /* Prevent input_pending from remaining set if we quit. */
4863 clear_input_pending ();
4867 return got_some_input
;
4870 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4873 read_process_output_call (Lisp_Object fun_and_args
)
4875 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4879 read_process_output_error_handler (Lisp_Object error_val
)
4881 cmd_error_internal (error_val
, "error in process filter: ");
4883 update_echo_area ();
4884 Fsleep_for (make_number (2), Qnil
);
4888 /* Read pending output from the process channel,
4889 starting with our buffered-ahead character if we have one.
4890 Yield number of decoded characters read.
4892 This function reads at most 4096 characters.
4893 If you want to read all available subprocess output,
4894 you must call it repeatedly until it returns zero.
4896 The characters read are decoded according to PROC's coding-system
4900 read_process_output (Lisp_Object proc
, register int channel
)
4902 register ssize_t nbytes
;
4904 register Lisp_Object outstream
;
4905 register struct Lisp_Process
*p
= XPROCESS (proc
);
4906 register EMACS_INT opoint
;
4907 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4908 int carryover
= p
->decoding_carryover
;
4910 int count
= SPECPDL_INDEX ();
4911 Lisp_Object odeactivate
;
4913 chars
= (char *) alloca (carryover
+ readmax
);
4915 /* See the comment above. */
4916 memcpy (chars
, SDATA (p
->decoding_buf
), carryover
);
4918 #ifdef DATAGRAM_SOCKETS
4919 /* We have a working select, so proc_buffered_char is always -1. */
4920 if (DATAGRAM_CHAN_P (channel
))
4922 socklen_t len
= datagram_address
[channel
].len
;
4923 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
4924 0, datagram_address
[channel
].sa
, &len
);
4929 int buffered
= 0 <= proc_buffered_char
[channel
];
4932 chars
[carryover
] = proc_buffered_char
[channel
];
4933 proc_buffered_char
[channel
] = -1;
4936 if (XPROCESS (proc
)->gnutls_p
)
4937 nbytes
= emacs_gnutls_read (channel
, XPROCESS (proc
),
4938 chars
+ carryover
+ buffered
,
4939 readmax
- buffered
);
4942 nbytes
= emacs_read (channel
, chars
+ carryover
+ buffered
,
4943 readmax
- buffered
);
4944 #ifdef ADAPTIVE_READ_BUFFERING
4945 if (nbytes
> 0 && p
->adaptive_read_buffering
)
4947 int delay
= p
->read_output_delay
;
4950 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
4953 process_output_delay_count
++;
4954 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
4957 else if (delay
> 0 && nbytes
== readmax
- buffered
)
4959 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
4961 process_output_delay_count
--;
4963 p
->read_output_delay
= delay
;
4966 p
->read_output_skip
= 1;
4967 process_output_skip
= 1;
4972 nbytes
+= buffered
&& nbytes
<= 0;
4975 p
->decoding_carryover
= 0;
4977 /* At this point, NBYTES holds number of bytes just received
4978 (including the one in proc_buffered_char[channel]). */
4981 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
4983 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4986 /* Now set NBYTES how many bytes we must decode. */
4987 nbytes
+= carryover
;
4989 odeactivate
= Vdeactivate_mark
;
4990 /* There's no good reason to let process filters change the current
4991 buffer, and many callers of accept-process-output, sit-for, and
4992 friends don't expect current-buffer to be changed from under them. */
4993 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
4995 /* Read and dispose of the process output. */
4996 outstream
= p
->filter
;
4997 if (!NILP (outstream
))
5000 int outer_running_asynch_code
= running_asynch_code
;
5001 int waiting
= waiting_for_user_input_p
;
5003 /* No need to gcpro these, because all we do with them later
5004 is test them for EQness, and none of them should be a string. */
5006 Lisp_Object obuffer
, okeymap
;
5007 XSETBUFFER (obuffer
, current_buffer
);
5008 okeymap
= BVAR (current_buffer
, keymap
);
5011 /* We inhibit quit here instead of just catching it so that
5012 hitting ^G when a filter happens to be running won't screw
5014 specbind (Qinhibit_quit
, Qt
);
5015 specbind (Qlast_nonmenu_event
, Qt
);
5017 /* In case we get recursively called,
5018 and we already saved the match data nonrecursively,
5019 save the same match data in safely recursive fashion. */
5020 if (outer_running_asynch_code
)
5023 /* Don't clobber the CURRENT match data, either! */
5024 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5025 restore_search_regs ();
5026 record_unwind_save_match_data ();
5027 Fset_match_data (tem
, Qt
);
5030 /* For speed, if a search happens within this code,
5031 save the match data in a special nonrecursive fashion. */
5032 running_asynch_code
= 1;
5034 decode_coding_c_string (coding
, (unsigned char *) chars
, nbytes
, Qt
);
5035 text
= coding
->dst_object
;
5036 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5037 /* A new coding system might be found. */
5038 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5040 p
->decode_coding_system
= Vlast_coding_system_used
;
5042 /* Don't call setup_coding_system for
5043 proc_decode_coding_system[channel] here. It is done in
5044 detect_coding called via decode_coding above. */
5046 /* If a coding system for encoding is not yet decided, we set
5047 it as the same as coding-system for decoding.
5049 But, before doing that we must check if
5050 proc_encode_coding_system[p->outfd] surely points to a
5051 valid memory because p->outfd will be changed once EOF is
5052 sent to the process. */
5053 if (NILP (p
->encode_coding_system
)
5054 && proc_encode_coding_system
[p
->outfd
])
5056 p
->encode_coding_system
5057 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5058 setup_coding_system (p
->encode_coding_system
,
5059 proc_encode_coding_system
[p
->outfd
]);
5063 if (coding
->carryover_bytes
> 0)
5065 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5066 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5067 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5068 coding
->carryover_bytes
);
5069 p
->decoding_carryover
= coding
->carryover_bytes
;
5071 if (SBYTES (text
) > 0)
5072 internal_condition_case_1 (read_process_output_call
,
5074 Fcons (proc
, Fcons (text
, Qnil
))),
5075 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5076 read_process_output_error_handler
);
5078 /* If we saved the match data nonrecursively, restore it now. */
5079 restore_search_regs ();
5080 running_asynch_code
= outer_running_asynch_code
;
5082 /* Restore waiting_for_user_input_p as it was
5083 when we were called, in case the filter clobbered it. */
5084 waiting_for_user_input_p
= waiting
;
5086 #if 0 /* Call record_asynch_buffer_change unconditionally,
5087 because we might have changed minor modes or other things
5088 that affect key bindings. */
5089 if (! EQ (Fcurrent_buffer (), obuffer
)
5090 || ! EQ (current_buffer
->keymap
, okeymap
))
5092 /* But do it only if the caller is actually going to read events.
5093 Otherwise there's no need to make him wake up, and it could
5094 cause trouble (for example it would make sit_for return). */
5095 if (waiting_for_user_input_p
== -1)
5096 record_asynch_buffer_change ();
5099 /* If no filter, write into buffer if it isn't dead. */
5100 else if (!NILP (p
->buffer
) && !NILP (BVAR (XBUFFER (p
->buffer
), name
)))
5102 Lisp_Object old_read_only
;
5103 EMACS_INT old_begv
, old_zv
;
5104 EMACS_INT old_begv_byte
, old_zv_byte
;
5105 EMACS_INT before
, before_byte
;
5106 EMACS_INT opoint_byte
;
5110 Fset_buffer (p
->buffer
);
5112 opoint_byte
= PT_BYTE
;
5113 old_read_only
= BVAR (current_buffer
, read_only
);
5116 old_begv_byte
= BEGV_BYTE
;
5117 old_zv_byte
= ZV_BYTE
;
5119 BVAR (current_buffer
, read_only
) = Qnil
;
5121 /* Insert new output into buffer
5122 at the current end-of-output marker,
5123 thus preserving logical ordering of input and output. */
5124 if (XMARKER (p
->mark
)->buffer
)
5125 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5126 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5129 SET_PT_BOTH (ZV
, ZV_BYTE
);
5131 before_byte
= PT_BYTE
;
5133 /* If the output marker is outside of the visible region, save
5134 the restriction and widen. */
5135 if (! (BEGV
<= PT
&& PT
<= ZV
))
5138 decode_coding_c_string (coding
, (unsigned char *) chars
, nbytes
, Qt
);
5139 text
= coding
->dst_object
;
5140 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5141 /* A new coding system might be found. See the comment in the
5142 similar code in the previous `if' block. */
5143 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5145 p
->decode_coding_system
= Vlast_coding_system_used
;
5146 if (NILP (p
->encode_coding_system
)
5147 && proc_encode_coding_system
[p
->outfd
])
5149 p
->encode_coding_system
5150 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5151 setup_coding_system (p
->encode_coding_system
,
5152 proc_encode_coding_system
[p
->outfd
]);
5155 if (coding
->carryover_bytes
> 0)
5157 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5158 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5159 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5160 coding
->carryover_bytes
);
5161 p
->decoding_carryover
= coding
->carryover_bytes
;
5163 /* Adjust the multibyteness of TEXT to that of the buffer. */
5164 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
5165 != ! STRING_MULTIBYTE (text
))
5166 text
= (STRING_MULTIBYTE (text
)
5167 ? Fstring_as_unibyte (text
)
5168 : Fstring_to_multibyte (text
));
5169 /* Insert before markers in case we are inserting where
5170 the buffer's mark is, and the user's next command is Meta-y. */
5171 insert_from_string_before_markers (text
, 0, 0,
5172 SCHARS (text
), SBYTES (text
), 0);
5174 /* Make sure the process marker's position is valid when the
5175 process buffer is changed in the signal_after_change above.
5176 W3 is known to do that. */
5177 if (BUFFERP (p
->buffer
)
5178 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5179 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5181 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5183 update_mode_lines
++;
5185 /* Make sure opoint and the old restrictions
5186 float ahead of any new text just as point would. */
5187 if (opoint
>= before
)
5189 opoint
+= PT
- before
;
5190 opoint_byte
+= PT_BYTE
- before_byte
;
5192 if (old_begv
> before
)
5194 old_begv
+= PT
- before
;
5195 old_begv_byte
+= PT_BYTE
- before_byte
;
5197 if (old_zv
>= before
)
5199 old_zv
+= PT
- before
;
5200 old_zv_byte
+= PT_BYTE
- before_byte
;
5203 /* If the restriction isn't what it should be, set it. */
5204 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5205 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5208 BVAR (current_buffer
, read_only
) = old_read_only
;
5209 SET_PT_BOTH (opoint
, opoint_byte
);
5211 /* Handling the process output should not deactivate the mark. */
5212 Vdeactivate_mark
= odeactivate
;
5214 unbind_to (count
, Qnil
);
5218 /* Sending data to subprocess */
5220 static jmp_buf send_process_frame
;
5221 static Lisp_Object process_sent_to
;
5224 send_process_trap (int ignore
)
5226 SIGNAL_THREAD_CHECK (SIGPIPE
);
5227 sigunblock (sigmask (SIGPIPE
));
5228 longjmp (send_process_frame
, 1);
5231 /* Send some data to process PROC.
5232 BUF is the beginning of the data; LEN is the number of characters.
5233 OBJECT is the Lisp object that the data comes from. If OBJECT is
5234 nil or t, it means that the data comes from C string.
5236 If OBJECT is not nil, the data is encoded by PROC's coding-system
5237 for encoding before it is sent.
5239 This function can evaluate Lisp code and can garbage collect. */
5242 send_process (volatile Lisp_Object proc
, const char *volatile buf
,
5243 volatile EMACS_INT len
, volatile Lisp_Object object
)
5245 /* Use volatile to protect variables from being clobbered by longjmp. */
5246 struct Lisp_Process
*p
= XPROCESS (proc
);
5248 struct coding_system
*coding
;
5249 struct gcpro gcpro1
;
5250 void (*volatile old_sigpipe
) (int);
5254 if (p
->raw_status_new
)
5256 if (! EQ (p
->status
, Qrun
))
5257 error ("Process %s not running", SDATA (p
->name
));
5259 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5261 coding
= proc_encode_coding_system
[p
->outfd
];
5262 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5264 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5265 || (BUFFERP (object
)
5266 && !NILP (BVAR (XBUFFER (object
), enable_multibyte_characters
)))
5269 p
->encode_coding_system
5270 = complement_process_encoding_system (p
->encode_coding_system
);
5271 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
5273 /* The coding system for encoding was changed to raw-text
5274 because we sent a unibyte text previously. Now we are
5275 sending a multibyte text, thus we must encode it by the
5276 original coding system specified for the current process.
5278 Another reason we comming here is that the coding system
5279 was just complemented and new one was returned by
5280 complement_process_encoding_system. */
5281 setup_coding_system (p
->encode_coding_system
, coding
);
5282 Vlast_coding_system_used
= p
->encode_coding_system
;
5284 coding
->src_multibyte
= 1;
5288 /* For sending a unibyte text, character code conversion should
5289 not take place but EOL conversion should. So, setup raw-text
5290 or one of the subsidiary if we have not yet done it. */
5291 if (CODING_REQUIRE_ENCODING (coding
))
5293 if (CODING_REQUIRE_FLUSHING (coding
))
5295 /* But, before changing the coding, we must flush out data. */
5296 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5297 send_process (proc
, "", 0, Qt
);
5298 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
5300 setup_coding_system (raw_text_coding_system
5301 (Vlast_coding_system_used
),
5303 coding
->src_multibyte
= 0;
5306 coding
->dst_multibyte
= 0;
5308 if (CODING_REQUIRE_ENCODING (coding
))
5310 coding
->dst_object
= Qt
;
5311 if (BUFFERP (object
))
5313 EMACS_INT from_byte
, from
, to
;
5314 EMACS_INT save_pt
, save_pt_byte
;
5315 struct buffer
*cur
= current_buffer
;
5317 set_buffer_internal (XBUFFER (object
));
5318 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
5320 from_byte
= PTR_BYTE_POS ((unsigned char *) buf
);
5321 from
= BYTE_TO_CHAR (from_byte
);
5322 to
= BYTE_TO_CHAR (from_byte
+ len
);
5323 TEMP_SET_PT_BOTH (from
, from_byte
);
5324 encode_coding_object (coding
, object
, from
, from_byte
,
5325 to
, from_byte
+ len
, Qt
);
5326 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
5327 set_buffer_internal (cur
);
5329 else if (STRINGP (object
))
5331 encode_coding_object (coding
, object
, 0, 0, SCHARS (object
),
5332 SBYTES (object
), Qt
);
5336 coding
->dst_object
= make_unibyte_string (buf
, len
);
5337 coding
->produced
= len
;
5340 len
= coding
->produced
;
5341 object
= coding
->dst_object
;
5342 buf
= SSDATA (object
);
5345 if (pty_max_bytes
== 0)
5347 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5348 pty_max_bytes
= fpathconf (p
->outfd
, _PC_MAX_CANON
);
5349 if (pty_max_bytes
< 0)
5350 pty_max_bytes
= 250;
5352 pty_max_bytes
= 250;
5354 /* Deduct one, to leave space for the eof. */
5358 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5359 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5360 when returning with longjmp despite being declared volatile. */
5361 if (!setjmp (send_process_frame
))
5363 process_sent_to
= proc
;
5366 EMACS_INT
this = len
;
5368 /* Send this batch, using one or more write calls. */
5371 int outfd
= p
->outfd
;
5372 old_sigpipe
= (void (*) (int)) signal (SIGPIPE
, send_process_trap
);
5373 #ifdef DATAGRAM_SOCKETS
5374 if (DATAGRAM_CHAN_P (outfd
))
5376 rv
= sendto (outfd
, buf
, this,
5377 0, datagram_address
[outfd
].sa
,
5378 datagram_address
[outfd
].len
);
5379 if (rv
< 0 && errno
== EMSGSIZE
)
5381 signal (SIGPIPE
, old_sigpipe
);
5382 report_file_error ("sending datagram",
5383 Fcons (proc
, Qnil
));
5390 if (XPROCESS (proc
)->gnutls_p
)
5391 rv
= emacs_gnutls_write (outfd
,
5396 rv
= emacs_write (outfd
, buf
, this);
5397 #ifdef ADAPTIVE_READ_BUFFERING
5398 if (p
->read_output_delay
> 0
5399 && p
->adaptive_read_buffering
== 1)
5401 p
->read_output_delay
= 0;
5402 process_output_delay_count
--;
5403 p
->read_output_skip
= 0;
5407 signal (SIGPIPE
, old_sigpipe
);
5413 || errno
== EWOULDBLOCK
5419 /* Buffer is full. Wait, accepting input;
5420 that may allow the program
5421 to finish doing output and read more. */
5425 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5426 /* A gross hack to work around a bug in FreeBSD.
5427 In the following sequence, read(2) returns
5431 write(2) 954 bytes, get EAGAIN
5432 read(2) 1024 bytes in process_read_output
5433 read(2) 11 bytes in process_read_output
5435 That is, read(2) returns more bytes than have
5436 ever been written successfully. The 1033 bytes
5437 read are the 1022 bytes written successfully
5438 after processing (for example with CRs added if
5439 the terminal is set up that way which it is
5440 here). The same bytes will be seen again in a
5441 later read(2), without the CRs. */
5443 if (errno
== EAGAIN
)
5446 ioctl (p
->outfd
, TIOCFLUSH
, &flags
);
5448 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5450 /* Running filters might relocate buffers or strings.
5451 Arrange to relocate BUF. */
5452 if (BUFFERP (object
))
5453 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
),
5454 (unsigned char *) buf
);
5455 else if (STRINGP (object
))
5456 offset
= buf
- SSDATA (object
);
5458 #ifdef EMACS_HAS_USECS
5459 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5461 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5464 if (BUFFERP (object
))
5465 buf
= (char *) BUF_BYTE_ADDRESS (XBUFFER (object
),
5467 else if (STRINGP (object
))
5468 buf
= offset
+ SSDATA (object
);
5473 /* This is a real error. */
5474 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5484 signal (SIGPIPE
, old_sigpipe
);
5485 proc
= process_sent_to
;
5486 p
= XPROCESS (proc
);
5487 p
->raw_status_new
= 0;
5488 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5489 p
->tick
= ++process_tick
;
5490 deactivate_process (proc
);
5491 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5497 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5499 doc
: /* Send current contents of region as input to PROCESS.
5500 PROCESS may be a process, a buffer, the name of a process or buffer, or
5501 nil, indicating the current buffer's process.
5502 Called from program, takes three arguments, PROCESS, START and END.
5503 If the region is more than 500 characters long,
5504 it is sent in several bunches. This may happen even for shorter regions.
5505 Output from processes can arrive in between bunches. */)
5506 (Lisp_Object process
, Lisp_Object start
, Lisp_Object end
)
5509 EMACS_INT start1
, end1
;
5511 proc
= get_process (process
);
5512 validate_region (&start
, &end
);
5514 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5515 move_gap (XINT (start
));
5517 start1
= CHAR_TO_BYTE (XINT (start
));
5518 end1
= CHAR_TO_BYTE (XINT (end
));
5519 send_process (proc
, (char *) BYTE_POS_ADDR (start1
), end1
- start1
,
5520 Fcurrent_buffer ());
5525 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5527 doc
: /* Send PROCESS the contents of STRING as input.
5528 PROCESS may be a process, a buffer, the name of a process or buffer, or
5529 nil, indicating the current buffer's process.
5530 If STRING is more than 500 characters long,
5531 it is sent in several bunches. This may happen even for shorter strings.
5532 Output from processes can arrive in between bunches. */)
5533 (Lisp_Object process
, Lisp_Object string
)
5536 CHECK_STRING (string
);
5537 proc
= get_process (process
);
5538 send_process (proc
, SSDATA (string
),
5539 SBYTES (string
), string
);
5543 /* Return the foreground process group for the tty/pty that
5544 the process P uses. */
5546 emacs_get_tty_pgrp (struct Lisp_Process
*p
)
5551 if (ioctl (p
->infd
, TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5554 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5555 master side. Try the slave side. */
5556 fd
= emacs_open (SSDATA (p
->tty_name
), O_RDONLY
, 0);
5560 ioctl (fd
, TIOCGPGRP
, &gid
);
5564 #endif /* defined (TIOCGPGRP ) */
5569 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5570 Sprocess_running_child_p
, 0, 1, 0,
5571 doc
: /* Return t if PROCESS has given the terminal to a child.
5572 If the operating system does not make it possible to find out,
5573 return t unconditionally. */)
5574 (Lisp_Object process
)
5576 /* Initialize in case ioctl doesn't exist or gives an error,
5577 in a way that will cause returning t. */
5580 struct Lisp_Process
*p
;
5582 proc
= get_process (process
);
5583 p
= XPROCESS (proc
);
5585 if (!EQ (p
->type
, Qreal
))
5586 error ("Process %s is not a subprocess",
5589 error ("Process %s is not active",
5592 gid
= emacs_get_tty_pgrp (p
);
5599 /* send a signal number SIGNO to PROCESS.
5600 If CURRENT_GROUP is t, that means send to the process group
5601 that currently owns the terminal being used to communicate with PROCESS.
5602 This is used for various commands in shell mode.
5603 If CURRENT_GROUP is lambda, that means send to the process group
5604 that currently owns the terminal, but only if it is NOT the shell itself.
5606 If NOMSG is zero, insert signal-announcements into process's buffers
5609 If we can, we try to signal PROCESS by sending control characters
5610 down the pty. This allows us to signal inferiors who have changed
5611 their uid, for which killpg would return an EPERM error. */
5614 process_send_signal (Lisp_Object process
, int signo
, Lisp_Object current_group
,
5618 register struct Lisp_Process
*p
;
5622 proc
= get_process (process
);
5623 p
= XPROCESS (proc
);
5625 if (!EQ (p
->type
, Qreal
))
5626 error ("Process %s is not a subprocess",
5629 error ("Process %s is not active",
5633 current_group
= Qnil
;
5635 /* If we are using pgrps, get a pgrp number and make it negative. */
5636 if (NILP (current_group
))
5637 /* Send the signal to the shell's process group. */
5641 #ifdef SIGNALS_VIA_CHARACTERS
5642 /* If possible, send signals to the entire pgrp
5643 by sending an input character to it. */
5646 cc_t
*sig_char
= NULL
;
5648 tcgetattr (p
->infd
, &t
);
5653 sig_char
= &t
.c_cc
[VINTR
];
5657 sig_char
= &t
.c_cc
[VQUIT
];
5661 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5662 sig_char
= &t
.c_cc
[VSWTCH
];
5664 sig_char
= &t
.c_cc
[VSUSP
];
5669 if (sig_char
&& *sig_char
!= CDISABLE
)
5671 send_process (proc
, (char *) sig_char
, 1, Qnil
);
5674 /* If we can't send the signal with a character,
5675 fall through and send it another way. */
5677 /* The code above may fall through if it can't
5678 handle the signal. */
5679 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5682 /* Get the current pgrp using the tty itself, if we have that.
5683 Otherwise, use the pty to get the pgrp.
5684 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5685 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5686 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5687 His patch indicates that if TIOCGPGRP returns an error, then
5688 we should just assume that p->pid is also the process group id. */
5690 gid
= emacs_get_tty_pgrp (p
);
5693 /* If we can't get the information, assume
5694 the shell owns the tty. */
5697 /* It is not clear whether anything really can set GID to -1.
5698 Perhaps on some system one of those ioctls can or could do so.
5699 Or perhaps this is vestigial. */
5702 #else /* ! defined (TIOCGPGRP ) */
5703 /* Can't select pgrps on this system, so we know that
5704 the child itself heads the pgrp. */
5706 #endif /* ! defined (TIOCGPGRP ) */
5708 /* If current_group is lambda, and the shell owns the terminal,
5709 don't send any signal. */
5710 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
5718 p
->raw_status_new
= 0;
5720 p
->tick
= ++process_tick
;
5723 status_notify (NULL
);
5724 redisplay_preserve_echo_area (13);
5727 #endif /* ! defined (SIGCONT) */
5731 flush_pending_output (p
->infd
);
5735 /* If we don't have process groups, send the signal to the immediate
5736 subprocess. That isn't really right, but it's better than any
5737 obvious alternative. */
5740 kill (p
->pid
, signo
);
5744 /* gid may be a pid, or minus a pgrp's number */
5746 if (!NILP (current_group
))
5748 if (ioctl (p
->infd
, TIOCSIGSEND
, signo
) == -1)
5749 EMACS_KILLPG (gid
, signo
);
5756 #else /* ! defined (TIOCSIGSEND) */
5757 EMACS_KILLPG (gid
, signo
);
5758 #endif /* ! defined (TIOCSIGSEND) */
5761 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5762 doc
: /* Interrupt process PROCESS.
5763 PROCESS may be a process, a buffer, or the name of a process or buffer.
5764 No arg or nil means current buffer's process.
5765 Second arg CURRENT-GROUP non-nil means send signal to
5766 the current process-group of the process's controlling terminal
5767 rather than to the process's own process group.
5768 If the process is a shell, this means interrupt current subjob
5769 rather than the shell.
5771 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5772 don't send the signal. */)
5773 (Lisp_Object process
, Lisp_Object current_group
)
5775 process_send_signal (process
, SIGINT
, current_group
, 0);
5779 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5780 doc
: /* Kill process PROCESS. May be process or name of one.
5781 See function `interrupt-process' for more details on usage. */)
5782 (Lisp_Object process
, Lisp_Object current_group
)
5784 process_send_signal (process
, SIGKILL
, current_group
, 0);
5788 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5789 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5790 See function `interrupt-process' for more details on usage. */)
5791 (Lisp_Object process
, Lisp_Object current_group
)
5793 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5797 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5798 doc
: /* Stop process PROCESS. May be process or name of one.
5799 See function `interrupt-process' for more details on usage.
5800 If PROCESS is a network or serial process, inhibit handling of incoming
5802 (Lisp_Object process
, Lisp_Object current_group
)
5804 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
5806 struct Lisp_Process
*p
;
5808 p
= XPROCESS (process
);
5809 if (NILP (p
->command
)
5812 FD_CLR (p
->infd
, &input_wait_mask
);
5813 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
5819 error ("No SIGTSTP support");
5821 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5826 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5827 doc
: /* Continue process PROCESS. May be process or name of one.
5828 See function `interrupt-process' for more details on usage.
5829 If PROCESS is a network or serial process, resume handling of incoming
5831 (Lisp_Object process
, Lisp_Object current_group
)
5833 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
5835 struct Lisp_Process
*p
;
5837 p
= XPROCESS (process
);
5838 if (EQ (p
->command
, Qt
)
5840 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
5842 FD_SET (p
->infd
, &input_wait_mask
);
5843 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
5845 if (fd_info
[ p
->infd
].flags
& FILE_SERIAL
)
5846 PurgeComm (fd_info
[ p
->infd
].hnd
, PURGE_RXABORT
| PURGE_RXCLEAR
);
5847 #else /* not WINDOWSNT */
5848 tcflush (p
->infd
, TCIFLUSH
);
5849 #endif /* not WINDOWSNT */
5855 process_send_signal (process
, SIGCONT
, current_group
, 0);
5857 error ("No SIGCONT support");
5862 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
5863 2, 2, "sProcess (name or number): \nnSignal code: ",
5864 doc
: /* Send PROCESS the signal with code SIGCODE.
5865 PROCESS may also be a number specifying the process id of the
5866 process to signal; in this case, the process need not be a child of
5868 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
5869 (Lisp_Object process
, Lisp_Object sigcode
)
5873 if (INTEGERP (process
))
5875 pid
= XINT (process
);
5879 if (FLOATP (process
))
5881 pid
= (pid_t
) XFLOAT_DATA (process
);
5885 if (STRINGP (process
))
5888 if (tem
= Fget_process (process
), NILP (tem
))
5890 pid
= XINT (Fstring_to_number (process
, make_number (10)));
5897 process
= get_process (process
);
5902 CHECK_PROCESS (process
);
5903 pid
= XPROCESS (process
)->pid
;
5905 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
5909 #define parse_signal(NAME, VALUE) \
5910 else if (!xstrcasecmp (name, NAME)) \
5911 XSETINT (sigcode, VALUE)
5913 if (INTEGERP (sigcode
))
5919 CHECK_SYMBOL (sigcode
);
5920 name
= SSDATA (SYMBOL_NAME (sigcode
));
5922 if (!strncmp (name
, "SIG", 3) || !strncmp (name
, "sig", 3))
5928 parse_signal ("usr1", SIGUSR1
);
5931 parse_signal ("usr2", SIGUSR2
);
5934 parse_signal ("term", SIGTERM
);
5937 parse_signal ("hup", SIGHUP
);
5940 parse_signal ("int", SIGINT
);
5943 parse_signal ("quit", SIGQUIT
);
5946 parse_signal ("ill", SIGILL
);
5949 parse_signal ("abrt", SIGABRT
);
5952 parse_signal ("emt", SIGEMT
);
5955 parse_signal ("kill", SIGKILL
);
5958 parse_signal ("fpe", SIGFPE
);
5961 parse_signal ("bus", SIGBUS
);
5964 parse_signal ("segv", SIGSEGV
);
5967 parse_signal ("sys", SIGSYS
);
5970 parse_signal ("pipe", SIGPIPE
);
5973 parse_signal ("alrm", SIGALRM
);
5976 parse_signal ("urg", SIGURG
);
5979 parse_signal ("stop", SIGSTOP
);
5982 parse_signal ("tstp", SIGTSTP
);
5985 parse_signal ("cont", SIGCONT
);
5988 parse_signal ("chld", SIGCHLD
);
5991 parse_signal ("ttin", SIGTTIN
);
5994 parse_signal ("ttou", SIGTTOU
);
5997 parse_signal ("io", SIGIO
);
6000 parse_signal ("xcpu", SIGXCPU
);
6003 parse_signal ("xfsz", SIGXFSZ
);
6006 parse_signal ("vtalrm", SIGVTALRM
);
6009 parse_signal ("prof", SIGPROF
);
6012 parse_signal ("winch", SIGWINCH
);
6015 parse_signal ("info", SIGINFO
);
6018 error ("Undefined signal name %s", name
);
6023 return make_number (kill (pid
, XINT (sigcode
)));
6026 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6027 doc
: /* Make PROCESS see end-of-file in its input.
6028 EOF comes after any text already sent to it.
6029 PROCESS may be a process, a buffer, the name of a process or buffer, or
6030 nil, indicating the current buffer's process.
6031 If PROCESS is a network connection, or is a process communicating
6032 through a pipe (as opposed to a pty), then you cannot send any more
6033 text to PROCESS after you call this function.
6034 If PROCESS is a serial process, wait until all output written to the
6035 process has been transmitted to the serial port. */)
6036 (Lisp_Object process
)
6039 struct coding_system
*coding
;
6041 if (DATAGRAM_CONN_P (process
))
6044 proc
= get_process (process
);
6045 coding
= proc_encode_coding_system
[XPROCESS (proc
)->outfd
];
6047 /* Make sure the process is really alive. */
6048 if (XPROCESS (proc
)->raw_status_new
)
6049 update_status (XPROCESS (proc
));
6050 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6051 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6053 if (CODING_REQUIRE_FLUSHING (coding
))
6055 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6056 send_process (proc
, "", 0, Qnil
);
6059 if (XPROCESS (proc
)->pty_flag
)
6060 send_process (proc
, "\004", 1, Qnil
);
6061 else if (EQ (XPROCESS (proc
)->type
, Qserial
))
6064 if (tcdrain (XPROCESS (proc
)->outfd
) != 0)
6065 error ("tcdrain() failed: %s", emacs_strerror (errno
));
6066 #endif /* not WINDOWSNT */
6067 /* Do nothing on Windows because writes are blocking. */
6071 int old_outfd
, new_outfd
;
6073 #ifdef HAVE_SHUTDOWN
6074 /* If this is a network connection, or socketpair is used
6075 for communication with the subprocess, call shutdown to cause EOF.
6076 (In some old system, shutdown to socketpair doesn't work.
6077 Then we just can't win.) */
6078 if (EQ (XPROCESS (proc
)->type
, Qnetwork
)
6079 || XPROCESS (proc
)->outfd
== XPROCESS (proc
)->infd
)
6080 shutdown (XPROCESS (proc
)->outfd
, 1);
6081 /* In case of socketpair, outfd == infd, so don't close it. */
6082 if (XPROCESS (proc
)->outfd
!= XPROCESS (proc
)->infd
)
6083 emacs_close (XPROCESS (proc
)->outfd
);
6084 #else /* not HAVE_SHUTDOWN */
6085 emacs_close (XPROCESS (proc
)->outfd
);
6086 #endif /* not HAVE_SHUTDOWN */
6087 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6090 old_outfd
= XPROCESS (proc
)->outfd
;
6092 if (!proc_encode_coding_system
[new_outfd
])
6093 proc_encode_coding_system
[new_outfd
]
6094 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6095 memcpy (proc_encode_coding_system
[new_outfd
],
6096 proc_encode_coding_system
[old_outfd
],
6097 sizeof (struct coding_system
));
6098 memset (proc_encode_coding_system
[old_outfd
], 0,
6099 sizeof (struct coding_system
));
6101 XPROCESS (proc
)->outfd
= new_outfd
;
6106 /* On receipt of a signal that a child status has changed, loop asking
6107 about children with changed statuses until the system says there
6110 All we do is change the status; we do not run sentinels or print
6111 notifications. That is saved for the next time keyboard input is
6112 done, in order to avoid timing errors.
6114 ** WARNING: this can be called during garbage collection.
6115 Therefore, it must not be fooled by the presence of mark bits in
6118 ** USG WARNING: Although it is not obvious from the documentation
6119 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6120 signal() before executing at least one wait(), otherwise the
6121 handler will be called again, resulting in an infinite loop. The
6122 relevant portion of the documentation reads "SIGCLD signals will be
6123 queued and the signal-catching function will be continually
6124 reentered until the queue is empty". Invoking signal() causes the
6125 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6128 ** Malloc WARNING: This should never call malloc either directly or
6129 indirectly; if it does, that is a bug */
6133 sigchld_handler (int signo
)
6135 int old_errno
= errno
;
6137 struct Lisp_Process
*p
;
6139 SIGNAL_THREAD_CHECK (signo
);
6150 #endif /* no WUNTRACED */
6151 /* Keep trying to get a status until we get a definitive result. */
6155 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6157 while (pid
< 0 && errno
== EINTR
);
6161 /* PID == 0 means no processes found, PID == -1 means a real
6162 failure. We have done all our job, so return. */
6169 #endif /* no WNOHANG */
6171 /* Find the process that signaled us, and record its status. */
6173 /* The process can have been deleted by Fdelete_process. */
6174 for (tail
= deleted_pid_list
; CONSP (tail
); tail
= XCDR (tail
))
6176 Lisp_Object xpid
= XCAR (tail
);
6177 if ((INTEGERP (xpid
) && pid
== (pid_t
) XINT (xpid
))
6178 || (FLOATP (xpid
) && pid
== (pid_t
) XFLOAT_DATA (xpid
)))
6180 XSETCAR (tail
, Qnil
);
6181 goto sigchld_end_of_loop
;
6185 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6187 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6189 proc
= XCDR (XCAR (tail
));
6190 p
= XPROCESS (proc
);
6191 if (EQ (p
->type
, Qreal
) && p
->pid
== pid
)
6196 /* Look for an asynchronous process whose pid hasn't been filled
6199 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6201 proc
= XCDR (XCAR (tail
));
6202 p
= XPROCESS (proc
);
6208 /* Change the status of the process that was found. */
6211 int clear_desc_flag
= 0;
6213 p
->tick
= ++process_tick
;
6215 p
->raw_status_new
= 1;
6217 /* If process has terminated, stop waiting for its output. */
6218 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6220 clear_desc_flag
= 1;
6222 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6223 if (clear_desc_flag
)
6225 FD_CLR (p
->infd
, &input_wait_mask
);
6226 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6229 /* Tell wait_reading_process_output that it needs to wake up and
6231 if (input_available_clear_time
)
6232 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6235 /* There was no asynchronous process found for that pid: we have
6236 a synchronous process. */
6239 synch_process_alive
= 0;
6241 /* Report the status of the synchronous process. */
6243 synch_process_retcode
= WRETCODE (w
);
6244 else if (WIFSIGNALED (w
))
6245 synch_process_termsig
= WTERMSIG (w
);
6247 /* Tell wait_reading_process_output that it needs to wake up and
6249 if (input_available_clear_time
)
6250 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6253 sigchld_end_of_loop
:
6256 /* On some systems, we must return right away.
6257 If any more processes want to signal us, we will
6259 Otherwise (on systems that have WNOHANG), loop around
6260 to use up all the processes that have something to tell us. */
6261 #if (defined WINDOWSNT \
6262 || (defined USG && !defined GNU_LINUX \
6263 && !(defined HPUX && defined WNOHANG)))
6266 #endif /* USG, but not HPUX with WNOHANG */
6269 #endif /* SIGCHLD */
6273 exec_sentinel_unwind (Lisp_Object data
)
6275 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6280 exec_sentinel_error_handler (Lisp_Object error_val
)
6282 cmd_error_internal (error_val
, "error in process sentinel: ");
6284 update_echo_area ();
6285 Fsleep_for (make_number (2), Qnil
);
6290 exec_sentinel (Lisp_Object proc
, Lisp_Object reason
)
6292 Lisp_Object sentinel
, odeactivate
;
6293 register struct Lisp_Process
*p
= XPROCESS (proc
);
6294 int count
= SPECPDL_INDEX ();
6295 int outer_running_asynch_code
= running_asynch_code
;
6296 int waiting
= waiting_for_user_input_p
;
6298 if (inhibit_sentinels
)
6301 /* No need to gcpro these, because all we do with them later
6302 is test them for EQness, and none of them should be a string. */
6303 odeactivate
= Vdeactivate_mark
;
6305 Lisp_Object obuffer
, okeymap
;
6306 XSETBUFFER (obuffer
, current_buffer
);
6307 okeymap
= BVAR (current_buffer
, keymap
);
6310 /* There's no good reason to let sentinels change the current
6311 buffer, and many callers of accept-process-output, sit-for, and
6312 friends don't expect current-buffer to be changed from under them. */
6313 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
6315 sentinel
= p
->sentinel
;
6316 if (NILP (sentinel
))
6319 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6320 assure that it gets restored no matter how the sentinel exits. */
6322 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6323 /* Inhibit quit so that random quits don't screw up a running filter. */
6324 specbind (Qinhibit_quit
, Qt
);
6325 specbind (Qlast_nonmenu_event
, Qt
); /* Why? --Stef */
6327 /* In case we get recursively called,
6328 and we already saved the match data nonrecursively,
6329 save the same match data in safely recursive fashion. */
6330 if (outer_running_asynch_code
)
6333 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6334 restore_search_regs ();
6335 record_unwind_save_match_data ();
6336 Fset_match_data (tem
, Qt
);
6339 /* For speed, if a search happens within this code,
6340 save the match data in a special nonrecursive fashion. */
6341 running_asynch_code
= 1;
6343 internal_condition_case_1 (read_process_output_call
,
6345 Fcons (proc
, Fcons (reason
, Qnil
))),
6346 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6347 exec_sentinel_error_handler
);
6349 /* If we saved the match data nonrecursively, restore it now. */
6350 restore_search_regs ();
6351 running_asynch_code
= outer_running_asynch_code
;
6353 Vdeactivate_mark
= odeactivate
;
6355 /* Restore waiting_for_user_input_p as it was
6356 when we were called, in case the filter clobbered it. */
6357 waiting_for_user_input_p
= waiting
;
6360 if (! EQ (Fcurrent_buffer (), obuffer
)
6361 || ! EQ (current_buffer
->keymap
, okeymap
))
6363 /* But do it only if the caller is actually going to read events.
6364 Otherwise there's no need to make him wake up, and it could
6365 cause trouble (for example it would make sit_for return). */
6366 if (waiting_for_user_input_p
== -1)
6367 record_asynch_buffer_change ();
6369 unbind_to (count
, Qnil
);
6372 /* Report all recent events of a change in process status
6373 (either run the sentinel or output a message).
6374 This is usually done while Emacs is waiting for keyboard input
6375 but can be done at other times. */
6378 status_notify (struct Lisp_Process
*deleting_process
)
6380 register Lisp_Object proc
, buffer
;
6381 Lisp_Object tail
, msg
;
6382 struct gcpro gcpro1
, gcpro2
;
6386 /* We need to gcpro tail; if read_process_output calls a filter
6387 which deletes a process and removes the cons to which tail points
6388 from Vprocess_alist, and then causes a GC, tail is an unprotected
6392 /* Set this now, so that if new processes are created by sentinels
6393 that we run, we get called again to handle their status changes. */
6394 update_tick
= process_tick
;
6396 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6399 register struct Lisp_Process
*p
;
6401 proc
= Fcdr (XCAR (tail
));
6402 p
= XPROCESS (proc
);
6404 if (p
->tick
!= p
->update_tick
)
6406 p
->update_tick
= p
->tick
;
6408 /* If process is still active, read any output that remains. */
6409 while (! EQ (p
->filter
, Qt
)
6410 && ! EQ (p
->status
, Qconnect
)
6411 && ! EQ (p
->status
, Qlisten
)
6412 /* Network or serial process not stopped: */
6413 && ! EQ (p
->command
, Qt
)
6415 && p
!= deleting_process
6416 && read_process_output (proc
, p
->infd
) > 0);
6420 /* Get the text to use for the message. */
6421 if (p
->raw_status_new
)
6423 msg
= status_message (p
);
6425 /* If process is terminated, deactivate it or delete it. */
6427 if (CONSP (p
->status
))
6428 symbol
= XCAR (p
->status
);
6430 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6431 || EQ (symbol
, Qclosed
))
6433 if (delete_exited_processes
)
6434 remove_process (proc
);
6436 deactivate_process (proc
);
6439 /* The actions above may have further incremented p->tick.
6440 So set p->update_tick again
6441 so that an error in the sentinel will not cause
6442 this code to be run again. */
6443 p
->update_tick
= p
->tick
;
6444 /* Now output the message suitably. */
6445 if (!NILP (p
->sentinel
))
6446 exec_sentinel (proc
, msg
);
6447 /* Don't bother with a message in the buffer
6448 when a process becomes runnable. */
6449 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6452 struct buffer
*old
= current_buffer
;
6453 EMACS_INT opoint
, opoint_byte
;
6454 EMACS_INT before
, before_byte
;
6456 /* Avoid error if buffer is deleted
6457 (probably that's why the process is dead, too) */
6458 if (NILP (BVAR (XBUFFER (buffer
), name
)))
6460 Fset_buffer (buffer
);
6463 opoint_byte
= PT_BYTE
;
6464 /* Insert new output into buffer
6465 at the current end-of-output marker,
6466 thus preserving logical ordering of input and output. */
6467 if (XMARKER (p
->mark
)->buffer
)
6468 Fgoto_char (p
->mark
);
6470 SET_PT_BOTH (ZV
, ZV_BYTE
);
6473 before_byte
= PT_BYTE
;
6475 tem
= BVAR (current_buffer
, read_only
);
6476 BVAR (current_buffer
, read_only
) = Qnil
;
6477 insert_string ("\nProcess ");
6478 Finsert (1, &p
->name
);
6479 insert_string (" ");
6481 BVAR (current_buffer
, read_only
) = tem
;
6482 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6484 if (opoint
>= before
)
6485 SET_PT_BOTH (opoint
+ (PT
- before
),
6486 opoint_byte
+ (PT_BYTE
- before_byte
));
6488 SET_PT_BOTH (opoint
, opoint_byte
);
6490 set_buffer_internal (old
);
6495 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6500 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6501 Sset_process_coding_system
, 1, 3, 0,
6502 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6503 DECODING will be used to decode subprocess output and ENCODING to
6504 encode subprocess input. */)
6505 (register Lisp_Object process
, Lisp_Object decoding
, Lisp_Object encoding
)
6507 register struct Lisp_Process
*p
;
6509 CHECK_PROCESS (process
);
6510 p
= XPROCESS (process
);
6512 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6514 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6515 Fcheck_coding_system (decoding
);
6516 Fcheck_coding_system (encoding
);
6517 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
6518 p
->decode_coding_system
= decoding
;
6519 p
->encode_coding_system
= encoding
;
6520 setup_process_coding_systems (process
);
6525 DEFUN ("process-coding-system",
6526 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6527 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6528 (register Lisp_Object process
)
6530 CHECK_PROCESS (process
);
6531 return Fcons (XPROCESS (process
)->decode_coding_system
,
6532 XPROCESS (process
)->encode_coding_system
);
6535 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6536 Sset_process_filter_multibyte
, 2, 2, 0,
6537 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6538 If FLAG is non-nil, the filter is given multibyte strings.
6539 If FLAG is nil, the filter is given unibyte strings. In this case,
6540 all character code conversion except for end-of-line conversion is
6542 (Lisp_Object process
, Lisp_Object flag
)
6544 register struct Lisp_Process
*p
;
6546 CHECK_PROCESS (process
);
6547 p
= XPROCESS (process
);
6549 p
->decode_coding_system
= raw_text_coding_system (p
->decode_coding_system
);
6550 setup_process_coding_systems (process
);
6555 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6556 Sprocess_filter_multibyte_p
, 1, 1, 0,
6557 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6558 (Lisp_Object process
)
6560 register struct Lisp_Process
*p
;
6561 struct coding_system
*coding
;
6563 CHECK_PROCESS (process
);
6564 p
= XPROCESS (process
);
6565 coding
= proc_decode_coding_system
[p
->infd
];
6566 return (CODING_FOR_UNIBYTE (coding
) ? Qnil
: Qt
);
6573 add_gpm_wait_descriptor (int desc
)
6575 add_keyboard_wait_descriptor (desc
);
6579 delete_gpm_wait_descriptor (int desc
)
6581 delete_keyboard_wait_descriptor (desc
);
6584 /* Return nonzero if *MASK has a bit set
6585 that corresponds to one of the keyboard input descriptors. */
6588 keyboard_bit_set (fd_set
*mask
)
6592 for (fd
= 0; fd
<= max_input_desc
; fd
++)
6593 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6594 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6600 #else /* not subprocesses */
6602 /* Defined on msdos.c. */
6603 extern int sys_select (int, SELECT_TYPE
*, SELECT_TYPE
*, SELECT_TYPE
*,
6606 /* Implementation of wait_reading_process_output, assuming that there
6607 are no subprocesses. Used only by the MS-DOS build.
6609 Wait for timeout to elapse and/or keyboard input to be available.
6612 timeout in seconds, or
6613 zero for no limit, or
6614 -1 means gobble data immediately available but don't wait for any.
6616 read_kbd is a Lisp_Object:
6617 0 to ignore keyboard input, or
6618 1 to return when input is available, or
6619 -1 means caller will actually read the input, so don't throw to
6622 see full version for other parameters. We know that wait_proc will
6623 always be NULL, since `subprocesses' isn't defined.
6625 do_display != 0 means redisplay should be done to show subprocess
6626 output that arrives.
6628 Return true if we received input from any process. */
6631 wait_reading_process_output (int time_limit
, int microsecs
, int read_kbd
,
6633 Lisp_Object wait_for_cell
,
6634 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
6637 EMACS_TIME end_time
, timeout
;
6638 SELECT_TYPE waitchannels
;
6641 /* What does time_limit really mean? */
6642 if (time_limit
|| microsecs
)
6644 EMACS_GET_TIME (end_time
);
6645 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
6646 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
6649 /* Turn off periodic alarms (in case they are in use)
6650 and then turn off any other atimers,
6651 because the select emulator uses alarms. */
6653 turn_on_atimers (0);
6657 int timeout_reduced_for_timers
= 0;
6659 /* If calling from keyboard input, do not quit
6660 since we want to return C-g as an input character.
6661 Otherwise, do pending quit if requested. */
6665 /* Exit now if the cell we're waiting for became non-nil. */
6666 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6669 /* Compute time from now till when time limit is up */
6670 /* Exit if already run out */
6671 if (time_limit
== -1)
6673 /* -1 specified for timeout means
6674 gobble output available now
6675 but don't wait at all. */
6677 EMACS_SET_SECS_USECS (timeout
, 0, 0);
6679 else if (time_limit
|| microsecs
)
6681 EMACS_GET_TIME (timeout
);
6682 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
6683 if (EMACS_TIME_NEG_P (timeout
))
6688 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
6691 /* If our caller will not immediately handle keyboard events,
6692 run timer events directly.
6693 (Callers that will immediately read keyboard events
6694 call timer_delay on their own.) */
6695 if (NILP (wait_for_cell
))
6697 EMACS_TIME timer_delay
;
6701 int old_timers_run
= timers_run
;
6702 timer_delay
= timer_check ();
6703 if (timers_run
!= old_timers_run
&& do_display
)
6704 /* We must retry, since a timer may have requeued itself
6705 and that could alter the time delay. */
6706 redisplay_preserve_echo_area (14);
6710 while (!detect_input_pending ());
6712 /* If there is unread keyboard input, also return. */
6714 && requeued_events_pending_p ())
6717 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
6719 EMACS_TIME difference
;
6720 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
6721 if (EMACS_TIME_NEG_P (difference
))
6723 timeout
= timer_delay
;
6724 timeout_reduced_for_timers
= 1;
6729 /* Cause C-g and alarm signals to take immediate action,
6730 and cause input available signals to zero out timeout. */
6732 set_waiting_for_input (&timeout
);
6734 /* Wait till there is something to do. */
6736 if (! read_kbd
&& NILP (wait_for_cell
))
6737 FD_ZERO (&waitchannels
);
6739 FD_SET (0, &waitchannels
);
6741 /* If a frame has been newly mapped and needs updating,
6742 reprocess its display stuff. */
6743 if (frame_garbaged
&& do_display
)
6745 clear_waiting_for_input ();
6746 redisplay_preserve_echo_area (15);
6748 set_waiting_for_input (&timeout
);
6751 if (read_kbd
&& detect_input_pending ())
6754 FD_ZERO (&waitchannels
);
6757 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
6762 /* Make C-g and alarm signals set flags again */
6763 clear_waiting_for_input ();
6765 /* If we woke up due to SIGWINCH, actually change size now. */
6766 do_pending_window_change (0);
6768 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
6769 /* We waited the full specified time, so return now. */
6774 /* If the system call was interrupted, then go around the
6776 if (xerrno
== EINTR
)
6777 FD_ZERO (&waitchannels
);
6779 error ("select error: %s", emacs_strerror (xerrno
));
6782 /* Check for keyboard input */
6785 && detect_input_pending_run_timers (do_display
))
6787 swallow_events (do_display
);
6788 if (detect_input_pending_run_timers (do_display
))
6792 /* If there is unread keyboard input, also return. */
6794 && requeued_events_pending_p ())
6797 /* If wait_for_cell. check for keyboard input
6798 but don't run any timers.
6799 ??? (It seems wrong to me to check for keyboard
6800 input at all when wait_for_cell, but the code
6801 has been this way since July 1994.
6802 Try changing this after version 19.31.) */
6803 if (! NILP (wait_for_cell
)
6804 && detect_input_pending ())
6806 swallow_events (do_display
);
6807 if (detect_input_pending ())
6811 /* Exit now if the cell we're waiting for became non-nil. */
6812 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6821 #endif /* not subprocesses */
6823 /* The following functions are needed even if async subprocesses are
6824 not supported. Some of them are no-op stubs in that case. */
6826 /* Add DESC to the set of keyboard input descriptors. */
6829 add_keyboard_wait_descriptor (int desc
)
6831 #ifdef subprocesses /* actually means "not MSDOS" */
6832 FD_SET (desc
, &input_wait_mask
);
6833 FD_SET (desc
, &non_process_wait_mask
);
6834 if (desc
> max_input_desc
)
6835 max_input_desc
= desc
;
6839 /* From now on, do not expect DESC to give keyboard input. */
6842 delete_keyboard_wait_descriptor (int desc
)
6846 int lim
= max_input_desc
;
6848 FD_CLR (desc
, &input_wait_mask
);
6849 FD_CLR (desc
, &non_process_wait_mask
);
6851 if (desc
== max_input_desc
)
6852 for (fd
= 0; fd
< lim
; fd
++)
6853 if (FD_ISSET (fd
, &input_wait_mask
) || FD_ISSET (fd
, &write_mask
))
6854 max_input_desc
= fd
;
6858 /* Setup coding systems of PROCESS. */
6861 setup_process_coding_systems (Lisp_Object process
)
6864 struct Lisp_Process
*p
= XPROCESS (process
);
6866 int outch
= p
->outfd
;
6867 Lisp_Object coding_system
;
6869 if (inch
< 0 || outch
< 0)
6872 if (!proc_decode_coding_system
[inch
])
6873 proc_decode_coding_system
[inch
]
6874 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6875 coding_system
= p
->decode_coding_system
;
6876 if (! NILP (p
->filter
))
6878 else if (BUFFERP (p
->buffer
))
6880 if (NILP (BVAR (XBUFFER (p
->buffer
), enable_multibyte_characters
)))
6881 coding_system
= raw_text_coding_system (coding_system
);
6883 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
6885 if (!proc_encode_coding_system
[outch
])
6886 proc_encode_coding_system
[outch
]
6887 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6888 setup_coding_system (p
->encode_coding_system
,
6889 proc_encode_coding_system
[outch
]);
6893 /* Close all descriptors currently in use for communication
6894 with subprocess. This is used in a newly-forked subprocess
6895 to get rid of irrelevant descriptors. */
6898 close_process_descs (void)
6902 for (i
= 0; i
< MAXDESC
; i
++)
6904 Lisp_Object process
;
6905 process
= chan_process
[i
];
6906 if (!NILP (process
))
6908 int in
= XPROCESS (process
)->infd
;
6909 int out
= XPROCESS (process
)->outfd
;
6912 if (out
>= 0 && in
!= out
)
6919 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
6920 doc
: /* Return the (or a) process associated with BUFFER.
6921 BUFFER may be a buffer or the name of one. */)
6922 (register Lisp_Object buffer
)
6925 register Lisp_Object buf
, tail
, proc
;
6927 if (NILP (buffer
)) return Qnil
;
6928 buf
= Fget_buffer (buffer
);
6929 if (NILP (buf
)) return Qnil
;
6931 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6933 proc
= Fcdr (XCAR (tail
));
6934 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
6937 #endif /* subprocesses */
6941 DEFUN ("process-inherit-coding-system-flag",
6942 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
6944 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
6945 If this flag is t, `buffer-file-coding-system' of the buffer
6946 associated with PROCESS will inherit the coding system used to decode
6947 the process output. */)
6948 (register Lisp_Object process
)
6951 CHECK_PROCESS (process
);
6952 return XPROCESS (process
)->inherit_coding_system_flag
? Qt
: Qnil
;
6954 /* Ignore the argument and return the value of
6955 inherit-process-coding-system. */
6956 return inherit_process_coding_system
? Qt
: Qnil
;
6960 /* Kill all processes associated with `buffer'.
6961 If `buffer' is nil, kill all processes */
6964 kill_buffer_processes (Lisp_Object buffer
)
6967 Lisp_Object tail
, proc
;
6969 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6971 proc
= XCDR (XCAR (tail
));
6973 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6975 if (NETCONN_P (proc
) || SERIALCONN_P (proc
))
6976 Fdelete_process (proc
);
6977 else if (XPROCESS (proc
)->infd
>= 0)
6978 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6981 #else /* subprocesses */
6982 /* Since we have no subprocesses, this does nothing. */
6983 #endif /* subprocesses */
6986 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
,
6987 Swaiting_for_user_input_p
, 0, 0, 0,
6988 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
6989 This is intended for use by asynchronous process output filters and sentinels. */)
6993 return (waiting_for_user_input_p
? Qt
: Qnil
);
6999 /* Stop reading input from keyboard sources. */
7002 hold_keyboard_input (void)
7007 /* Resume reading input from keyboard sources. */
7010 unhold_keyboard_input (void)
7015 /* Return non-zero if keyboard input is on hold, zero otherwise. */
7018 kbd_on_hold_p (void)
7020 return kbd_is_on_hold
;
7024 /* Enumeration of and access to system processes a-la ps(1). */
7026 DEFUN ("list-system-processes", Flist_system_processes
, Slist_system_processes
,
7028 doc
: /* Return a list of numerical process IDs of all running processes.
7029 If this functionality is unsupported, return nil.
7031 See `process-attributes' for getting attributes of a process given its ID. */)
7034 return list_system_processes ();
7037 DEFUN ("process-attributes", Fprocess_attributes
,
7038 Sprocess_attributes
, 1, 1, 0,
7039 doc
: /* Return attributes of the process given by its PID, a number.
7041 Value is an alist where each element is a cons cell of the form
7045 If this functionality is unsupported, the value is nil.
7047 See `list-system-processes' for getting a list of all process IDs.
7049 The KEYs of the attributes that this function may return are listed
7050 below, together with the type of the associated VALUE (in parentheses).
7051 Not all platforms support all of these attributes; unsupported
7052 attributes will not appear in the returned alist.
7053 Unless explicitly indicated otherwise, numbers can have either
7054 integer or floating point values.
7056 euid -- Effective user User ID of the process (number)
7057 user -- User name corresponding to euid (string)
7058 egid -- Effective user Group ID of the process (number)
7059 group -- Group name corresponding to egid (string)
7060 comm -- Command name (executable name only) (string)
7061 state -- Process state code, such as "S", "R", or "T" (string)
7062 ppid -- Parent process ID (number)
7063 pgrp -- Process group ID (number)
7064 sess -- Session ID, i.e. process ID of session leader (number)
7065 ttname -- Controlling tty name (string)
7066 tpgid -- ID of foreground process group on the process's tty (number)
7067 minflt -- number of minor page faults (number)
7068 majflt -- number of major page faults (number)
7069 cminflt -- cumulative number of minor page faults (number)
7070 cmajflt -- cumulative number of major page faults (number)
7071 utime -- user time used by the process, in the (HIGH LOW USEC) format
7072 stime -- system time used by the process, in the (HIGH LOW USEC) format
7073 time -- sum of utime and stime, in the (HIGH LOW USEC) format
7074 cutime -- user time used by the process and its children, (HIGH LOW USEC)
7075 cstime -- system time used by the process and its children, (HIGH LOW USEC)
7076 ctime -- sum of cutime and cstime, in the (HIGH LOW USEC) format
7077 pri -- priority of the process (number)
7078 nice -- nice value of the process (number)
7079 thcount -- process thread count (number)
7080 start -- time the process started, in the (HIGH LOW USEC) format
7081 vsize -- virtual memory size of the process in KB's (number)
7082 rss -- resident set size of the process in KB's (number)
7083 etime -- elapsed time the process is running, in (HIGH LOW USEC) format
7084 pcpu -- percents of CPU time used by the process (floating-point number)
7085 pmem -- percents of total physical memory used by process's resident set
7086 (floating-point number)
7087 args -- command line which invoked the process (string). */)
7090 return system_process_attributes (pid
);
7100 inhibit_sentinels
= 0;
7104 if (! noninteractive
|| initialized
)
7106 signal (SIGCHLD
, sigchld_handler
);
7109 FD_ZERO (&input_wait_mask
);
7110 FD_ZERO (&non_keyboard_wait_mask
);
7111 FD_ZERO (&non_process_wait_mask
);
7112 FD_ZERO (&write_mask
);
7113 max_process_desc
= 0;
7114 memset (fd_callback_info
, 0, sizeof (fd_callback_info
));
7116 #ifdef NON_BLOCKING_CONNECT
7117 FD_ZERO (&connect_wait_mask
);
7118 num_pending_connects
= 0;
7121 #ifdef ADAPTIVE_READ_BUFFERING
7122 process_output_delay_count
= 0;
7123 process_output_skip
= 0;
7126 /* Don't do this, it caused infinite select loops. The display
7127 method should call add_keyboard_wait_descriptor on stdin if it
7130 FD_SET (0, &input_wait_mask
);
7133 Vprocess_alist
= Qnil
;
7135 deleted_pid_list
= Qnil
;
7137 for (i
= 0; i
< MAXDESC
; i
++)
7139 chan_process
[i
] = Qnil
;
7140 proc_buffered_char
[i
] = -1;
7142 memset (proc_decode_coding_system
, 0, sizeof proc_decode_coding_system
);
7143 memset (proc_encode_coding_system
, 0, sizeof proc_encode_coding_system
);
7144 #ifdef DATAGRAM_SOCKETS
7145 memset (datagram_address
, 0, sizeof datagram_address
);
7149 Lisp_Object subfeatures
= Qnil
;
7150 const struct socket_options
*sopt
;
7152 #define ADD_SUBFEATURE(key, val) \
7153 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
7155 #ifdef NON_BLOCKING_CONNECT
7156 ADD_SUBFEATURE (QCnowait
, Qt
);
7158 #ifdef DATAGRAM_SOCKETS
7159 ADD_SUBFEATURE (QCtype
, Qdatagram
);
7161 #ifdef HAVE_SEQPACKET
7162 ADD_SUBFEATURE (QCtype
, Qseqpacket
);
7164 #ifdef HAVE_LOCAL_SOCKETS
7165 ADD_SUBFEATURE (QCfamily
, Qlocal
);
7167 ADD_SUBFEATURE (QCfamily
, Qipv4
);
7169 ADD_SUBFEATURE (QCfamily
, Qipv6
);
7171 #ifdef HAVE_GETSOCKNAME
7172 ADD_SUBFEATURE (QCservice
, Qt
);
7174 #if defined(O_NONBLOCK) || defined(O_NDELAY)
7175 ADD_SUBFEATURE (QCserver
, Qt
);
7178 for (sopt
= socket_options
; sopt
->name
; sopt
++)
7179 subfeatures
= pure_cons (intern_c_string (sopt
->name
), subfeatures
);
7181 Fprovide (intern_c_string ("make-network-process"), subfeatures
);
7184 #if defined (DARWIN_OS)
7185 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7186 processes. As such, we only change the default value. */
7189 char const *release
= (STRINGP (Voperating_system_release
)
7190 ? SSDATA (Voperating_system_release
)
7192 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
7193 && release
[1] == '.')) {
7194 Vprocess_connection_type
= Qnil
;
7198 #endif /* subprocesses */
7203 syms_of_process (void)
7207 Qprocessp
= intern_c_string ("processp");
7208 staticpro (&Qprocessp
);
7209 Qrun
= intern_c_string ("run");
7211 Qstop
= intern_c_string ("stop");
7213 Qsignal
= intern_c_string ("signal");
7214 staticpro (&Qsignal
);
7216 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7219 Qexit = intern_c_string ("exit");
7220 staticpro (&Qexit); */
7222 Qopen
= intern_c_string ("open");
7224 Qclosed
= intern_c_string ("closed");
7225 staticpro (&Qclosed
);
7226 Qconnect
= intern_c_string ("connect");
7227 staticpro (&Qconnect
);
7228 Qfailed
= intern_c_string ("failed");
7229 staticpro (&Qfailed
);
7230 Qlisten
= intern_c_string ("listen");
7231 staticpro (&Qlisten
);
7232 Qlocal
= intern_c_string ("local");
7233 staticpro (&Qlocal
);
7234 Qipv4
= intern_c_string ("ipv4");
7237 Qipv6
= intern_c_string ("ipv6");
7240 Qdatagram
= intern_c_string ("datagram");
7241 staticpro (&Qdatagram
);
7242 Qseqpacket
= intern_c_string ("seqpacket");
7243 staticpro (&Qseqpacket
);
7245 QCport
= intern_c_string (":port");
7246 staticpro (&QCport
);
7247 QCspeed
= intern_c_string (":speed");
7248 staticpro (&QCspeed
);
7249 QCprocess
= intern_c_string (":process");
7250 staticpro (&QCprocess
);
7252 QCbytesize
= intern_c_string (":bytesize");
7253 staticpro (&QCbytesize
);
7254 QCstopbits
= intern_c_string (":stopbits");
7255 staticpro (&QCstopbits
);
7256 QCparity
= intern_c_string (":parity");
7257 staticpro (&QCparity
);
7258 Qodd
= intern_c_string ("odd");
7260 Qeven
= intern_c_string ("even");
7262 QCflowcontrol
= intern_c_string (":flowcontrol");
7263 staticpro (&QCflowcontrol
);
7264 Qhw
= intern_c_string ("hw");
7266 Qsw
= intern_c_string ("sw");
7268 QCsummary
= intern_c_string (":summary");
7269 staticpro (&QCsummary
);
7271 Qreal
= intern_c_string ("real");
7273 Qnetwork
= intern_c_string ("network");
7274 staticpro (&Qnetwork
);
7275 Qserial
= intern_c_string ("serial");
7276 staticpro (&Qserial
);
7277 QCbuffer
= intern_c_string (":buffer");
7278 staticpro (&QCbuffer
);
7279 QChost
= intern_c_string (":host");
7280 staticpro (&QChost
);
7281 QCservice
= intern_c_string (":service");
7282 staticpro (&QCservice
);
7283 QClocal
= intern_c_string (":local");
7284 staticpro (&QClocal
);
7285 QCremote
= intern_c_string (":remote");
7286 staticpro (&QCremote
);
7287 QCcoding
= intern_c_string (":coding");
7288 staticpro (&QCcoding
);
7289 QCserver
= intern_c_string (":server");
7290 staticpro (&QCserver
);
7291 QCnowait
= intern_c_string (":nowait");
7292 staticpro (&QCnowait
);
7293 QCsentinel
= intern_c_string (":sentinel");
7294 staticpro (&QCsentinel
);
7295 QClog
= intern_c_string (":log");
7297 QCnoquery
= intern_c_string (":noquery");
7298 staticpro (&QCnoquery
);
7299 QCstop
= intern_c_string (":stop");
7300 staticpro (&QCstop
);
7301 QCoptions
= intern_c_string (":options");
7302 staticpro (&QCoptions
);
7303 QCplist
= intern_c_string (":plist");
7304 staticpro (&QCplist
);
7306 Qlast_nonmenu_event
= intern_c_string ("last-nonmenu-event");
7307 staticpro (&Qlast_nonmenu_event
);
7309 staticpro (&Vprocess_alist
);
7311 staticpro (&deleted_pid_list
);
7314 #endif /* subprocesses */
7316 QCname
= intern_c_string (":name");
7317 staticpro (&QCname
);
7318 QCtype
= intern_c_string (":type");
7319 staticpro (&QCtype
);
7321 Qeuid
= intern_c_string ("euid");
7323 Qegid
= intern_c_string ("egid");
7325 Quser
= intern_c_string ("user");
7327 Qgroup
= intern_c_string ("group");
7328 staticpro (&Qgroup
);
7329 Qcomm
= intern_c_string ("comm");
7331 Qstate
= intern_c_string ("state");
7332 staticpro (&Qstate
);
7333 Qppid
= intern_c_string ("ppid");
7335 Qpgrp
= intern_c_string ("pgrp");
7337 Qsess
= intern_c_string ("sess");
7339 Qttname
= intern_c_string ("ttname");
7340 staticpro (&Qttname
);
7341 Qtpgid
= intern_c_string ("tpgid");
7342 staticpro (&Qtpgid
);
7343 Qminflt
= intern_c_string ("minflt");
7344 staticpro (&Qminflt
);
7345 Qmajflt
= intern_c_string ("majflt");
7346 staticpro (&Qmajflt
);
7347 Qcminflt
= intern_c_string ("cminflt");
7348 staticpro (&Qcminflt
);
7349 Qcmajflt
= intern_c_string ("cmajflt");
7350 staticpro (&Qcmajflt
);
7351 Qutime
= intern_c_string ("utime");
7352 staticpro (&Qutime
);
7353 Qstime
= intern_c_string ("stime");
7354 staticpro (&Qstime
);
7355 Qtime
= intern_c_string ("time");
7357 Qcutime
= intern_c_string ("cutime");
7358 staticpro (&Qcutime
);
7359 Qcstime
= intern_c_string ("cstime");
7360 staticpro (&Qcstime
);
7361 Qctime
= intern_c_string ("ctime");
7362 staticpro (&Qctime
);
7363 Qpri
= intern_c_string ("pri");
7365 Qnice
= intern_c_string ("nice");
7367 Qthcount
= intern_c_string ("thcount");
7368 staticpro (&Qthcount
);
7369 Qstart
= intern_c_string ("start");
7370 staticpro (&Qstart
);
7371 Qvsize
= intern_c_string ("vsize");
7372 staticpro (&Qvsize
);
7373 Qrss
= intern_c_string ("rss");
7375 Qetime
= intern_c_string ("etime");
7376 staticpro (&Qetime
);
7377 Qpcpu
= intern_c_string ("pcpu");
7379 Qpmem
= intern_c_string ("pmem");
7381 Qargs
= intern_c_string ("args");
7384 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes
,
7385 doc
: /* *Non-nil means delete processes immediately when they exit.
7386 A value of nil means don't delete them until `list-processes' is run. */);
7388 delete_exited_processes
= 1;
7391 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type
,
7392 doc
: /* Control type of device used to communicate with subprocesses.
7393 Values are nil to use a pipe, or t or `pty' to use a pty.
7394 The value has no effect if the system has no ptys or if all ptys are busy:
7395 then a pipe is used in any case.
7396 The value takes effect when `start-process' is called. */);
7397 Vprocess_connection_type
= Qt
;
7399 #ifdef ADAPTIVE_READ_BUFFERING
7400 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering
,
7401 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7402 On some systems, when Emacs reads the output from a subprocess, the output data
7403 is read in very small blocks, potentially resulting in very poor performance.
7404 This behavior can be remedied to some extent by setting this variable to a
7405 non-nil value, as it will automatically delay reading from such processes, to
7406 allow them to produce more output before Emacs tries to read it.
7407 If the value is t, the delay is reset after each write to the process; any other
7408 non-nil value means that the delay is not reset on write.
7409 The variable takes effect when `start-process' is called. */);
7410 Vprocess_adaptive_read_buffering
= Qt
;
7413 defsubr (&Sprocessp
);
7414 defsubr (&Sget_process
);
7415 defsubr (&Sdelete_process
);
7416 defsubr (&Sprocess_status
);
7417 defsubr (&Sprocess_exit_status
);
7418 defsubr (&Sprocess_id
);
7419 defsubr (&Sprocess_name
);
7420 defsubr (&Sprocess_tty_name
);
7421 defsubr (&Sprocess_command
);
7422 defsubr (&Sset_process_buffer
);
7423 defsubr (&Sprocess_buffer
);
7424 defsubr (&Sprocess_mark
);
7425 defsubr (&Sset_process_filter
);
7426 defsubr (&Sprocess_filter
);
7427 defsubr (&Sset_process_sentinel
);
7428 defsubr (&Sprocess_sentinel
);
7429 defsubr (&Sset_process_window_size
);
7430 defsubr (&Sset_process_inherit_coding_system_flag
);
7431 defsubr (&Sset_process_query_on_exit_flag
);
7432 defsubr (&Sprocess_query_on_exit_flag
);
7433 defsubr (&Sprocess_contact
);
7434 defsubr (&Sprocess_plist
);
7435 defsubr (&Sset_process_plist
);
7436 defsubr (&Sprocess_list
);
7437 defsubr (&Sstart_process
);
7438 defsubr (&Sserial_process_configure
);
7439 defsubr (&Smake_serial_process
);
7440 defsubr (&Sset_network_process_option
);
7441 defsubr (&Smake_network_process
);
7442 defsubr (&Sformat_network_address
);
7443 #if defined(HAVE_NET_IF_H)
7445 defsubr (&Snetwork_interface_list
);
7447 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7448 defsubr (&Snetwork_interface_info
);
7450 #endif /* defined(HAVE_NET_IF_H) */
7451 #ifdef DATAGRAM_SOCKETS
7452 defsubr (&Sprocess_datagram_address
);
7453 defsubr (&Sset_process_datagram_address
);
7455 defsubr (&Saccept_process_output
);
7456 defsubr (&Sprocess_send_region
);
7457 defsubr (&Sprocess_send_string
);
7458 defsubr (&Sinterrupt_process
);
7459 defsubr (&Skill_process
);
7460 defsubr (&Squit_process
);
7461 defsubr (&Sstop_process
);
7462 defsubr (&Scontinue_process
);
7463 defsubr (&Sprocess_running_child_p
);
7464 defsubr (&Sprocess_send_eof
);
7465 defsubr (&Ssignal_process
);
7466 defsubr (&Swaiting_for_user_input_p
);
7467 defsubr (&Sprocess_type
);
7468 defsubr (&Sset_process_coding_system
);
7469 defsubr (&Sprocess_coding_system
);
7470 defsubr (&Sset_process_filter_multibyte
);
7471 defsubr (&Sprocess_filter_multibyte_p
);
7473 #endif /* subprocesses */
7475 defsubr (&Sget_buffer_process
);
7476 defsubr (&Sprocess_inherit_coding_system_flag
);
7477 defsubr (&Slist_system_processes
);
7478 defsubr (&Sprocess_attributes
);