1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
3 1996, 1998, 1999, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009, 2010 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
41 /* Only MS-DOS does not define `subprocesses'. */
44 #include <sys/socket.h>
46 #include <netinet/in.h>
47 #include <arpa/inet.h>
49 /* Are local (unix) sockets supported? */
50 #if defined (HAVE_SYS_UN_H)
51 #if !defined (AF_LOCAL) && defined (AF_UNIX)
52 #define AF_LOCAL AF_UNIX
55 #define HAVE_LOCAL_SOCKETS
60 #if defined(HAVE_SYS_IOCTL_H)
61 #include <sys/ioctl.h>
62 #if defined(HAVE_NET_IF_H)
64 #endif /* HAVE_NET_IF_H */
65 #endif /* HAVE_SYS_IOCTL_H */
76 #include <netinet/in.h>
77 #include <arpa/nameser.h>
89 #endif /* subprocesses */
97 #include "character.h"
101 #include "termhooks.h"
102 #include "termopts.h"
103 #include "commands.h"
104 #include "keyboard.h"
105 #include "blockinput.h"
106 #include "dispextern.h"
107 #include "composite.h"
109 #include "sysselect.h"
110 #include "syssignal.h"
116 #if defined (USE_GTK) || defined (HAVE_GCONF)
117 #include "xgselect.h"
118 #endif /* defined (USE_GTK) || defined (HAVE_GCONF) */
122 extern int timers_run
;
124 Lisp_Object Qeuid
, Qegid
, Qcomm
, Qstate
, Qppid
, Qpgrp
, Qsess
, Qttname
, Qtpgid
;
125 Lisp_Object Qminflt
, Qmajflt
, Qcminflt
, Qcmajflt
, Qutime
, Qstime
, Qcstime
;
126 Lisp_Object Qcutime
, Qpri
, Qnice
, Qthcount
, Qstart
, Qvsize
, Qrss
, Qargs
;
127 Lisp_Object Quser
, Qgroup
, Qetime
, Qpcpu
, Qpmem
, Qtime
, Qctime
;
128 Lisp_Object QCname
, QCtype
;
130 /* Non-zero if keyboard input is on hold, zero otherwise. */
132 static int kbd_is_on_hold
;
134 /* Nonzero means delete a process right away if it exits. */
135 static int delete_exited_processes
;
137 /* Nonzero means don't run process sentinels. This is used
139 int inhibit_sentinels
;
143 Lisp_Object Qprocessp
;
144 Lisp_Object Qrun
, Qstop
, Qsignal
;
145 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
146 Lisp_Object Qlocal
, Qipv4
, Qdatagram
, Qseqpacket
;
147 Lisp_Object Qreal
, Qnetwork
, Qserial
;
151 Lisp_Object QCport
, QCspeed
, QCprocess
;
152 Lisp_Object QCbytesize
, QCstopbits
, QCparity
, Qodd
, Qeven
;
153 Lisp_Object QCflowcontrol
, Qhw
, Qsw
, QCsummary
;
154 Lisp_Object QCbuffer
, QChost
, QCservice
;
155 Lisp_Object QClocal
, QCremote
, QCcoding
;
156 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
157 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
158 Lisp_Object Qlast_nonmenu_event
;
159 /* QCfamily is declared and initialized in xfaces.c,
160 QCfilter in keyboard.c. */
161 extern Lisp_Object QCfamily
, QCfilter
;
163 /* Qexit is declared and initialized in eval.c. */
165 /* QCfamily is defined in xfaces.c. */
166 extern Lisp_Object QCfamily
;
167 /* QCfilter is defined in keyboard.c. */
168 extern Lisp_Object QCfilter
;
170 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
171 #define NETCONN1_P(p) (EQ ((p)->type, Qnetwork))
172 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
173 #define SERIALCONN1_P(p) (EQ ((p)->type, Qserial))
175 /* Define first descriptor number available for subprocesses. */
176 #define FIRST_PROC_DESC 3
178 extern const char *get_operating_system_release (void);
180 /* From sysdep.c or w32.c */
181 extern int serial_open (char *port
);
182 extern void serial_configure (struct Lisp_Process
*p
, Lisp_Object contact
);
188 /* t means use pty, nil means use a pipe,
189 maybe other values to come. */
190 static Lisp_Object Vprocess_connection_type
;
192 /* These next two vars are non-static since sysdep.c uses them in the
193 emulation of `select'. */
194 /* Number of events of change of status of a process. */
196 /* Number of events for which the user or sentinel has been notified. */
199 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
201 /* Only W32 has this, it really means that select can't take write mask. */
202 #ifdef BROKEN_NON_BLOCKING_CONNECT
203 #undef NON_BLOCKING_CONNECT
204 #define SELECT_CANT_DO_WRITE_MASK
206 #ifndef NON_BLOCKING_CONNECT
208 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
209 #if defined (O_NONBLOCK) || defined (O_NDELAY)
210 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
211 #define NON_BLOCKING_CONNECT
212 #endif /* EWOULDBLOCK || EINPROGRESS */
213 #endif /* O_NONBLOCK || O_NDELAY */
214 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
215 #endif /* HAVE_SELECT */
216 #endif /* NON_BLOCKING_CONNECT */
217 #endif /* BROKEN_NON_BLOCKING_CONNECT */
219 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
220 this system. We need to read full packets, so we need a
221 "non-destructive" select. So we require either native select,
222 or emulation of select using FIONREAD. */
224 #ifdef BROKEN_DATAGRAM_SOCKETS
225 #undef DATAGRAM_SOCKETS
227 #ifndef DATAGRAM_SOCKETS
228 #if defined (HAVE_SELECT) || defined (FIONREAD)
229 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
230 #define DATAGRAM_SOCKETS
231 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
232 #endif /* HAVE_SELECT || FIONREAD */
233 #endif /* DATAGRAM_SOCKETS */
234 #endif /* BROKEN_DATAGRAM_SOCKETS */
236 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
237 # define HAVE_SEQPACKET
240 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
241 #ifdef EMACS_HAS_USECS
242 #define ADAPTIVE_READ_BUFFERING
246 #ifdef ADAPTIVE_READ_BUFFERING
247 #define READ_OUTPUT_DELAY_INCREMENT 10000
248 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
249 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
251 /* Number of processes which have a non-zero read_output_delay,
252 and therefore might be delayed for adaptive read buffering. */
254 static int process_output_delay_count
;
256 /* Non-zero if any process has non-nil read_output_skip. */
258 static int process_output_skip
;
260 /* Non-nil means to delay reading process output to improve buffering.
261 A value of t means that delay is reset after each send, any other
262 non-nil value does not reset the delay. A value of nil disables
263 adaptive read buffering completely. */
264 static Lisp_Object Vprocess_adaptive_read_buffering
;
266 #define process_output_delay_count 0
269 static int keyboard_bit_set (SELECT_TYPE
*);
270 static void deactivate_process (Lisp_Object
);
271 static void status_notify (struct Lisp_Process
*);
272 static int read_process_output (Lisp_Object
, int);
273 static void create_pty (Lisp_Object
);
275 /* If we support a window system, turn on the code to poll periodically
276 to detect C-g. It isn't actually used when doing interrupt input. */
277 #ifdef HAVE_WINDOW_SYSTEM
278 #define POLL_FOR_INPUT
281 static Lisp_Object
get_process (register Lisp_Object name
);
282 static void exec_sentinel (Lisp_Object proc
, Lisp_Object reason
);
284 /* Mask of bits indicating the descriptors that we wait for input on. */
286 static SELECT_TYPE input_wait_mask
;
288 /* Mask that excludes keyboard input descriptor(s). */
290 static SELECT_TYPE non_keyboard_wait_mask
;
292 /* Mask that excludes process input descriptor(s). */
294 static SELECT_TYPE non_process_wait_mask
;
296 /* Mask for selecting for write. */
298 static SELECT_TYPE write_mask
;
300 #ifdef NON_BLOCKING_CONNECT
301 /* Mask of bits indicating the descriptors that we wait for connect to
302 complete on. Once they complete, they are removed from this mask
303 and added to the input_wait_mask and non_keyboard_wait_mask. */
305 static SELECT_TYPE connect_wait_mask
;
307 /* Number of bits set in connect_wait_mask. */
308 static int num_pending_connects
;
310 #define IF_NON_BLOCKING_CONNECT(s) s
311 #else /* NON_BLOCKING_CONNECT */
312 #define IF_NON_BLOCKING_CONNECT(s)
313 #endif /* NON_BLOCKING_CONNECT */
315 /* The largest descriptor currently in use for a process object. */
316 static int max_process_desc
;
318 /* The largest descriptor currently in use for input. */
319 static int max_input_desc
;
321 /* Indexed by descriptor, gives the process (if any) for that descriptor */
322 Lisp_Object chan_process
[MAXDESC
];
324 /* Alist of elements (NAME . PROCESS) */
325 Lisp_Object Vprocess_alist
;
327 /* Buffered-ahead input char from process, indexed by channel.
328 -1 means empty (no char is buffered).
329 Used on sys V where the only way to tell if there is any
330 output from the process is to read at least one char.
331 Always -1 on systems that support FIONREAD. */
333 /* Don't make static; need to access externally. */
334 int proc_buffered_char
[MAXDESC
];
336 /* Table of `struct coding-system' for each process. */
337 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
338 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
340 #ifdef DATAGRAM_SOCKETS
341 /* Table of `partner address' for datagram sockets. */
342 struct sockaddr_and_len
{
345 } datagram_address
[MAXDESC
];
346 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
347 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
349 #define DATAGRAM_CHAN_P(chan) (0)
350 #define DATAGRAM_CONN_P(proc) (0)
353 /* Maximum number of bytes to send to a pty without an eof. */
354 static int pty_max_bytes
;
358 struct fd_callback_data
364 int condition
; /* mask of the defines above. */
365 } fd_callback_info
[MAXDESC
];
368 /* Add a file descriptor FD to be monitored for when read is possible.
369 When read is possible, call FUNC with argument DATA. */
372 add_read_fd (int fd
, fd_callback func
, void *data
)
374 xassert (fd
< MAXDESC
);
375 add_keyboard_wait_descriptor (fd
);
377 fd_callback_info
[fd
].func
= func
;
378 fd_callback_info
[fd
].data
= data
;
379 fd_callback_info
[fd
].condition
|= FOR_READ
;
382 /* Stop monitoring file descriptor FD for when read is possible. */
385 delete_read_fd (int fd
)
387 xassert (fd
< MAXDESC
);
388 delete_keyboard_wait_descriptor (fd
);
390 fd_callback_info
[fd
].condition
&= ~FOR_READ
;
391 if (fd_callback_info
[fd
].condition
== 0)
393 fd_callback_info
[fd
].func
= 0;
394 fd_callback_info
[fd
].data
= 0;
398 /* Add a file descriptor FD to be monitored for when write is possible.
399 When write is possible, call FUNC with argument DATA. */
402 add_write_fd (int fd
, fd_callback func
, void *data
)
404 xassert (fd
< MAXDESC
);
405 FD_SET (fd
, &write_mask
);
406 if (fd
> max_input_desc
)
409 fd_callback_info
[fd
].func
= func
;
410 fd_callback_info
[fd
].data
= data
;
411 fd_callback_info
[fd
].condition
|= FOR_WRITE
;
414 /* Stop monitoring file descriptor FD for when write is possible. */
417 delete_write_fd (int fd
)
419 int lim
= max_input_desc
;
421 xassert (fd
< MAXDESC
);
422 FD_CLR (fd
, &write_mask
);
423 fd_callback_info
[fd
].condition
&= ~FOR_WRITE
;
424 if (fd_callback_info
[fd
].condition
== 0)
426 fd_callback_info
[fd
].func
= 0;
427 fd_callback_info
[fd
].data
= 0;
429 if (fd
== max_input_desc
)
430 for (fd
= lim
; fd
>= 0; fd
--)
431 if (FD_ISSET (fd
, &input_wait_mask
) || FD_ISSET (fd
, &write_mask
))
441 /* Compute the Lisp form of the process status, p->status, from
442 the numeric status that was returned by `wait'. */
444 static Lisp_Object
status_convert (int);
447 update_status (struct Lisp_Process
*p
)
449 eassert (p
->raw_status_new
);
450 p
->status
= status_convert (p
->raw_status
);
451 p
->raw_status_new
= 0;
454 /* Convert a process status word in Unix format to
455 the list that we use internally. */
458 status_convert (int w
)
461 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
462 else if (WIFEXITED (w
))
463 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
464 WCOREDUMP (w
) ? Qt
: Qnil
));
465 else if (WIFSIGNALED (w
))
466 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
467 WCOREDUMP (w
) ? Qt
: Qnil
));
472 /* Given a status-list, extract the three pieces of information
473 and store them individually through the three pointers. */
476 decode_status (Lisp_Object l
, Lisp_Object
*symbol
, int *code
, int *coredump
)
490 *code
= XFASTINT (XCAR (tem
));
492 *coredump
= !NILP (tem
);
496 /* Return a string describing a process status list. */
499 status_message (struct Lisp_Process
*p
)
501 Lisp_Object status
= p
->status
;
504 Lisp_Object string
, string2
;
506 decode_status (status
, &symbol
, &code
, &coredump
);
508 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
511 synchronize_system_messages_locale ();
512 signame
= strsignal (code
);
514 string
= build_string ("unknown");
519 string
= make_unibyte_string (signame
, strlen (signame
));
520 if (! NILP (Vlocale_coding_system
))
521 string
= (code_convert_string_norecord
522 (string
, Vlocale_coding_system
, 0));
523 c1
= STRING_CHAR ((char *) SDATA (string
));
526 Faset (string
, make_number (0), make_number (c2
));
528 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
529 return concat2 (string
, string2
);
531 else if (EQ (symbol
, Qexit
))
534 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
536 return build_string ("finished\n");
537 string
= Fnumber_to_string (make_number (code
));
538 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
539 return concat3 (build_string ("exited abnormally with code "),
542 else if (EQ (symbol
, Qfailed
))
544 string
= Fnumber_to_string (make_number (code
));
545 string2
= build_string ("\n");
546 return concat3 (build_string ("failed with code "),
550 return Fcopy_sequence (Fsymbol_name (symbol
));
555 /* The file name of the pty opened by allocate_pty. */
556 static char pty_name
[24];
558 /* Open an available pty, returning a file descriptor.
559 Return -1 on failure.
560 The file name of the terminal corresponding to the pty
561 is left in the variable pty_name. */
572 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
573 for (i
= 0; i
< 16; i
++)
576 struct stat stb
; /* Used in some PTY_OPEN. */
577 #ifdef PTY_NAME_SPRINTF
580 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
581 #endif /* no PTY_NAME_SPRINTF */
585 #else /* no PTY_OPEN */
587 { /* Some systems name their pseudoterminals so that there are gaps in
588 the usual sequence - for example, on HP9000/S700 systems, there
589 are no pseudoterminals with names ending in 'f'. So we wait for
590 three failures in a row before deciding that we've reached the
592 int failed_count
= 0;
594 if (stat (pty_name
, &stb
) < 0)
597 if (failed_count
>= 3)
604 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
606 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
609 #endif /* no PTY_OPEN */
613 /* check to make certain that both sides are available
614 this avoids a nasty yet stupid bug in rlogins */
615 #ifdef PTY_TTY_NAME_SPRINTF
618 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
619 #endif /* no PTY_TTY_NAME_SPRINTF */
620 if (access (pty_name
, 6) != 0)
635 #endif /* HAVE_PTYS */
638 make_process (Lisp_Object name
)
640 register Lisp_Object val
, tem
, name1
;
641 register struct Lisp_Process
*p
;
645 p
= allocate_process ();
653 p
->raw_status_new
= 0;
655 p
->mark
= Fmake_marker ();
656 p
->kill_without_query
= 0;
658 #ifdef ADAPTIVE_READ_BUFFERING
659 p
->adaptive_read_buffering
= 0;
660 p
->read_output_delay
= 0;
661 p
->read_output_skip
= 0;
665 p
->gnutls_initstage
= GNUTLS_STAGE_EMPTY
;
666 p
->gnutls_log_level
= 0;
670 /* If name is already in use, modify it until it is unused. */
675 tem
= Fget_process (name1
);
676 if (NILP (tem
)) break;
677 sprintf (suffix
, "<%d>", i
);
678 name1
= concat2 (name
, build_string (suffix
));
682 XSETPROCESS (val
, p
);
683 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
688 remove_process (register Lisp_Object proc
)
690 register Lisp_Object pair
;
692 pair
= Frassq (proc
, Vprocess_alist
);
693 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
695 deactivate_process (proc
);
699 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
700 doc
: /* Return t if OBJECT is a process. */)
703 return PROCESSP (object
) ? Qt
: Qnil
;
706 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
707 doc
: /* Return the process named NAME, or nil if there is none. */)
708 (register Lisp_Object name
)
713 return Fcdr (Fassoc (name
, Vprocess_alist
));
716 /* This is how commands for the user decode process arguments. It
717 accepts a process, a process name, a buffer, a buffer name, or nil.
718 Buffers denote the first process in the buffer, and nil denotes the
722 get_process (register Lisp_Object name
)
724 register Lisp_Object proc
, obj
;
727 obj
= Fget_process (name
);
729 obj
= Fget_buffer (name
);
731 error ("Process %s does not exist", SDATA (name
));
733 else if (NILP (name
))
734 obj
= Fcurrent_buffer ();
738 /* Now obj should be either a buffer object or a process object.
742 proc
= Fget_buffer_process (obj
);
744 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
756 /* Fdelete_process promises to immediately forget about the process, but in
757 reality, Emacs needs to remember those processes until they have been
758 treated by sigchld_handler; otherwise this handler would consider the
759 process as being synchronous and say that the synchronous process is
761 static Lisp_Object deleted_pid_list
;
764 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
765 doc
: /* Delete PROCESS: kill it and forget about it immediately.
766 PROCESS may be a process, a buffer, the name of a process or buffer, or
767 nil, indicating the current buffer's process. */)
768 (register Lisp_Object process
)
770 register struct Lisp_Process
*p
;
772 process
= get_process (process
);
773 p
= XPROCESS (process
);
775 p
->raw_status_new
= 0;
776 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
778 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
779 p
->tick
= ++process_tick
;
781 redisplay_preserve_echo_area (13);
783 else if (p
->infd
>= 0)
787 /* Assignment to EMACS_INT stops GCC whining about limited range
789 EMACS_INT pid
= p
->pid
;
791 /* No problem storing the pid here, as it is still in Vprocess_alist. */
792 deleted_pid_list
= Fcons (make_fixnum_or_float (pid
),
793 /* GC treated elements set to nil. */
794 Fdelq (Qnil
, deleted_pid_list
));
795 /* If the process has already signaled, remove it from the list. */
796 if (p
->raw_status_new
)
799 if (CONSP (p
->status
))
800 symbol
= XCAR (p
->status
);
801 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
803 = Fdelete (make_fixnum_or_float (pid
), deleted_pid_list
);
807 Fkill_process (process
, Qnil
);
808 /* Do this now, since remove_process will make sigchld_handler do nothing. */
810 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
811 p
->tick
= ++process_tick
;
813 redisplay_preserve_echo_area (13);
816 remove_process (process
);
820 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
821 doc
: /* Return the status of PROCESS.
822 The returned value is one of the following symbols:
823 run -- for a process that is running.
824 stop -- for a process stopped but continuable.
825 exit -- for a process that has exited.
826 signal -- for a process that has got a fatal signal.
827 open -- for a network stream connection that is open.
828 listen -- for a network stream server that is listening.
829 closed -- for a network stream connection that is closed.
830 connect -- when waiting for a non-blocking connection to complete.
831 failed -- when a non-blocking connection has failed.
832 nil -- if arg is a process name and no such process exists.
833 PROCESS may be a process, a buffer, the name of a process, or
834 nil, indicating the current buffer's process. */)
835 (register Lisp_Object process
)
837 register struct Lisp_Process
*p
;
838 register Lisp_Object status
;
840 if (STRINGP (process
))
841 process
= Fget_process (process
);
843 process
= get_process (process
);
848 p
= XPROCESS (process
);
849 if (p
->raw_status_new
)
853 status
= XCAR (status
);
854 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
856 if (EQ (status
, Qexit
))
858 else if (EQ (p
->command
, Qt
))
860 else if (EQ (status
, Qrun
))
866 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
868 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
869 If PROCESS has not yet exited or died, return 0. */)
870 (register Lisp_Object process
)
872 CHECK_PROCESS (process
);
873 if (XPROCESS (process
)->raw_status_new
)
874 update_status (XPROCESS (process
));
875 if (CONSP (XPROCESS (process
)->status
))
876 return XCAR (XCDR (XPROCESS (process
)->status
));
877 return make_number (0);
880 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
881 doc
: /* Return the process id of PROCESS.
882 This is the pid of the external process which PROCESS uses or talks to.
883 For a network connection, this value is nil. */)
884 (register Lisp_Object process
)
886 /* Assignment to EMACS_INT stops GCC whining about limited range of
890 CHECK_PROCESS (process
);
891 pid
= XPROCESS (process
)->pid
;
892 return (pid
? make_fixnum_or_float (pid
) : Qnil
);
895 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
896 doc
: /* Return the name of PROCESS, as a string.
897 This is the name of the program invoked in PROCESS,
898 possibly modified to make it unique among process names. */)
899 (register Lisp_Object process
)
901 CHECK_PROCESS (process
);
902 return XPROCESS (process
)->name
;
905 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
906 doc
: /* Return the command that was executed to start PROCESS.
907 This is a list of strings, the first string being the program executed
908 and the rest of the strings being the arguments given to it.
909 For a network or serial process, this is nil (process is running) or t
910 \(process is stopped). */)
911 (register Lisp_Object process
)
913 CHECK_PROCESS (process
);
914 return XPROCESS (process
)->command
;
917 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
918 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
919 This is the terminal that the process itself reads and writes on,
920 not the name of the pty that Emacs uses to talk with that terminal. */)
921 (register Lisp_Object process
)
923 CHECK_PROCESS (process
);
924 return XPROCESS (process
)->tty_name
;
927 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
929 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
930 (register Lisp_Object process
, Lisp_Object buffer
)
932 struct Lisp_Process
*p
;
934 CHECK_PROCESS (process
);
936 CHECK_BUFFER (buffer
);
937 p
= XPROCESS (process
);
939 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
940 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
941 setup_process_coding_systems (process
);
945 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
947 doc
: /* Return the buffer PROCESS is associated with.
948 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
949 (register Lisp_Object process
)
951 CHECK_PROCESS (process
);
952 return XPROCESS (process
)->buffer
;
955 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
957 doc
: /* Return the marker for the end of the last output from PROCESS. */)
958 (register Lisp_Object process
)
960 CHECK_PROCESS (process
);
961 return XPROCESS (process
)->mark
;
964 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
966 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
967 A value of t means stop accepting output from the process.
969 When a process has a filter, its buffer is not used for output.
970 Instead, each time it does output, the entire string of output is
971 passed to the filter.
973 The filter gets two arguments: the process and the string of output.
974 The string argument is normally a multibyte string, except:
975 - if the process' input coding system is no-conversion or raw-text,
976 it is a unibyte string (the non-converted input), or else
977 - if `default-enable-multibyte-characters' is nil, it is a unibyte
978 string (the result of converting the decoded input multibyte
979 string to unibyte with `string-make-unibyte'). */)
980 (register Lisp_Object process
, Lisp_Object filter
)
982 struct Lisp_Process
*p
;
984 CHECK_PROCESS (process
);
985 p
= XPROCESS (process
);
987 /* Don't signal an error if the process' input file descriptor
988 is closed. This could make debugging Lisp more difficult,
989 for example when doing something like
991 (setq process (start-process ...))
993 (set-process-filter process ...) */
997 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
999 FD_CLR (p
->infd
, &input_wait_mask
);
1000 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
1002 else if (EQ (p
->filter
, Qt
)
1003 /* Network or serial process not stopped: */
1004 && !EQ (p
->command
, Qt
))
1006 FD_SET (p
->infd
, &input_wait_mask
);
1007 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
1012 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1013 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
1014 setup_process_coding_systems (process
);
1018 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1020 doc
: /* Returns the filter function of PROCESS; nil if none.
1021 See `set-process-filter' for more info on filter functions. */)
1022 (register Lisp_Object process
)
1024 CHECK_PROCESS (process
);
1025 return XPROCESS (process
)->filter
;
1028 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1030 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1031 The sentinel is called as a function when the process changes state.
1032 It gets two arguments: the process, and a string describing the change. */)
1033 (register Lisp_Object process
, Lisp_Object sentinel
)
1035 struct Lisp_Process
*p
;
1037 CHECK_PROCESS (process
);
1038 p
= XPROCESS (process
);
1040 p
->sentinel
= sentinel
;
1041 if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1042 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1046 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1048 doc
: /* Return the sentinel of PROCESS; nil if none.
1049 See `set-process-sentinel' for more info on sentinels. */)
1050 (register Lisp_Object process
)
1052 CHECK_PROCESS (process
);
1053 return XPROCESS (process
)->sentinel
;
1056 DEFUN ("set-process-window-size", Fset_process_window_size
,
1057 Sset_process_window_size
, 3, 3, 0,
1058 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1059 (register Lisp_Object process
, Lisp_Object height
, Lisp_Object width
)
1061 CHECK_PROCESS (process
);
1062 CHECK_NATNUM (height
);
1063 CHECK_NATNUM (width
);
1065 if (XPROCESS (process
)->infd
< 0
1066 || set_window_size (XPROCESS (process
)->infd
,
1067 XINT (height
), XINT (width
)) <= 0)
1073 DEFUN ("set-process-inherit-coding-system-flag",
1074 Fset_process_inherit_coding_system_flag
,
1075 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1076 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1077 If the second argument FLAG is non-nil, then the variable
1078 `buffer-file-coding-system' of the buffer associated with PROCESS
1079 will be bound to the value of the coding system used to decode
1082 This is useful when the coding system specified for the process buffer
1083 leaves either the character code conversion or the end-of-line conversion
1084 unspecified, or if the coding system used to decode the process output
1085 is more appropriate for saving the process buffer.
1087 Binding the variable `inherit-process-coding-system' to non-nil before
1088 starting the process is an alternative way of setting the inherit flag
1089 for the process which will run. */)
1090 (register Lisp_Object process
, Lisp_Object flag
)
1092 CHECK_PROCESS (process
);
1093 XPROCESS (process
)->inherit_coding_system_flag
= !NILP (flag
);
1097 DEFUN ("set-process-query-on-exit-flag",
1098 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1100 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1101 If the second argument FLAG is non-nil, Emacs will query the user before
1102 exiting or killing a buffer if PROCESS is running. */)
1103 (register Lisp_Object process
, Lisp_Object flag
)
1105 CHECK_PROCESS (process
);
1106 XPROCESS (process
)->kill_without_query
= NILP (flag
);
1110 DEFUN ("process-query-on-exit-flag",
1111 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1113 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1114 (register Lisp_Object process
)
1116 CHECK_PROCESS (process
);
1117 return (XPROCESS (process
)->kill_without_query
? Qnil
: Qt
);
1120 #ifdef DATAGRAM_SOCKETS
1121 Lisp_Object
Fprocess_datagram_address (Lisp_Object process
);
1124 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1126 doc
: /* Return the contact info of PROCESS; t for a real child.
1127 For a network or serial connection, the value depends on the optional
1128 KEY arg. If KEY is nil, value is a cons cell of the form (HOST
1129 SERVICE) for a network connection or (PORT SPEED) for a serial
1130 connection. If KEY is t, the complete contact information for the
1131 connection is returned, else the specific value for the keyword KEY is
1132 returned. See `make-network-process' or `make-serial-process' for a
1133 list of keywords. */)
1134 (register Lisp_Object process
, Lisp_Object key
)
1136 Lisp_Object contact
;
1138 CHECK_PROCESS (process
);
1139 contact
= XPROCESS (process
)->childp
;
1141 #ifdef DATAGRAM_SOCKETS
1142 if (DATAGRAM_CONN_P (process
)
1143 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1144 contact
= Fplist_put (contact
, QCremote
,
1145 Fprocess_datagram_address (process
));
1148 if ((!NETCONN_P (process
) && !SERIALCONN_P (process
)) || EQ (key
, Qt
))
1150 if (NILP (key
) && NETCONN_P (process
))
1151 return Fcons (Fplist_get (contact
, QChost
),
1152 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1153 if (NILP (key
) && SERIALCONN_P (process
))
1154 return Fcons (Fplist_get (contact
, QCport
),
1155 Fcons (Fplist_get (contact
, QCspeed
), Qnil
));
1156 return Fplist_get (contact
, key
);
1159 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1161 doc
: /* Return the plist of PROCESS. */)
1162 (register Lisp_Object process
)
1164 CHECK_PROCESS (process
);
1165 return XPROCESS (process
)->plist
;
1168 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1170 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1171 (register Lisp_Object process
, Lisp_Object plist
)
1173 CHECK_PROCESS (process
);
1176 XPROCESS (process
)->plist
= plist
;
1180 #if 0 /* Turned off because we don't currently record this info
1181 in the process. Perhaps add it. */
1182 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1183 doc
: /* Return the connection type of PROCESS.
1184 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1185 a socket connection. */)
1186 (Lisp_Object process
)
1188 return XPROCESS (process
)->type
;
1192 DEFUN ("process-type", Fprocess_type
, Sprocess_type
, 1, 1, 0,
1193 doc
: /* Return the connection type of PROCESS.
1194 The value is either the symbol `real', `network', or `serial'.
1195 PROCESS may be a process, a buffer, the name of a process or buffer, or
1196 nil, indicating the current buffer's process. */)
1197 (Lisp_Object process
)
1200 proc
= get_process (process
);
1201 return XPROCESS (proc
)->type
;
1204 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1206 doc
: /* Convert network ADDRESS from internal format to a string.
1207 A 4 or 5 element vector represents an IPv4 address (with port number).
1208 An 8 or 9 element vector represents an IPv6 address (with port number).
1209 If optional second argument OMIT-PORT is non-nil, don't include a port
1210 number in the string, even when present in ADDRESS.
1211 Returns nil if format of ADDRESS is invalid. */)
1212 (Lisp_Object address
, Lisp_Object omit_port
)
1217 if (STRINGP (address
)) /* AF_LOCAL */
1220 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1222 register struct Lisp_Vector
*p
= XVECTOR (address
);
1223 Lisp_Object args
[10];
1226 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1228 args
[0] = build_string ("%d.%d.%d.%d");
1231 else if (p
->size
== 5)
1233 args
[0] = build_string ("%d.%d.%d.%d:%d");
1236 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1238 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1241 else if (p
->size
== 9)
1243 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1249 for (i
= 0; i
< nargs
; i
++)
1251 EMACS_INT element
= XINT (p
->contents
[i
]);
1253 if (element
< 0 || element
> 65535)
1256 if (nargs
<= 5 /* IPv4 */
1257 && i
< 4 /* host, not port */
1261 args
[i
+1] = p
->contents
[i
];
1264 return Fformat (nargs
+1, args
);
1267 if (CONSP (address
))
1269 Lisp_Object args
[2];
1270 args
[0] = build_string ("<Family %d>");
1271 args
[1] = Fcar (address
);
1272 return Fformat (2, args
);
1279 list_processes_1 (Lisp_Object query_only
)
1281 register Lisp_Object tail
, tem
;
1282 Lisp_Object proc
, minspace
, tem1
;
1283 register struct Lisp_Process
*p
;
1285 int w_proc
, w_buffer
, w_tty
;
1287 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1289 w_proc
= 4; /* Proc */
1290 w_buffer
= 6; /* Buffer */
1291 w_tty
= 0; /* Omit if no ttys */
1293 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
1297 proc
= Fcdr (XCAR (tail
));
1298 p
= XPROCESS (proc
);
1301 if (!NILP (query_only
) && p
->kill_without_query
)
1303 if (STRINGP (p
->name
)
1304 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1306 if (!NILP (p
->buffer
))
1308 if (NILP (XBUFFER (p
->buffer
)->name
))
1311 w_buffer
= 8; /* (Killed) */
1313 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1316 if (STRINGP (p
->tty_name
)
1317 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1321 XSETFASTINT (i_status
, w_proc
+ 1);
1322 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1325 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1326 XSETFASTINT (i_command
, XFASTINT (i_tty
) + w_tty
+ 1);
1331 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1334 XSETFASTINT (minspace
, 1);
1336 set_buffer_internal (XBUFFER (Vstandard_output
));
1337 current_buffer
->undo_list
= Qt
;
1339 current_buffer
->truncate_lines
= Qt
;
1341 write_string ("Proc", -1);
1342 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1343 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1346 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1348 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1349 write_string ("\n", -1);
1351 write_string ("----", -1);
1352 Findent_to (i_status
, minspace
); write_string ("------", -1);
1353 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1356 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1358 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1359 write_string ("\n", -1);
1361 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
1365 proc
= Fcdr (XCAR (tail
));
1366 p
= XPROCESS (proc
);
1369 if (!NILP (query_only
) && p
->kill_without_query
)
1372 Finsert (1, &p
->name
);
1373 Findent_to (i_status
, minspace
);
1375 if (p
->raw_status_new
)
1378 if (CONSP (p
->status
))
1379 symbol
= XCAR (p
->status
);
1381 if (EQ (symbol
, Qsignal
))
1384 tem
= Fcar (Fcdr (p
->status
));
1385 Fprinc (symbol
, Qnil
);
1387 else if (NETCONN1_P (p
) || SERIALCONN1_P (p
))
1389 if (EQ (symbol
, Qexit
))
1390 write_string ("closed", -1);
1391 else if (EQ (p
->command
, Qt
))
1392 write_string ("stopped", -1);
1393 else if (EQ (symbol
, Qrun
))
1394 write_string ("open", -1);
1396 Fprinc (symbol
, Qnil
);
1398 else if (SERIALCONN1_P (p
))
1400 write_string ("running", -1);
1403 Fprinc (symbol
, Qnil
);
1405 if (EQ (symbol
, Qexit
))
1408 tem
= Fcar (Fcdr (p
->status
));
1411 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1412 write_string (tembuf
, -1);
1416 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
) || EQ (symbol
, Qclosed
))
1419 Findent_to (i_buffer
, minspace
);
1420 if (NILP (p
->buffer
))
1421 insert_string ("(none)");
1422 else if (NILP (XBUFFER (p
->buffer
)->name
))
1423 insert_string ("(Killed)");
1425 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1429 Findent_to (i_tty
, minspace
);
1430 if (STRINGP (p
->tty_name
))
1431 Finsert (1, &p
->tty_name
);
1434 Findent_to (i_command
, minspace
);
1436 if (EQ (p
->status
, Qlisten
))
1438 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1439 if (INTEGERP (port
))
1440 port
= Fnumber_to_string (port
);
1442 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1443 sprintf (tembuf
, "(network %s server on %s)\n",
1444 (DATAGRAM_CHAN_P (p
->infd
) ? "datagram" : "stream"),
1445 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1446 insert_string (tembuf
);
1448 else if (NETCONN1_P (p
))
1450 /* For a local socket, there is no host name,
1451 so display service instead. */
1452 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1453 if (!STRINGP (host
))
1455 host
= Fplist_get (p
->childp
, QCservice
);
1456 if (INTEGERP (host
))
1457 host
= Fnumber_to_string (host
);
1460 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1461 sprintf (tembuf
, "(network %s connection to %s)\n",
1462 (DATAGRAM_CHAN_P (p
->infd
) ? "datagram" : "stream"),
1463 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1464 insert_string (tembuf
);
1466 else if (SERIALCONN1_P (p
))
1468 Lisp_Object port
= Fplist_get (p
->childp
, QCport
);
1469 Lisp_Object speed
= Fplist_get (p
->childp
, QCspeed
);
1470 insert_string ("(serial port ");
1472 insert_string (SDATA (port
));
1474 insert_string ("?");
1475 if (INTEGERP (speed
))
1477 sprintf (tembuf
, " at %ld b/s", (long) XINT (speed
));
1478 insert_string (tembuf
);
1480 insert_string (")\n");
1494 insert_string (" ");
1496 insert_string ("\n");
1501 status_notify (NULL
);
1502 redisplay_preserve_echo_area (13);
1507 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1508 doc
: /* Display a list of all processes.
1509 If optional argument QUERY-ONLY is non-nil, only processes with
1510 the query-on-exit flag set will be listed.
1511 Any process listed as exited or signaled is actually eliminated
1512 after the listing is made. */)
1513 (Lisp_Object query_only
)
1515 internal_with_output_to_temp_buffer ("*Process List*",
1516 list_processes_1
, query_only
);
1520 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1521 doc
: /* Return a list of all processes. */)
1524 return Fmapcar (Qcdr
, Vprocess_alist
);
1527 /* Starting asynchronous inferior processes. */
1529 static Lisp_Object
start_process_unwind (Lisp_Object proc
);
1531 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1532 doc
: /* Start a program in a subprocess. Return the process object for it.
1533 NAME is name for process. It is modified if necessary to make it unique.
1534 BUFFER is the buffer (or buffer name) to associate with the process.
1536 Process output (both standard output and standard error streams) goes
1537 at end of BUFFER, unless you specify an output stream or filter
1538 function to handle the output. BUFFER may also be nil, meaning that
1539 this process is not associated with any buffer.
1541 PROGRAM is the program file name. It is searched for in PATH. If
1542 nil, just associate a pty with the buffer. Remaining arguments are
1543 strings to give program as arguments.
1545 If you want to separate standard output from standard error, invoke
1546 the command through a shell and redirect one of them using the shell
1549 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1550 (int nargs
, register Lisp_Object
*args
)
1552 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1553 register unsigned char **new_argv
;
1555 int count
= SPECPDL_INDEX ();
1559 buffer
= Fget_buffer_create (buffer
);
1561 /* Make sure that the child will be able to chdir to the current
1562 buffer's current directory, or its unhandled equivalent. We
1563 can't just have the child check for an error when it does the
1564 chdir, since it's in a vfork.
1566 We have to GCPRO around this because Fexpand_file_name and
1567 Funhandled_file_name_directory might call a file name handling
1568 function. The argument list is protected by the caller, so all
1569 we really have to worry about is buffer. */
1571 struct gcpro gcpro1
, gcpro2
;
1573 current_dir
= current_buffer
->directory
;
1575 GCPRO2 (buffer
, current_dir
);
1577 current_dir
= Funhandled_file_name_directory (current_dir
);
1578 if (NILP (current_dir
))
1579 /* If the file name handler says that current_dir is unreachable, use
1580 a sensible default. */
1581 current_dir
= build_string ("~/");
1582 current_dir
= expand_and_dir_to_file (current_dir
, Qnil
);
1583 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1584 report_file_error ("Setting current directory",
1585 Fcons (current_buffer
->directory
, Qnil
));
1591 CHECK_STRING (name
);
1595 if (!NILP (program
))
1596 CHECK_STRING (program
);
1598 proc
= make_process (name
);
1599 /* If an error occurs and we can't start the process, we want to
1600 remove it from the process list. This means that each error
1601 check in create_process doesn't need to call remove_process
1602 itself; it's all taken care of here. */
1603 record_unwind_protect (start_process_unwind
, proc
);
1605 XPROCESS (proc
)->childp
= Qt
;
1606 XPROCESS (proc
)->plist
= Qnil
;
1607 XPROCESS (proc
)->type
= Qreal
;
1608 XPROCESS (proc
)->buffer
= buffer
;
1609 XPROCESS (proc
)->sentinel
= Qnil
;
1610 XPROCESS (proc
)->filter
= Qnil
;
1611 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1614 /* AKA GNUTLS_INITSTAGE(proc). */
1615 XPROCESS (proc
)->gnutls_initstage
= GNUTLS_STAGE_EMPTY
;
1616 XPROCESS (proc
)->gnutls_cred_type
= Qnil
;
1619 #ifdef ADAPTIVE_READ_BUFFERING
1620 XPROCESS (proc
)->adaptive_read_buffering
1621 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
1622 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
1625 /* Make the process marker point into the process buffer (if any). */
1626 if (BUFFERP (buffer
))
1627 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1628 BUF_ZV (XBUFFER (buffer
)),
1629 BUF_ZV_BYTE (XBUFFER (buffer
)));
1632 /* Decide coding systems for communicating with the process. Here
1633 we don't setup the structure coding_system nor pay attention to
1634 unibyte mode. They are done in create_process. */
1636 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1637 Lisp_Object coding_systems
= Qt
;
1638 Lisp_Object val
, *args2
;
1639 struct gcpro gcpro1
, gcpro2
;
1641 val
= Vcoding_system_for_read
;
1644 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1645 args2
[0] = Qstart_process
;
1646 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1647 GCPRO2 (proc
, current_dir
);
1648 if (!NILP (program
))
1649 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1651 if (CONSP (coding_systems
))
1652 val
= XCAR (coding_systems
);
1653 else if (CONSP (Vdefault_process_coding_system
))
1654 val
= XCAR (Vdefault_process_coding_system
);
1656 XPROCESS (proc
)->decode_coding_system
= val
;
1658 val
= Vcoding_system_for_write
;
1661 if (EQ (coding_systems
, Qt
))
1663 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1664 args2
[0] = Qstart_process
;
1665 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1666 GCPRO2 (proc
, current_dir
);
1667 if (!NILP (program
))
1668 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1671 if (CONSP (coding_systems
))
1672 val
= XCDR (coding_systems
);
1673 else if (CONSP (Vdefault_process_coding_system
))
1674 val
= XCDR (Vdefault_process_coding_system
);
1676 XPROCESS (proc
)->encode_coding_system
= val
;
1680 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1681 XPROCESS (proc
)->decoding_carryover
= 0;
1682 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1684 XPROCESS (proc
)->inherit_coding_system_flag
1685 = !(NILP (buffer
) || !inherit_process_coding_system
);
1687 if (!NILP (program
))
1689 /* If program file name is not absolute, search our path for it.
1690 Put the name we will really use in TEM. */
1691 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1692 && !(SCHARS (program
) > 1
1693 && IS_DEVICE_SEP (SREF (program
, 1))))
1695 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1698 GCPRO4 (name
, program
, buffer
, current_dir
);
1699 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1702 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1703 tem
= Fexpand_file_name (tem
, Qnil
);
1707 if (!NILP (Ffile_directory_p (program
)))
1708 error ("Specified program for new process is a directory");
1712 /* If program file name starts with /: for quoting a magic name,
1714 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1715 && SREF (tem
, 1) == ':')
1716 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1719 struct gcpro gcpro1
;
1722 /* Encode the file name and put it in NEW_ARGV.
1723 That's where the child will use it to execute the program. */
1724 tem
= Fcons (ENCODE_FILE (tem
), Qnil
);
1726 /* Here we encode arguments by the coding system used for sending
1727 data to the process. We don't support using different coding
1728 systems for encoding arguments and for encoding data sent to the
1731 for (i
= 3; i
< nargs
; i
++)
1733 tem
= Fcons (args
[i
], tem
);
1734 CHECK_STRING (XCAR (tem
));
1735 if (STRING_MULTIBYTE (XCAR (tem
)))
1737 code_convert_string_norecord
1738 (XCAR (tem
), XPROCESS (proc
)->encode_coding_system
, 1));
1744 /* Now that everything is encoded we can collect the strings into
1746 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1747 new_argv
[nargs
- 2] = 0;
1749 for (i
= nargs
- 3; i
>= 0; i
--)
1751 new_argv
[i
] = SDATA (XCAR (tem
));
1755 create_process (proc
, (char **) new_argv
, current_dir
);
1760 return unbind_to (count
, proc
);
1763 /* This function is the unwind_protect form for Fstart_process. If
1764 PROC doesn't have its pid set, then we know someone has signaled
1765 an error and the process wasn't started successfully, so we should
1766 remove it from the process list. */
1768 start_process_unwind (Lisp_Object proc
)
1770 if (!PROCESSP (proc
))
1773 /* Was PROC started successfully? */
1774 if (XPROCESS (proc
)->pid
== -1)
1775 remove_process (proc
);
1781 create_process_1 (struct atimer
*timer
)
1783 /* Nothing to do. */
1788 create_process (Lisp_Object process
, char **new_argv
, Lisp_Object current_dir
)
1790 int inchannel
, outchannel
;
1793 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1794 int wait_child_setup
[2];
1798 struct sigaction sigint_action
;
1799 struct sigaction sigquit_action
;
1801 struct sigaction sighup_action
;
1803 /* Use volatile to protect variables from being clobbered by longjmp. */
1804 volatile int forkin
, forkout
;
1805 volatile int pty_flag
= 0;
1807 extern char **environ
;
1810 inchannel
= outchannel
= -1;
1813 if (!NILP (Vprocess_connection_type
))
1814 outchannel
= inchannel
= allocate_pty ();
1818 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1819 /* On most USG systems it does not work to open the pty's tty here,
1820 then close it and reopen it in the child. */
1822 /* Don't let this terminal become our controlling terminal
1823 (in case we don't have one). */
1824 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1826 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1829 report_file_error ("Opening pty", Qnil
);
1831 forkin
= forkout
= -1;
1832 #endif /* not USG, or USG_SUBTTY_WORKS */
1836 #endif /* HAVE_PTYS */
1841 report_file_error ("Creating pipe", Qnil
);
1847 emacs_close (inchannel
);
1848 emacs_close (forkout
);
1849 report_file_error ("Creating pipe", Qnil
);
1855 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1859 tem
= pipe (wait_child_setup
);
1861 report_file_error ("Creating pipe", Qnil
);
1862 tem
= fcntl (wait_child_setup
[1], F_GETFD
, 0);
1864 tem
= fcntl (wait_child_setup
[1], F_SETFD
, tem
| FD_CLOEXEC
);
1867 emacs_close (wait_child_setup
[0]);
1868 emacs_close (wait_child_setup
[1]);
1869 report_file_error ("Setting file descriptor flags", Qnil
);
1875 /* Replaced by close_process_descs */
1876 set_exclusive_use (inchannel
);
1877 set_exclusive_use (outchannel
);
1881 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1882 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1885 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1886 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1890 /* Record this as an active process, with its channels.
1891 As a result, child_setup will close Emacs's side of the pipes. */
1892 chan_process
[inchannel
] = process
;
1893 XPROCESS (process
)->infd
= inchannel
;
1894 XPROCESS (process
)->outfd
= outchannel
;
1896 /* Previously we recorded the tty descriptor used in the subprocess.
1897 It was only used for getting the foreground tty process, so now
1898 we just reopen the device (see emacs_get_tty_pgrp) as this is
1899 more portable (see USG_SUBTTY_WORKS above). */
1901 XPROCESS (process
)->pty_flag
= pty_flag
;
1902 XPROCESS (process
)->status
= Qrun
;
1903 setup_process_coding_systems (process
);
1905 /* Delay interrupts until we have a chance to store
1906 the new fork's pid in its process structure */
1907 sigemptyset (&blocked
);
1909 sigaddset (&blocked
, SIGCHLD
);
1911 #ifdef HAVE_WORKING_VFORK
1912 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1913 this sets the parent's signal handlers as well as the child's.
1914 So delay all interrupts whose handlers the child might munge,
1915 and record the current handlers so they can be restored later. */
1916 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1917 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1919 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1921 #endif /* HAVE_WORKING_VFORK */
1922 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1924 FD_SET (inchannel
, &input_wait_mask
);
1925 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1926 if (inchannel
> max_process_desc
)
1927 max_process_desc
= inchannel
;
1929 /* Until we store the proper pid, enable sigchld_handler
1930 to recognize an unknown pid as standing for this process.
1931 It is very important not to let this `marker' value stay
1932 in the table after this function has returned; if it does
1933 it might cause call-process to hang and subsequent asynchronous
1934 processes to get their return values scrambled. */
1935 XPROCESS (process
)->pid
= -1;
1940 /* child_setup must clobber environ on systems with true vfork.
1941 Protect it from permanent change. */
1942 char **save_environ
= environ
;
1944 current_dir
= ENCODE_FILE (current_dir
);
1949 #endif /* not WINDOWSNT */
1951 int xforkin
= forkin
;
1952 int xforkout
= forkout
;
1954 #if 0 /* This was probably a mistake--it duplicates code later on,
1955 but fails to handle all the cases. */
1956 /* Make sure SIGCHLD is not blocked in the child. */
1957 sigsetmask (SIGEMPTYMASK
);
1960 /* Make the pty be the controlling terminal of the process. */
1962 /* First, disconnect its current controlling terminal. */
1964 /* We tried doing setsid only if pty_flag, but it caused
1965 process_set_signal to fail on SGI when using a pipe. */
1967 /* Make the pty's terminal the controlling terminal. */
1968 if (pty_flag
&& xforkin
>= 0)
1971 /* We ignore the return value
1972 because faith@cs.unc.edu says that is necessary on Linux. */
1973 ioctl (xforkin
, TIOCSCTTY
, 0);
1976 #else /* not HAVE_SETSID */
1978 /* It's very important to call setpgrp here and no time
1979 afterwards. Otherwise, we lose our controlling tty which
1980 is set when we open the pty. */
1983 #endif /* not HAVE_SETSID */
1984 #if defined (LDISC1)
1985 if (pty_flag
&& xforkin
>= 0)
1988 tcgetattr (xforkin
, &t
);
1990 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1991 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1994 #if defined (NTTYDISC) && defined (TIOCSETD)
1995 if (pty_flag
&& xforkin
>= 0)
1997 /* Use new line discipline. */
1998 int ldisc
= NTTYDISC
;
1999 ioctl (xforkin
, TIOCSETD
, &ldisc
);
2004 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2005 can do TIOCSPGRP only to the process's controlling tty. */
2008 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2009 I can't test it since I don't have 4.3. */
2010 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
2013 ioctl (j
, TIOCNOTTY
, 0);
2017 /* In order to get a controlling terminal on some versions
2018 of BSD, it is necessary to put the process in pgrp 0
2019 before it opens the terminal. */
2027 #endif /* TIOCNOTTY */
2029 #if !defined (DONT_REOPEN_PTY)
2030 /*** There is a suggestion that this ought to be a
2031 conditional on TIOCSPGRP,
2032 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2033 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2034 that system does seem to need this code, even though
2035 both HAVE_SETSID and TIOCSCTTY are defined. */
2036 /* Now close the pty (if we had it open) and reopen it.
2037 This makes the pty the controlling terminal of the subprocess. */
2041 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2044 emacs_close (xforkin
);
2045 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2049 emacs_write (1, "Couldn't open the pty terminal ", 31);
2050 emacs_write (1, pty_name
, strlen (pty_name
));
2051 emacs_write (1, "\n", 1);
2056 #endif /* not DONT_REOPEN_PTY */
2058 #ifdef SETUP_SLAVE_PTY
2063 #endif /* SETUP_SLAVE_PTY */
2065 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2066 Now reenable it in the child, so it will die when we want it to. */
2068 signal (SIGHUP
, SIG_DFL
);
2070 #endif /* HAVE_PTYS */
2072 signal (SIGINT
, SIG_DFL
);
2073 signal (SIGQUIT
, SIG_DFL
);
2075 /* Stop blocking signals in the child. */
2076 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2079 child_setup_tty (xforkout
);
2081 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2082 new_argv
, 1, current_dir
);
2083 #else /* not WINDOWSNT */
2085 emacs_close (wait_child_setup
[0]);
2087 child_setup (xforkin
, xforkout
, xforkout
,
2088 new_argv
, 1, current_dir
);
2089 #endif /* not WINDOWSNT */
2091 environ
= save_environ
;
2096 /* This runs in the Emacs process. */
2100 emacs_close (forkin
);
2101 if (forkin
!= forkout
&& forkout
>= 0)
2102 emacs_close (forkout
);
2106 /* vfork succeeded. */
2107 XPROCESS (process
)->pid
= pid
;
2110 register_child (pid
, inchannel
);
2111 #endif /* WINDOWSNT */
2113 /* If the subfork execv fails, and it exits,
2114 this close hangs. I don't know why.
2115 So have an interrupt jar it loose. */
2117 struct atimer
*timer
;
2121 EMACS_SET_SECS_USECS (offset
, 1, 0);
2122 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2125 emacs_close (forkin
);
2127 cancel_atimer (timer
);
2131 if (forkin
!= forkout
&& forkout
>= 0)
2132 emacs_close (forkout
);
2136 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2139 XPROCESS (process
)->tty_name
= Qnil
;
2141 #if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
2142 /* Wait for child_setup to complete in case that vfork is
2143 actually defined as fork. The descriptor wait_child_setup[1]
2144 of a pipe is closed at the child side either by close-on-exec
2145 on successful execvp or the _exit call in child_setup. */
2149 emacs_close (wait_child_setup
[1]);
2150 emacs_read (wait_child_setup
[0], &dummy
, 1);
2151 emacs_close (wait_child_setup
[0]);
2156 /* Restore the signal state whether vfork succeeded or not.
2157 (We will signal an error, below, if it failed.) */
2158 #ifdef HAVE_WORKING_VFORK
2159 /* Restore the parent's signal handlers. */
2160 sigaction (SIGINT
, &sigint_action
, 0);
2161 sigaction (SIGQUIT
, &sigquit_action
, 0);
2163 sigaction (SIGHUP
, &sighup_action
, 0);
2165 #endif /* HAVE_WORKING_VFORK */
2166 /* Stop blocking signals in the parent. */
2167 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2169 /* Now generate the error if vfork failed. */
2171 report_file_error ("Doing vfork", Qnil
);
2175 create_pty (Lisp_Object process
)
2177 int inchannel
, outchannel
;
2179 /* Use volatile to protect variables from being clobbered by longjmp. */
2180 volatile int forkin
, forkout
;
2181 volatile int pty_flag
= 0;
2183 inchannel
= outchannel
= -1;
2186 if (!NILP (Vprocess_connection_type
))
2187 outchannel
= inchannel
= allocate_pty ();
2191 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
2192 /* On most USG systems it does not work to open the pty's tty here,
2193 then close it and reopen it in the child. */
2195 /* Don't let this terminal become our controlling terminal
2196 (in case we don't have one). */
2197 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
2199 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
2202 report_file_error ("Opening pty", Qnil
);
2203 #if defined (DONT_REOPEN_PTY)
2204 /* In the case that vfork is defined as fork, the parent process
2205 (Emacs) may send some data before the child process completes
2206 tty options setup. So we setup tty before forking. */
2207 child_setup_tty (forkout
);
2208 #endif /* DONT_REOPEN_PTY */
2210 forkin
= forkout
= -1;
2211 #endif /* not USG, or USG_SUBTTY_WORKS */
2214 #endif /* HAVE_PTYS */
2217 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
2218 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
2221 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
2222 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
2226 /* Record this as an active process, with its channels.
2227 As a result, child_setup will close Emacs's side of the pipes. */
2228 chan_process
[inchannel
] = process
;
2229 XPROCESS (process
)->infd
= inchannel
;
2230 XPROCESS (process
)->outfd
= outchannel
;
2232 /* Previously we recorded the tty descriptor used in the subprocess.
2233 It was only used for getting the foreground tty process, so now
2234 we just reopen the device (see emacs_get_tty_pgrp) as this is
2235 more portable (see USG_SUBTTY_WORKS above). */
2237 XPROCESS (process
)->pty_flag
= pty_flag
;
2238 XPROCESS (process
)->status
= Qrun
;
2239 setup_process_coding_systems (process
);
2241 FD_SET (inchannel
, &input_wait_mask
);
2242 FD_SET (inchannel
, &non_keyboard_wait_mask
);
2243 if (inchannel
> max_process_desc
)
2244 max_process_desc
= inchannel
;
2246 XPROCESS (process
)->pid
= -2;
2249 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2252 XPROCESS (process
)->tty_name
= Qnil
;
2256 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2257 The address family of sa is not included in the result. */
2260 conv_sockaddr_to_lisp (struct sockaddr
*sa
, int len
)
2262 Lisp_Object address
;
2265 register struct Lisp_Vector
*p
;
2267 /* Workaround for a bug in getsockname on BSD: Names bound to
2268 sockets in the UNIX domain are inaccessible; getsockname returns
2269 a zero length name. */
2270 if (len
< offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
))
2271 return empty_unibyte_string
;
2273 switch (sa
->sa_family
)
2277 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2278 len
= sizeof (sin
->sin_addr
) + 1;
2279 address
= Fmake_vector (make_number (len
), Qnil
);
2280 p
= XVECTOR (address
);
2281 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2282 cp
= (unsigned char *) &sin
->sin_addr
;
2288 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2289 uint16_t *ip6
= (uint16_t *) &sin6
->sin6_addr
;
2290 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2291 address
= Fmake_vector (make_number (len
), Qnil
);
2292 p
= XVECTOR (address
);
2293 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2294 for (i
= 0; i
< len
; i
++)
2295 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2299 #ifdef HAVE_LOCAL_SOCKETS
2302 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2303 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2304 if (sockun
->sun_path
[i
] == 0)
2306 return make_unibyte_string (sockun
->sun_path
, i
);
2310 len
-= offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
);
2311 address
= Fcons (make_number (sa
->sa_family
),
2312 Fmake_vector (make_number (len
), Qnil
));
2313 p
= XVECTOR (XCDR (address
));
2314 cp
= (unsigned char *) &sa
->sa_family
+ sizeof (sa
->sa_family
);
2320 p
->contents
[i
++] = make_number (*cp
++);
2326 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2329 get_lisp_to_sockaddr_size (Lisp_Object address
, int *familyp
)
2331 register struct Lisp_Vector
*p
;
2333 if (VECTORP (address
))
2335 p
= XVECTOR (address
);
2339 return sizeof (struct sockaddr_in
);
2342 else if (p
->size
== 9)
2344 *familyp
= AF_INET6
;
2345 return sizeof (struct sockaddr_in6
);
2349 #ifdef HAVE_LOCAL_SOCKETS
2350 else if (STRINGP (address
))
2352 *familyp
= AF_LOCAL
;
2353 return sizeof (struct sockaddr_un
);
2356 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2358 struct sockaddr
*sa
;
2359 *familyp
= XINT (XCAR (address
));
2360 p
= XVECTOR (XCDR (address
));
2361 return p
->size
+ sizeof (sa
->sa_family
);
2366 /* Convert an address object (vector or string) to an internal sockaddr.
2368 The address format has been basically validated by
2369 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2370 it could have come from user data. So if FAMILY is not valid,
2371 we return after zeroing *SA. */
2374 conv_lisp_to_sockaddr (int family
, Lisp_Object address
, struct sockaddr
*sa
, int len
)
2376 register struct Lisp_Vector
*p
;
2377 register unsigned char *cp
= NULL
;
2380 memset (sa
, 0, len
);
2382 if (VECTORP (address
))
2384 p
= XVECTOR (address
);
2385 if (family
== AF_INET
)
2387 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2388 len
= sizeof (sin
->sin_addr
) + 1;
2389 i
= XINT (p
->contents
[--len
]);
2390 sin
->sin_port
= htons (i
);
2391 cp
= (unsigned char *)&sin
->sin_addr
;
2392 sa
->sa_family
= family
;
2395 else if (family
== AF_INET6
)
2397 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2398 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2399 len
= sizeof (sin6
->sin6_addr
) + 1;
2400 i
= XINT (p
->contents
[--len
]);
2401 sin6
->sin6_port
= htons (i
);
2402 for (i
= 0; i
< len
; i
++)
2403 if (INTEGERP (p
->contents
[i
]))
2405 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2408 sa
->sa_family
= family
;
2415 else if (STRINGP (address
))
2417 #ifdef HAVE_LOCAL_SOCKETS
2418 if (family
== AF_LOCAL
)
2420 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2421 cp
= SDATA (address
);
2422 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2423 sockun
->sun_path
[i
] = *cp
++;
2424 sa
->sa_family
= family
;
2431 p
= XVECTOR (XCDR (address
));
2432 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2435 for (i
= 0; i
< len
; i
++)
2436 if (INTEGERP (p
->contents
[i
]))
2437 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2440 #ifdef DATAGRAM_SOCKETS
2441 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2443 doc
: /* Get the current datagram address associated with PROCESS. */)
2444 (Lisp_Object process
)
2448 CHECK_PROCESS (process
);
2450 if (!DATAGRAM_CONN_P (process
))
2453 channel
= XPROCESS (process
)->infd
;
2454 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2455 datagram_address
[channel
].len
);
2458 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2460 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2461 Returns nil upon error setting address, ADDRESS otherwise. */)
2462 (Lisp_Object process
, Lisp_Object address
)
2467 CHECK_PROCESS (process
);
2469 if (!DATAGRAM_CONN_P (process
))
2472 channel
= XPROCESS (process
)->infd
;
2474 len
= get_lisp_to_sockaddr_size (address
, &family
);
2475 if (datagram_address
[channel
].len
!= len
)
2477 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2483 static const struct socket_options
{
2484 /* The name of this option. Should be lowercase version of option
2485 name without SO_ prefix. */
2487 /* Option level SOL_... */
2489 /* Option number SO_... */
2491 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2492 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2493 } socket_options
[] =
2495 #ifdef SO_BINDTODEVICE
2496 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2499 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2502 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2505 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2508 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2511 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2514 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2517 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2519 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2522 /* Set option OPT to value VAL on socket S.
2524 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2525 Signals an error if setting a known option fails.
2529 set_socket_option (int s
, Lisp_Object opt
, Lisp_Object val
)
2532 const struct socket_options
*sopt
;
2537 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2538 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2539 if (strcmp (name
, sopt
->name
) == 0)
2542 switch (sopt
->opttype
)
2547 optval
= NILP (val
) ? 0 : 1;
2548 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2549 &optval
, sizeof (optval
));
2557 optval
= XINT (val
);
2559 error ("Bad option value for %s", name
);
2560 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2561 &optval
, sizeof (optval
));
2565 #ifdef SO_BINDTODEVICE
2568 char devname
[IFNAMSIZ
+1];
2570 /* This is broken, at least in the Linux 2.4 kernel.
2571 To unbind, the arg must be a zero integer, not the empty string.
2572 This should work on all systems. KFS. 2003-09-23. */
2573 memset (devname
, 0, sizeof devname
);
2576 char *arg
= (char *) SDATA (val
);
2577 int len
= min (strlen (arg
), IFNAMSIZ
);
2578 memcpy (devname
, arg
, len
);
2580 else if (!NILP (val
))
2581 error ("Bad option value for %s", name
);
2582 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2591 struct linger linger
;
2594 linger
.l_linger
= 0;
2596 linger
.l_linger
= XINT (val
);
2598 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2599 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2600 &linger
, sizeof (linger
));
2610 report_file_error ("Cannot set network option",
2611 Fcons (opt
, Fcons (val
, Qnil
)));
2612 return (1 << sopt
->optbit
);
2616 DEFUN ("set-network-process-option",
2617 Fset_network_process_option
, Sset_network_process_option
,
2619 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2620 See `make-network-process' for a list of options and values.
2621 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2622 OPTION is not a supported option, return nil instead; otherwise return t. */)
2623 (Lisp_Object process
, Lisp_Object option
, Lisp_Object value
, Lisp_Object no_error
)
2626 struct Lisp_Process
*p
;
2628 CHECK_PROCESS (process
);
2629 p
= XPROCESS (process
);
2630 if (!NETCONN1_P (p
))
2631 error ("Process is not a network process");
2635 error ("Process is not running");
2637 if (set_socket_option (s
, option
, value
))
2639 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2643 if (NILP (no_error
))
2644 error ("Unknown or unsupported option");
2650 DEFUN ("serial-process-configure",
2651 Fserial_process_configure
,
2652 Sserial_process_configure
,
2654 doc
: /* Configure speed, bytesize, etc. of a serial process.
2656 Arguments are specified as keyword/argument pairs. Attributes that
2657 are not given are re-initialized from the process's current
2658 configuration (available via the function `process-contact') or set to
2659 reasonable default values. The following arguments are defined:
2665 -- Any of these arguments can be given to identify the process that is
2666 to be configured. If none of these arguments is given, the current
2667 buffer's process is used.
2669 :speed SPEED -- SPEED is the speed of the serial port in bits per
2670 second, also called baud rate. Any value can be given for SPEED, but
2671 most serial ports work only at a few defined values between 1200 and
2672 115200, with 9600 being the most common value. If SPEED is nil, the
2673 serial port is not configured any further, i.e., all other arguments
2674 are ignored. This may be useful for special serial ports such as
2675 Bluetooth-to-serial converters which can only be configured through AT
2676 commands. A value of nil for SPEED can be used only when passed
2677 through `make-serial-process' or `serial-term'.
2679 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2680 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2682 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2683 `odd' (use odd parity), or the symbol `even' (use even parity). If
2684 PARITY is not given, no parity is used.
2686 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2687 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2688 is not given or nil, 1 stopbit is used.
2690 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2691 flowcontrol to be used, which is either nil (don't use flowcontrol),
2692 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2693 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2694 flowcontrol is used.
2696 `serial-process-configure' is called by `make-serial-process' for the
2697 initial configuration of the serial port.
2701 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2703 \(serial-process-configure
2704 :buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)
2706 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2708 usage: (serial-process-configure &rest ARGS) */)
2709 (int nargs
, Lisp_Object
*args
)
2711 struct Lisp_Process
*p
;
2712 Lisp_Object contact
= Qnil
;
2713 Lisp_Object proc
= Qnil
;
2714 struct gcpro gcpro1
;
2716 contact
= Flist (nargs
, args
);
2719 proc
= Fplist_get (contact
, QCprocess
);
2721 proc
= Fplist_get (contact
, QCname
);
2723 proc
= Fplist_get (contact
, QCbuffer
);
2725 proc
= Fplist_get (contact
, QCport
);
2726 proc
= get_process (proc
);
2727 p
= XPROCESS (proc
);
2728 if (!EQ (p
->type
, Qserial
))
2729 error ("Not a serial process");
2731 if (NILP (Fplist_get (p
->childp
, QCspeed
)))
2737 serial_configure (p
, contact
);
2743 /* Used by make-serial-process to recover from errors. */
2744 Lisp_Object
make_serial_process_unwind (Lisp_Object proc
)
2746 if (!PROCESSP (proc
))
2748 remove_process (proc
);
2752 DEFUN ("make-serial-process", Fmake_serial_process
, Smake_serial_process
,
2754 doc
: /* Create and return a serial port process.
2756 In Emacs, serial port connections are represented by process objects,
2757 so input and output work as for subprocesses, and `delete-process'
2758 closes a serial port connection. However, a serial process has no
2759 process id, it cannot be signaled, and the status codes are different
2760 from normal processes.
2762 `make-serial-process' creates a process and a buffer, on which you
2763 probably want to use `process-send-string'. Try \\[serial-term] for
2764 an interactive terminal. See below for examples.
2766 Arguments are specified as keyword/argument pairs. The following
2767 arguments are defined:
2769 :port PORT -- (mandatory) PORT is the path or name of the serial port.
2770 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
2771 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
2772 the backslashes in strings).
2774 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
2775 which is called by `make-serial-process'.
2777 :name NAME -- NAME is the name of the process. If NAME is not given,
2778 the value of PORT is used.
2780 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2781 with the process. Process output goes at the end of that buffer,
2782 unless you specify an output stream or filter function to handle the
2783 output. If BUFFER is not given, the value of NAME is used.
2785 :coding CODING -- If CODING is a symbol, it specifies the coding
2786 system used for both reading and writing for this process. If CODING
2787 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2788 ENCODING is used for writing.
2790 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2791 the process is running. If BOOL is not given, query before exiting.
2793 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
2794 In the stopped state, a serial process does not accept incoming data,
2795 but you can send outgoing data. The stopped state is cleared by
2796 `continue-process' and set by `stop-process'.
2798 :filter FILTER -- Install FILTER as the process filter.
2800 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2802 :plist PLIST -- Install PLIST as the initial plist of the process.
2809 -- These arguments are handled by `serial-process-configure', which is
2810 called by `make-serial-process'.
2812 The original argument list, possibly modified by later configuration,
2813 is available via the function `process-contact'.
2817 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
2819 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
2821 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity 'odd)
2823 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
2825 usage: (make-serial-process &rest ARGS) */)
2826 (int nargs
, Lisp_Object
*args
)
2829 Lisp_Object proc
, contact
, port
;
2830 struct Lisp_Process
*p
;
2831 struct gcpro gcpro1
;
2832 Lisp_Object name
, buffer
;
2833 Lisp_Object tem
, val
;
2834 int specpdl_count
= -1;
2839 contact
= Flist (nargs
, args
);
2842 port
= Fplist_get (contact
, QCport
);
2844 error ("No port specified");
2845 CHECK_STRING (port
);
2847 if (NILP (Fplist_member (contact
, QCspeed
)))
2848 error (":speed not specified");
2849 if (!NILP (Fplist_get (contact
, QCspeed
)))
2850 CHECK_NUMBER (Fplist_get (contact
, QCspeed
));
2852 name
= Fplist_get (contact
, QCname
);
2855 CHECK_STRING (name
);
2856 proc
= make_process (name
);
2857 specpdl_count
= SPECPDL_INDEX ();
2858 record_unwind_protect (make_serial_process_unwind
, proc
);
2859 p
= XPROCESS (proc
);
2861 fd
= serial_open ((char*) SDATA (port
));
2864 if (fd
> max_process_desc
)
2865 max_process_desc
= fd
;
2866 chan_process
[fd
] = proc
;
2868 buffer
= Fplist_get (contact
, QCbuffer
);
2871 buffer
= Fget_buffer_create (buffer
);
2874 p
->childp
= contact
;
2875 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
2877 p
->sentinel
= Fplist_get (contact
, QCsentinel
);
2878 p
->filter
= Fplist_get (contact
, QCfilter
);
2880 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
2881 p
->kill_without_query
= 1;
2882 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
2886 if (!EQ (p
->command
, Qt
))
2888 FD_SET (fd
, &input_wait_mask
);
2889 FD_SET (fd
, &non_keyboard_wait_mask
);
2892 if (BUFFERP (buffer
))
2894 set_marker_both (p
->mark
, buffer
,
2895 BUF_ZV (XBUFFER (buffer
)),
2896 BUF_ZV_BYTE (XBUFFER (buffer
)));
2899 tem
= Fplist_member (contact
, QCcoding
);
2900 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
2906 val
= XCAR (XCDR (tem
));
2910 else if (!NILP (Vcoding_system_for_read
))
2911 val
= Vcoding_system_for_read
;
2912 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
2913 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
2915 p
->decode_coding_system
= val
;
2920 val
= XCAR (XCDR (tem
));
2924 else if (!NILP (Vcoding_system_for_write
))
2925 val
= Vcoding_system_for_write
;
2926 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
2927 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
2929 p
->encode_coding_system
= val
;
2931 setup_process_coding_systems (proc
);
2932 p
->decoding_buf
= make_uninit_string (0);
2933 p
->decoding_carryover
= 0;
2934 p
->encoding_buf
= make_uninit_string (0);
2935 p
->inherit_coding_system_flag
2936 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
2938 Fserial_process_configure (nargs
, args
);
2940 specpdl_ptr
= specpdl
+ specpdl_count
;
2946 /* Create a network stream/datagram client/server process. Treated
2947 exactly like a normal process when reading and writing. Primary
2948 differences are in status display and process deletion. A network
2949 connection has no PID; you cannot signal it. All you can do is
2950 stop/continue it and deactivate/close it via delete-process */
2952 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2954 doc
: /* Create and return a network server or client process.
2956 In Emacs, network connections are represented by process objects, so
2957 input and output work as for subprocesses and `delete-process' closes
2958 a network connection. However, a network process has no process id,
2959 it cannot be signaled, and the status codes are different from normal
2962 Arguments are specified as keyword/argument pairs. The following
2963 arguments are defined:
2965 :name NAME -- NAME is name for process. It is modified if necessary
2968 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2969 with the process. Process output goes at end of that buffer, unless
2970 you specify an output stream or filter function to handle the output.
2971 BUFFER may be also nil, meaning that this process is not associated
2974 :host HOST -- HOST is name of the host to connect to, or its IP
2975 address. The symbol `local' specifies the local host. If specified
2976 for a server process, it must be a valid name or address for the local
2977 host, and only clients connecting to that address will be accepted.
2979 :service SERVICE -- SERVICE is name of the service desired, or an
2980 integer specifying a port number to connect to. If SERVICE is t,
2981 a random port number is selected for the server. (If Emacs was
2982 compiled with getaddrinfo, a port number can also be specified as a
2983 string, e.g. "80", as well as an integer. This is not portable.)
2985 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2986 stream type connection, `datagram' creates a datagram type connection,
2987 `seqpacket' creates a reliable datagram connection.
2989 :family FAMILY -- FAMILY is the address (and protocol) family for the
2990 service specified by HOST and SERVICE. The default (nil) is to use
2991 whatever address family (IPv4 or IPv6) that is defined for the host
2992 and port number specified by HOST and SERVICE. Other address families
2994 local -- for a local (i.e. UNIX) address specified by SERVICE.
2995 ipv4 -- use IPv4 address family only.
2996 ipv6 -- use IPv6 address family only.
2998 :local ADDRESS -- ADDRESS is the local address used for the connection.
2999 This parameter is ignored when opening a client process. When specified
3000 for a server process, the FAMILY, HOST and SERVICE args are ignored.
3002 :remote ADDRESS -- ADDRESS is the remote partner's address for the
3003 connection. This parameter is ignored when opening a stream server
3004 process. For a datagram server process, it specifies the initial
3005 setting of the remote datagram address. When specified for a client
3006 process, the FAMILY, HOST, and SERVICE args are ignored.
3008 The format of ADDRESS depends on the address family:
3009 - An IPv4 address is represented as an vector of integers [A B C D P]
3010 corresponding to numeric IP address A.B.C.D and port number P.
3011 - A local address is represented as a string with the address in the
3012 local address space.
3013 - An "unsupported family" address is represented by a cons (F . AV)
3014 where F is the family number and AV is a vector containing the socket
3015 address data with one element per address data byte. Do not rely on
3016 this format in portable code, as it may depend on implementation
3017 defined constants, data sizes, and data structure alignment.
3019 :coding CODING -- If CODING is a symbol, it specifies the coding
3020 system used for both reading and writing for this process. If CODING
3021 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3022 ENCODING is used for writing.
3024 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
3025 return without waiting for the connection to complete; instead, the
3026 sentinel function will be called with second arg matching "open" (if
3027 successful) or "failed" when the connect completes. Default is to use
3028 a blocking connect (i.e. wait) for stream type connections.
3030 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
3031 running when Emacs is exited.
3033 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
3034 In the stopped state, a server process does not accept new
3035 connections, and a client process does not handle incoming traffic.
3036 The stopped state is cleared by `continue-process' and set by
3039 :filter FILTER -- Install FILTER as the process filter.
3041 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
3042 process filter are multibyte, otherwise they are unibyte.
3043 If this keyword is not specified, the strings are multibyte if
3044 `default-enable-multibyte-characters' is non-nil.
3046 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3048 :log LOG -- Install LOG as the server process log function. This
3049 function is called when the server accepts a network connection from a
3050 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
3051 is the server process, CLIENT is the new process for the connection,
3052 and MESSAGE is a string.
3054 :plist PLIST -- Install PLIST as the new process' initial plist.
3056 :server QLEN -- if QLEN is non-nil, create a server process for the
3057 specified FAMILY, SERVICE, and connection type (stream or datagram).
3058 If QLEN is an integer, it is used as the max. length of the server's
3059 pending connection queue (also known as the backlog); the default
3060 queue length is 5. Default is to create a client process.
3062 The following network options can be specified for this connection:
3064 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
3065 :dontroute BOOL -- Only send to directly connected hosts.
3066 :keepalive BOOL -- Send keep-alive messages on network stream.
3067 :linger BOOL or TIMEOUT -- Send queued messages before closing.
3068 :oobinline BOOL -- Place out-of-band data in receive data stream.
3069 :priority INT -- Set protocol defined priority for sent packets.
3070 :reuseaddr BOOL -- Allow reusing a recently used local address
3071 (this is allowed by default for a server process).
3072 :bindtodevice NAME -- bind to interface NAME. Using this may require
3073 special privileges on some systems.
3075 Consult the relevant system programmer's manual pages for more
3076 information on using these options.
3079 A server process will listen for and accept connections from clients.
3080 When a client connection is accepted, a new network process is created
3081 for the connection with the following parameters:
3083 - The client's process name is constructed by concatenating the server
3084 process' NAME and a client identification string.
3085 - If the FILTER argument is non-nil, the client process will not get a
3086 separate process buffer; otherwise, the client's process buffer is a newly
3087 created buffer named after the server process' BUFFER name or process
3088 NAME concatenated with the client identification string.
3089 - The connection type and the process filter and sentinel parameters are
3090 inherited from the server process' TYPE, FILTER and SENTINEL.
3091 - The client process' contact info is set according to the client's
3092 addressing information (typically an IP address and a port number).
3093 - The client process' plist is initialized from the server's plist.
3095 Notice that the FILTER and SENTINEL args are never used directly by
3096 the server process. Also, the BUFFER argument is not used directly by
3097 the server process, but via the optional :log function, accepted (and
3098 failed) connections may be logged in the server process' buffer.
3100 The original argument list, modified with the actual connection
3101 information, is available via the `process-contact' function.
3103 usage: (make-network-process &rest ARGS) */)
3104 (int nargs
, Lisp_Object
*args
)
3107 Lisp_Object contact
;
3108 struct Lisp_Process
*p
;
3109 #ifdef HAVE_GETADDRINFO
3110 struct addrinfo ai
, *res
, *lres
;
3111 struct addrinfo hints
;
3112 const char *portstring
;
3114 #else /* HAVE_GETADDRINFO */
3115 struct _emacs_addrinfo
3121 struct sockaddr
*ai_addr
;
3122 struct _emacs_addrinfo
*ai_next
;
3124 #endif /* HAVE_GETADDRINFO */
3125 struct sockaddr_in address_in
;
3126 #ifdef HAVE_LOCAL_SOCKETS
3127 struct sockaddr_un address_un
;
3132 int s
= -1, outch
, inch
;
3133 struct gcpro gcpro1
;
3134 int count
= SPECPDL_INDEX ();
3136 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
3138 Lisp_Object name
, buffer
, host
, service
, address
;
3139 Lisp_Object filter
, sentinel
;
3140 int is_non_blocking_client
= 0;
3141 int is_server
= 0, backlog
= 5;
3148 /* Save arguments for process-contact and clone-process. */
3149 contact
= Flist (nargs
, args
);
3153 /* Ensure socket support is loaded if available. */
3154 init_winsock (TRUE
);
3157 /* :type TYPE (nil: stream, datagram */
3158 tem
= Fplist_get (contact
, QCtype
);
3160 socktype
= SOCK_STREAM
;
3161 #ifdef DATAGRAM_SOCKETS
3162 else if (EQ (tem
, Qdatagram
))
3163 socktype
= SOCK_DGRAM
;
3165 #ifdef HAVE_SEQPACKET
3166 else if (EQ (tem
, Qseqpacket
))
3167 socktype
= SOCK_SEQPACKET
;
3170 error ("Unsupported connection type");
3173 tem
= Fplist_get (contact
, QCserver
);
3176 /* Don't support network sockets when non-blocking mode is
3177 not available, since a blocked Emacs is not useful. */
3178 #if !defined(O_NONBLOCK) && !defined(O_NDELAY)
3179 error ("Network servers not supported");
3183 backlog
= XINT (tem
);
3187 /* Make QCaddress an alias for :local (server) or :remote (client). */
3188 QCaddress
= is_server
? QClocal
: QCremote
;
3191 if (!is_server
&& socktype
!= SOCK_DGRAM
3192 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
3194 #ifndef NON_BLOCKING_CONNECT
3195 error ("Non-blocking connect not supported");
3197 is_non_blocking_client
= 1;
3201 name
= Fplist_get (contact
, QCname
);
3202 buffer
= Fplist_get (contact
, QCbuffer
);
3203 filter
= Fplist_get (contact
, QCfilter
);
3204 sentinel
= Fplist_get (contact
, QCsentinel
);
3206 CHECK_STRING (name
);
3208 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
3209 ai
.ai_socktype
= socktype
;
3214 /* :local ADDRESS or :remote ADDRESS */
3215 address
= Fplist_get (contact
, QCaddress
);
3216 if (!NILP (address
))
3218 host
= service
= Qnil
;
3220 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
3221 error ("Malformed :address");
3222 ai
.ai_family
= family
;
3223 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
3224 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
3228 /* :family FAMILY -- nil (for Inet), local, or integer. */
3229 tem
= Fplist_get (contact
, QCfamily
);
3232 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
3238 #ifdef HAVE_LOCAL_SOCKETS
3239 else if (EQ (tem
, Qlocal
))
3243 else if (EQ (tem
, Qipv6
))
3246 else if (EQ (tem
, Qipv4
))
3248 else if (INTEGERP (tem
))
3249 family
= XINT (tem
);
3251 error ("Unknown address family");
3253 ai
.ai_family
= family
;
3255 /* :service SERVICE -- string, integer (port number), or t (random port). */
3256 service
= Fplist_get (contact
, QCservice
);
3258 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3259 host
= Fplist_get (contact
, QChost
);
3262 if (EQ (host
, Qlocal
))
3263 /* Depending on setup, "localhost" may map to different IPv4 and/or
3264 IPv6 addresses, so it's better to be explicit. (Bug#6781) */
3265 host
= build_string ("127.0.0.1");
3266 CHECK_STRING (host
);
3269 #ifdef HAVE_LOCAL_SOCKETS
3270 if (family
== AF_LOCAL
)
3274 message (":family local ignores the :host \"%s\" property",
3276 contact
= Fplist_put (contact
, QChost
, Qnil
);
3279 CHECK_STRING (service
);
3280 memset (&address_un
, 0, sizeof address_un
);
3281 address_un
.sun_family
= AF_LOCAL
;
3282 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
3283 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
3284 ai
.ai_addrlen
= sizeof address_un
;
3289 /* Slow down polling to every ten seconds.
3290 Some kernels have a bug which causes retrying connect to fail
3291 after a connect. Polling can interfere with gethostbyname too. */
3292 #ifdef POLL_FOR_INPUT
3293 if (socktype
!= SOCK_DGRAM
)
3295 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
3296 bind_polling_period (10);
3300 #ifdef HAVE_GETADDRINFO
3301 /* If we have a host, use getaddrinfo to resolve both host and service.
3302 Otherwise, use getservbyname to lookup the service. */
3306 /* SERVICE can either be a string or int.
3307 Convert to a C string for later use by getaddrinfo. */
3308 if (EQ (service
, Qt
))
3310 else if (INTEGERP (service
))
3312 sprintf (portbuf
, "%ld", (long) XINT (service
));
3313 portstring
= portbuf
;
3317 CHECK_STRING (service
);
3318 portstring
= SDATA (service
);
3323 memset (&hints
, 0, sizeof (hints
));
3325 hints
.ai_family
= family
;
3326 hints
.ai_socktype
= socktype
;
3327 hints
.ai_protocol
= 0;
3329 #ifdef HAVE_RES_INIT
3333 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3335 #ifdef HAVE_GAI_STRERROR
3336 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror (ret
));
3338 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3344 #endif /* HAVE_GETADDRINFO */
3346 /* We end up here if getaddrinfo is not defined, or in case no hostname
3347 has been specified (e.g. for a local server process). */
3349 if (EQ (service
, Qt
))
3351 else if (INTEGERP (service
))
3352 port
= htons ((unsigned short) XINT (service
));
3355 struct servent
*svc_info
;
3356 CHECK_STRING (service
);
3357 svc_info
= getservbyname (SDATA (service
),
3358 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3360 error ("Unknown service: %s", SDATA (service
));
3361 port
= svc_info
->s_port
;
3364 memset (&address_in
, 0, sizeof address_in
);
3365 address_in
.sin_family
= family
;
3366 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3367 address_in
.sin_port
= port
;
3369 #ifndef HAVE_GETADDRINFO
3372 struct hostent
*host_info_ptr
;
3374 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3375 as it may `hang' Emacs for a very long time. */
3379 #ifdef HAVE_RES_INIT
3383 host_info_ptr
= gethostbyname (SDATA (host
));
3388 memcpy (&address_in
.sin_addr
, host_info_ptr
->h_addr
,
3389 host_info_ptr
->h_length
);
3390 family
= host_info_ptr
->h_addrtype
;
3391 address_in
.sin_family
= family
;
3394 /* Attempt to interpret host as numeric inet address */
3396 unsigned long numeric_addr
;
3397 numeric_addr
= inet_addr ((char *) SDATA (host
));
3398 if (numeric_addr
== -1)
3399 error ("Unknown host \"%s\"", SDATA (host
));
3401 memcpy (&address_in
.sin_addr
, &numeric_addr
,
3402 sizeof (address_in
.sin_addr
));
3406 #endif /* not HAVE_GETADDRINFO */
3408 ai
.ai_family
= family
;
3409 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3410 ai
.ai_addrlen
= sizeof address_in
;
3414 /* Do this in case we never enter the for-loop below. */
3415 count1
= SPECPDL_INDEX ();
3418 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3424 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3431 #ifdef DATAGRAM_SOCKETS
3432 if (!is_server
&& socktype
== SOCK_DGRAM
)
3434 #endif /* DATAGRAM_SOCKETS */
3436 #ifdef NON_BLOCKING_CONNECT
3437 if (is_non_blocking_client
)
3440 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3442 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3454 /* Make us close S if quit. */
3455 record_unwind_protect (close_file_unwind
, make_number (s
));
3457 /* Parse network options in the arg list.
3458 We simply ignore anything which isn't a known option (including other keywords).
3459 An error is signaled if setting a known option fails. */
3460 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3461 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3465 /* Configure as a server socket. */
3467 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3468 explicit :reuseaddr key to override this. */
3469 #ifdef HAVE_LOCAL_SOCKETS
3470 if (family
!= AF_LOCAL
)
3472 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3475 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3476 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3479 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3480 report_file_error ("Cannot bind server socket", Qnil
);
3482 #ifdef HAVE_GETSOCKNAME
3483 if (EQ (service
, Qt
))
3485 struct sockaddr_in sa1
;
3486 int len1
= sizeof (sa1
);
3487 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3489 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3490 service
= make_number (ntohs (sa1
.sin_port
));
3491 contact
= Fplist_put (contact
, QCservice
, service
);
3496 if (socktype
!= SOCK_DGRAM
&& listen (s
, backlog
))
3497 report_file_error ("Cannot listen on server socket", Qnil
);
3505 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3508 if (ret
== 0 || xerrno
== EISCONN
)
3510 /* The unwind-protect will be discarded afterwards.
3511 Likewise for immediate_quit. */
3515 #ifdef NON_BLOCKING_CONNECT
3517 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3521 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3528 if (xerrno
== EINTR
)
3530 /* Unlike most other syscalls connect() cannot be called
3531 again. (That would return EALREADY.) The proper way to
3532 wait for completion is select(). */
3539 sc
= select (s
+ 1, (SELECT_TYPE
*)0, &fdset
, (SELECT_TYPE
*)0,
3546 report_file_error ("select failed", Qnil
);
3550 len
= sizeof xerrno
;
3551 eassert (FD_ISSET (s
, &fdset
));
3552 if (getsockopt (s
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &len
) == -1)
3553 report_file_error ("getsockopt failed", Qnil
);
3555 errno
= xerrno
, report_file_error ("error during connect", Qnil
);
3559 #endif /* !WINDOWSNT */
3563 /* Discard the unwind protect closing S. */
3564 specpdl_ptr
= specpdl
+ count1
;
3569 if (xerrno
== EINTR
)
3576 #ifdef DATAGRAM_SOCKETS
3577 if (socktype
== SOCK_DGRAM
)
3579 if (datagram_address
[s
].sa
)
3581 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3582 datagram_address
[s
].len
= lres
->ai_addrlen
;
3586 memset (datagram_address
[s
].sa
, 0, lres
->ai_addrlen
);
3587 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3590 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3591 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3592 conv_lisp_to_sockaddr (rfamily
, remote
,
3593 datagram_address
[s
].sa
, rlen
);
3597 memcpy (datagram_address
[s
].sa
, lres
->ai_addr
, lres
->ai_addrlen
);
3600 contact
= Fplist_put (contact
, QCaddress
,
3601 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3602 #ifdef HAVE_GETSOCKNAME
3605 struct sockaddr_in sa1
;
3606 int len1
= sizeof (sa1
);
3607 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3608 contact
= Fplist_put (contact
, QClocal
,
3609 conv_sockaddr_to_lisp ((struct sockaddr
*)&sa1
, len1
));
3616 #ifdef HAVE_GETADDRINFO
3625 /* Discard the unwind protect for closing S, if any. */
3626 specpdl_ptr
= specpdl
+ count1
;
3628 /* Unwind bind_polling_period and request_sigio. */
3629 unbind_to (count
, Qnil
);
3633 /* If non-blocking got this far - and failed - assume non-blocking is
3634 not supported after all. This is probably a wrong assumption, but
3635 the normal blocking calls to open-network-stream handles this error
3637 if (is_non_blocking_client
)
3642 report_file_error ("make server process failed", contact
);
3644 report_file_error ("make client process failed", contact
);
3651 buffer
= Fget_buffer_create (buffer
);
3652 proc
= make_process (name
);
3654 chan_process
[inch
] = proc
;
3657 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3660 fcntl (inch
, F_SETFL
, O_NDELAY
);
3664 p
= XPROCESS (proc
);
3666 p
->childp
= contact
;
3667 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3671 p
->sentinel
= sentinel
;
3673 p
->log
= Fplist_get (contact
, QClog
);
3674 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3675 p
->kill_without_query
= 1;
3676 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3681 if (is_server
&& socktype
!= SOCK_DGRAM
)
3682 p
->status
= Qlisten
;
3684 /* Make the process marker point into the process buffer (if any). */
3685 if (BUFFERP (buffer
))
3686 set_marker_both (p
->mark
, buffer
,
3687 BUF_ZV (XBUFFER (buffer
)),
3688 BUF_ZV_BYTE (XBUFFER (buffer
)));
3690 #ifdef NON_BLOCKING_CONNECT
3691 if (is_non_blocking_client
)
3693 /* We may get here if connect did succeed immediately. However,
3694 in that case, we still need to signal this like a non-blocking
3696 p
->status
= Qconnect
;
3697 if (!FD_ISSET (inch
, &connect_wait_mask
))
3699 FD_SET (inch
, &connect_wait_mask
);
3700 FD_SET (inch
, &write_mask
);
3701 num_pending_connects
++;
3706 /* A server may have a client filter setting of Qt, but it must
3707 still listen for incoming connects unless it is stopped. */
3708 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3709 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3711 FD_SET (inch
, &input_wait_mask
);
3712 FD_SET (inch
, &non_keyboard_wait_mask
);
3715 if (inch
> max_process_desc
)
3716 max_process_desc
= inch
;
3718 tem
= Fplist_member (contact
, QCcoding
);
3719 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3720 tem
= Qnil
; /* No error message (too late!). */
3723 /* Setup coding systems for communicating with the network stream. */
3724 struct gcpro gcpro1
;
3725 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3726 Lisp_Object coding_systems
= Qt
;
3727 Lisp_Object args
[5], val
;
3731 val
= XCAR (XCDR (tem
));
3735 else if (!NILP (Vcoding_system_for_read
))
3736 val
= Vcoding_system_for_read
;
3737 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3738 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3739 /* We dare not decode end-of-line format by setting VAL to
3740 Qraw_text, because the existing Emacs Lisp libraries
3741 assume that they receive bare code including a sequene of
3746 if (NILP (host
) || NILP (service
))
3747 coding_systems
= Qnil
;
3750 args
[0] = Qopen_network_stream
, args
[1] = name
,
3751 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3753 coding_systems
= Ffind_operation_coding_system (5, args
);
3756 if (CONSP (coding_systems
))
3757 val
= XCAR (coding_systems
);
3758 else if (CONSP (Vdefault_process_coding_system
))
3759 val
= XCAR (Vdefault_process_coding_system
);
3763 p
->decode_coding_system
= val
;
3767 val
= XCAR (XCDR (tem
));
3771 else if (!NILP (Vcoding_system_for_write
))
3772 val
= Vcoding_system_for_write
;
3773 else if (NILP (current_buffer
->enable_multibyte_characters
))
3777 if (EQ (coding_systems
, Qt
))
3779 if (NILP (host
) || NILP (service
))
3780 coding_systems
= Qnil
;
3783 args
[0] = Qopen_network_stream
, args
[1] = name
,
3784 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3786 coding_systems
= Ffind_operation_coding_system (5, args
);
3790 if (CONSP (coding_systems
))
3791 val
= XCDR (coding_systems
);
3792 else if (CONSP (Vdefault_process_coding_system
))
3793 val
= XCDR (Vdefault_process_coding_system
);
3797 p
->encode_coding_system
= val
;
3799 setup_process_coding_systems (proc
);
3801 p
->decoding_buf
= make_uninit_string (0);
3802 p
->decoding_carryover
= 0;
3803 p
->encoding_buf
= make_uninit_string (0);
3805 p
->inherit_coding_system_flag
3806 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
3813 #if defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3816 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3817 doc
: /* Return an alist of all network interfaces and their network address.
3818 Each element is a cons, the car of which is a string containing the
3819 interface name, and the cdr is the network address in internal
3820 format; see the description of ADDRESS in `make-network-process'. */)
3823 struct ifconf ifconf
;
3824 struct ifreq
*ifreqs
= NULL
;
3829 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3835 buf_size
= ifaces
* sizeof (ifreqs
[0]);
3836 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3843 ifconf
.ifc_len
= buf_size
;
3844 ifconf
.ifc_req
= ifreqs
;
3845 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3851 if (ifconf
.ifc_len
== buf_size
)
3855 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3858 while (--ifaces
>= 0)
3860 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3861 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3862 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3864 memcpy (namebuf
, ifq
->ifr_name
, sizeof (ifq
->ifr_name
));
3865 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3866 res
= Fcons (Fcons (build_string (namebuf
),
3867 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3868 sizeof (struct sockaddr
))),
3874 #endif /* SIOCGIFCONF */
3876 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3880 const char *flag_sym
;
3883 static const struct ifflag_def ifflag_table
[] = {
3887 #ifdef IFF_BROADCAST
3888 { IFF_BROADCAST
, "broadcast" },
3891 { IFF_DEBUG
, "debug" },
3894 { IFF_LOOPBACK
, "loopback" },
3896 #ifdef IFF_POINTOPOINT
3897 { IFF_POINTOPOINT
, "pointopoint" },
3900 { IFF_RUNNING
, "running" },
3903 { IFF_NOARP
, "noarp" },
3906 { IFF_PROMISC
, "promisc" },
3908 #ifdef IFF_NOTRAILERS
3909 { IFF_NOTRAILERS
, "notrailers" },
3912 { IFF_ALLMULTI
, "allmulti" },
3915 { IFF_MASTER
, "master" },
3918 { IFF_SLAVE
, "slave" },
3920 #ifdef IFF_MULTICAST
3921 { IFF_MULTICAST
, "multicast" },
3924 { IFF_PORTSEL
, "portsel" },
3926 #ifdef IFF_AUTOMEDIA
3927 { IFF_AUTOMEDIA
, "automedia" },
3930 { IFF_DYNAMIC
, "dynamic" },
3933 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3936 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3939 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3942 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3945 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3950 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3951 doc
: /* Return information about network interface named IFNAME.
3952 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3953 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3954 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3955 FLAGS is the current flags of the interface. */)
3956 (Lisp_Object ifname
)
3959 Lisp_Object res
= Qnil
;
3964 CHECK_STRING (ifname
);
3966 memset (rq
.ifr_name
, 0, sizeof rq
.ifr_name
);
3967 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3969 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3974 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3975 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3977 int flags
= rq
.ifr_flags
;
3978 const struct ifflag_def
*fp
;
3982 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3984 if (flags
& fp
->flag_bit
)
3986 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3987 flags
-= fp
->flag_bit
;
3990 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3992 if (flags
& (1 << fnum
))
3994 elt
= Fcons (make_number (fnum
), elt
);
3999 res
= Fcons (elt
, res
);
4002 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
4003 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
4005 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
4006 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
4010 for (n
= 0; n
< 6; n
++)
4011 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
4012 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
4015 res
= Fcons (elt
, res
);
4018 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
4019 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
4022 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
4023 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
4025 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
4029 res
= Fcons (elt
, res
);
4032 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
4033 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
4036 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
4039 res
= Fcons (elt
, res
);
4042 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
4043 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
4046 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
4049 res
= Fcons (elt
, res
);
4053 return any
? res
: Qnil
;
4056 #endif /* defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H) */
4058 /* Turn off input and output for process PROC. */
4061 deactivate_process (Lisp_Object proc
)
4063 register int inchannel
, outchannel
;
4064 register struct Lisp_Process
*p
= XPROCESS (proc
);
4066 inchannel
= p
->infd
;
4067 outchannel
= p
->outfd
;
4069 #ifdef ADAPTIVE_READ_BUFFERING
4070 if (p
->read_output_delay
> 0)
4072 if (--process_output_delay_count
< 0)
4073 process_output_delay_count
= 0;
4074 p
->read_output_delay
= 0;
4075 p
->read_output_skip
= 0;
4081 /* Beware SIGCHLD hereabouts. */
4082 flush_pending_output (inchannel
);
4083 emacs_close (inchannel
);
4084 if (outchannel
>= 0 && outchannel
!= inchannel
)
4085 emacs_close (outchannel
);
4089 #ifdef DATAGRAM_SOCKETS
4090 if (DATAGRAM_CHAN_P (inchannel
))
4092 xfree (datagram_address
[inchannel
].sa
);
4093 datagram_address
[inchannel
].sa
= 0;
4094 datagram_address
[inchannel
].len
= 0;
4097 chan_process
[inchannel
] = Qnil
;
4098 FD_CLR (inchannel
, &input_wait_mask
);
4099 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
4100 #ifdef NON_BLOCKING_CONNECT
4101 if (FD_ISSET (inchannel
, &connect_wait_mask
))
4103 FD_CLR (inchannel
, &connect_wait_mask
);
4104 FD_CLR (inchannel
, &write_mask
);
4105 if (--num_pending_connects
< 0)
4109 if (inchannel
== max_process_desc
)
4112 /* We just closed the highest-numbered process input descriptor,
4113 so recompute the highest-numbered one now. */
4114 max_process_desc
= 0;
4115 for (i
= 0; i
< MAXDESC
; i
++)
4116 if (!NILP (chan_process
[i
]))
4117 max_process_desc
= i
;
4123 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
4125 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
4126 It is read into the process' buffers or given to their filter functions.
4127 Non-nil arg PROCESS means do not return until some output has been received
4130 Non-nil second arg SECONDS and third arg MILLISEC are number of seconds
4131 and milliseconds to wait; return after that much time whether or not
4132 there is any subprocess output. If SECONDS is a floating point number,
4133 it specifies a fractional number of seconds to wait.
4134 The MILLISEC argument is obsolete and should be avoided.
4136 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
4137 from PROCESS, suspending reading output from other processes.
4138 If JUST-THIS-ONE is an integer, don't run any timers either.
4139 Return non-nil if we received any output before the timeout expired. */)
4140 (register Lisp_Object process
, Lisp_Object seconds
, Lisp_Object millisec
, Lisp_Object just_this_one
)
4142 int secs
, usecs
= 0;
4144 if (! NILP (process
))
4145 CHECK_PROCESS (process
);
4147 just_this_one
= Qnil
;
4149 if (!NILP (millisec
))
4150 { /* Obsolete calling convention using integers rather than floats. */
4151 CHECK_NUMBER (millisec
);
4153 seconds
= make_float (XINT (millisec
) / 1000.0);
4156 CHECK_NUMBER (seconds
);
4157 seconds
= make_float (XINT (millisec
) / 1000.0 + XINT (seconds
));
4161 if (!NILP (seconds
))
4163 if (INTEGERP (seconds
))
4164 secs
= XINT (seconds
);
4165 else if (FLOATP (seconds
))
4167 double timeout
= XFLOAT_DATA (seconds
);
4168 secs
= (int) timeout
;
4169 usecs
= (int) ((timeout
- (double) secs
) * 1000000);
4172 wrong_type_argument (Qnumberp
, seconds
);
4174 if (secs
< 0 || (secs
== 0 && usecs
== 0))
4175 secs
= -1, usecs
= 0;
4178 secs
= NILP (process
) ? -1 : 0;
4181 (wait_reading_process_output (secs
, usecs
, 0, 0,
4183 !NILP (process
) ? XPROCESS (process
) : NULL
,
4184 NILP (just_this_one
) ? 0 :
4185 !INTEGERP (just_this_one
) ? 1 : -1)
4189 /* Accept a connection for server process SERVER on CHANNEL. */
4191 static int connect_counter
= 0;
4194 server_accept_connection (Lisp_Object server
, int channel
)
4196 Lisp_Object proc
, caller
, name
, buffer
;
4197 Lisp_Object contact
, host
, service
;
4198 struct Lisp_Process
*ps
= XPROCESS (server
);
4199 struct Lisp_Process
*p
;
4203 struct sockaddr_in in
;
4205 struct sockaddr_in6 in6
;
4207 #ifdef HAVE_LOCAL_SOCKETS
4208 struct sockaddr_un un
;
4211 int len
= sizeof saddr
;
4213 s
= accept (channel
, &saddr
.sa
, &len
);
4222 if (code
== EWOULDBLOCK
)
4226 if (!NILP (ps
->log
))
4227 call3 (ps
->log
, server
, Qnil
,
4228 concat3 (build_string ("accept failed with code"),
4229 Fnumber_to_string (make_number (code
)),
4230 build_string ("\n")));
4236 /* Setup a new process to handle the connection. */
4238 /* Generate a unique identification of the caller, and build contact
4239 information for this process. */
4242 switch (saddr
.sa
.sa_family
)
4246 Lisp_Object args
[5];
4247 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4248 args
[0] = build_string ("%d.%d.%d.%d");
4249 args
[1] = make_number (*ip
++);
4250 args
[2] = make_number (*ip
++);
4251 args
[3] = make_number (*ip
++);
4252 args
[4] = make_number (*ip
++);
4253 host
= Fformat (5, args
);
4254 service
= make_number (ntohs (saddr
.in
.sin_port
));
4256 args
[0] = build_string (" <%s:%d>");
4259 caller
= Fformat (3, args
);
4266 Lisp_Object args
[9];
4267 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4269 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4270 for (i
= 0; i
< 8; i
++)
4271 args
[i
+1] = make_number (ntohs (ip6
[i
]));
4272 host
= Fformat (9, args
);
4273 service
= make_number (ntohs (saddr
.in
.sin_port
));
4275 args
[0] = build_string (" <[%s]:%d>");
4278 caller
= Fformat (3, args
);
4283 #ifdef HAVE_LOCAL_SOCKETS
4287 caller
= Fnumber_to_string (make_number (connect_counter
));
4288 caller
= concat3 (build_string (" <"), caller
, build_string (">"));
4292 /* Create a new buffer name for this process if it doesn't have a
4293 filter. The new buffer name is based on the buffer name or
4294 process name of the server process concatenated with the caller
4297 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4301 buffer
= ps
->buffer
;
4303 buffer
= Fbuffer_name (buffer
);
4308 buffer
= concat2 (buffer
, caller
);
4309 buffer
= Fget_buffer_create (buffer
);
4313 /* Generate a unique name for the new server process. Combine the
4314 server process name with the caller identification. */
4316 name
= concat2 (ps
->name
, caller
);
4317 proc
= make_process (name
);
4319 chan_process
[s
] = proc
;
4322 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4325 fcntl (s
, F_SETFL
, O_NDELAY
);
4329 p
= XPROCESS (proc
);
4331 /* Build new contact information for this setup. */
4332 contact
= Fcopy_sequence (ps
->childp
);
4333 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4334 contact
= Fplist_put (contact
, QChost
, host
);
4335 if (!NILP (service
))
4336 contact
= Fplist_put (contact
, QCservice
, service
);
4337 contact
= Fplist_put (contact
, QCremote
,
4338 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4339 #ifdef HAVE_GETSOCKNAME
4341 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4342 contact
= Fplist_put (contact
, QClocal
,
4343 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4346 p
->childp
= contact
;
4347 p
->plist
= Fcopy_sequence (ps
->plist
);
4351 p
->sentinel
= ps
->sentinel
;
4352 p
->filter
= ps
->filter
;
4359 /* Client processes for accepted connections are not stopped initially. */
4360 if (!EQ (p
->filter
, Qt
))
4362 FD_SET (s
, &input_wait_mask
);
4363 FD_SET (s
, &non_keyboard_wait_mask
);
4366 if (s
> max_process_desc
)
4367 max_process_desc
= s
;
4369 /* Setup coding system for new process based on server process.
4370 This seems to be the proper thing to do, as the coding system
4371 of the new process should reflect the settings at the time the
4372 server socket was opened; not the current settings. */
4374 p
->decode_coding_system
= ps
->decode_coding_system
;
4375 p
->encode_coding_system
= ps
->encode_coding_system
;
4376 setup_process_coding_systems (proc
);
4378 p
->decoding_buf
= make_uninit_string (0);
4379 p
->decoding_carryover
= 0;
4380 p
->encoding_buf
= make_uninit_string (0);
4382 p
->inherit_coding_system_flag
4383 = (NILP (buffer
) ? 0 : ps
->inherit_coding_system_flag
);
4385 if (!NILP (ps
->log
))
4386 call3 (ps
->log
, server
, proc
,
4387 concat3 (build_string ("accept from "),
4388 (STRINGP (host
) ? host
: build_string ("-")),
4389 build_string ("\n")));
4391 if (!NILP (p
->sentinel
))
4392 exec_sentinel (proc
,
4393 concat3 (build_string ("open from "),
4394 (STRINGP (host
) ? host
: build_string ("-")),
4395 build_string ("\n")));
4398 /* This variable is different from waiting_for_input in keyboard.c.
4399 It is used to communicate to a lisp process-filter/sentinel (via the
4400 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4401 for user-input when that process-filter was called.
4402 waiting_for_input cannot be used as that is by definition 0 when
4403 lisp code is being evalled.
4404 This is also used in record_asynch_buffer_change.
4405 For that purpose, this must be 0
4406 when not inside wait_reading_process_output. */
4407 static int waiting_for_user_input_p
;
4410 wait_reading_process_output_unwind (Lisp_Object data
)
4412 waiting_for_user_input_p
= XINT (data
);
4416 /* This is here so breakpoints can be put on it. */
4418 wait_reading_process_output_1 (void)
4422 /* Use a wrapper around select to work around a bug in gdb 5.3.
4423 Normally, the wrapper is optimized away by inlining.
4425 If emacs is stopped inside select, the gdb backtrace doesn't
4426 show the function which called select, so it is practically
4427 impossible to step through wait_reading_process_output. */
4431 select_wrapper (int n
, fd_set
*rfd
, fd_set
*wfd
, fd_set
*xfd
, struct timeval
*tmo
)
4433 return select (n
, rfd
, wfd
, xfd
, tmo
);
4435 #define select select_wrapper
4438 /* Read and dispose of subprocess output while waiting for timeout to
4439 elapse and/or keyboard input to be available.
4442 timeout in seconds, or
4443 zero for no limit, or
4444 -1 means gobble data immediately available but don't wait for any.
4447 an additional duration to wait, measured in microseconds.
4448 If this is nonzero and time_limit is 0, then the timeout
4449 consists of MICROSECS only.
4451 READ_KBD is a lisp value:
4452 0 to ignore keyboard input, or
4453 1 to return when input is available, or
4454 -1 meaning caller will actually read the input, so don't throw to
4455 the quit handler, or
4457 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4458 output that arrives.
4460 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4461 (and gobble terminal input into the buffer if any arrives).
4463 If WAIT_PROC is specified, wait until something arrives from that
4464 process. The return value is true if we read some input from
4467 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4468 (suspending output from other processes). A negative value
4469 means don't run any timers either.
4471 If WAIT_PROC is specified, then the function returns true if we
4472 received input from that process before the timeout elapsed.
4473 Otherwise, return true if we received input from any process. */
4476 wait_reading_process_output (int time_limit
, int microsecs
, int read_kbd
,
4478 Lisp_Object wait_for_cell
,
4479 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
4481 register int channel
, nfds
;
4482 SELECT_TYPE Available
;
4483 SELECT_TYPE Writeok
;
4485 int check_delay
, no_avail
;
4488 EMACS_TIME timeout
, end_time
;
4489 int wait_channel
= -1;
4490 int got_some_input
= 0;
4491 int count
= SPECPDL_INDEX ();
4493 FD_ZERO (&Available
);
4496 if (time_limit
== 0 && microsecs
== 0 && wait_proc
&& !NILP (Vinhibit_quit
)
4497 && !(CONSP (wait_proc
->status
) && EQ (XCAR (wait_proc
->status
), Qexit
)))
4498 message ("Blocking call to accept-process-output with quit inhibited!!");
4500 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4501 if (wait_proc
!= NULL
)
4502 wait_channel
= wait_proc
->infd
;
4504 record_unwind_protect (wait_reading_process_output_unwind
,
4505 make_number (waiting_for_user_input_p
));
4506 waiting_for_user_input_p
= read_kbd
;
4508 /* Since we may need to wait several times,
4509 compute the absolute time to return at. */
4510 if (time_limit
|| microsecs
)
4512 EMACS_GET_TIME (end_time
);
4513 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4514 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4519 int timeout_reduced_for_timers
= 0;
4521 /* If calling from keyboard input, do not quit
4522 since we want to return C-g as an input character.
4523 Otherwise, do pending quit if requested. */
4528 process_pending_signals ();
4531 /* Exit now if the cell we're waiting for became non-nil. */
4532 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4535 /* Compute time from now till when time limit is up */
4536 /* Exit if already run out */
4537 if (time_limit
== -1)
4539 /* -1 specified for timeout means
4540 gobble output available now
4541 but don't wait at all. */
4543 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4545 else if (time_limit
|| microsecs
)
4547 EMACS_GET_TIME (timeout
);
4548 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4549 if (EMACS_TIME_NEG_P (timeout
))
4554 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4557 /* Normally we run timers here.
4558 But not if wait_for_cell; in those cases,
4559 the wait is supposed to be short,
4560 and those callers cannot handle running arbitrary Lisp code here. */
4561 if (NILP (wait_for_cell
)
4562 && just_wait_proc
>= 0)
4564 EMACS_TIME timer_delay
;
4568 int old_timers_run
= timers_run
;
4569 struct buffer
*old_buffer
= current_buffer
;
4570 Lisp_Object old_window
= selected_window
;
4572 timer_delay
= timer_check (1);
4574 /* If a timer has run, this might have changed buffers
4575 an alike. Make read_key_sequence aware of that. */
4576 if (timers_run
!= old_timers_run
4577 && (old_buffer
!= current_buffer
4578 || !EQ (old_window
, selected_window
))
4579 && waiting_for_user_input_p
== -1)
4580 record_asynch_buffer_change ();
4582 if (timers_run
!= old_timers_run
&& do_display
)
4583 /* We must retry, since a timer may have requeued itself
4584 and that could alter the time_delay. */
4585 redisplay_preserve_echo_area (9);
4589 while (!detect_input_pending ());
4591 /* If there is unread keyboard input, also return. */
4593 && requeued_events_pending_p ())
4596 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4598 EMACS_TIME difference
;
4599 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4600 if (EMACS_TIME_NEG_P (difference
))
4602 timeout
= timer_delay
;
4603 timeout_reduced_for_timers
= 1;
4606 /* If time_limit is -1, we are not going to wait at all. */
4607 else if (time_limit
!= -1)
4609 /* This is so a breakpoint can be put here. */
4610 wait_reading_process_output_1 ();
4614 /* Cause C-g and alarm signals to take immediate action,
4615 and cause input available signals to zero out timeout.
4617 It is important that we do this before checking for process
4618 activity. If we get a SIGCHLD after the explicit checks for
4619 process activity, timeout is the only way we will know. */
4621 set_waiting_for_input (&timeout
);
4623 /* If status of something has changed, and no input is
4624 available, notify the user of the change right away. After
4625 this explicit check, we'll let the SIGCHLD handler zap
4626 timeout to get our attention. */
4627 if (update_tick
!= process_tick
)
4632 if (kbd_on_hold_p ())
4635 Atemp
= input_wait_mask
;
4638 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4639 if ((select (max (max_process_desc
, max_input_desc
) + 1,
4641 #ifdef NON_BLOCKING_CONNECT
4642 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4646 (SELECT_TYPE
*)0, &timeout
)
4649 /* It's okay for us to do this and then continue with
4650 the loop, since timeout has already been zeroed out. */
4651 clear_waiting_for_input ();
4652 status_notify (NULL
);
4653 if (do_display
) redisplay_preserve_echo_area (13);
4657 /* Don't wait for output from a non-running process. Just
4658 read whatever data has already been received. */
4659 if (wait_proc
&& wait_proc
->raw_status_new
)
4660 update_status (wait_proc
);
4662 && ! EQ (wait_proc
->status
, Qrun
)
4663 && ! EQ (wait_proc
->status
, Qconnect
))
4665 int nread
, total_nread
= 0;
4667 clear_waiting_for_input ();
4668 XSETPROCESS (proc
, wait_proc
);
4670 /* Read data from the process, until we exhaust it. */
4671 while (wait_proc
->infd
>= 0)
4673 nread
= read_process_output (proc
, wait_proc
->infd
);
4680 total_nread
+= nread
;
4684 else if (nread
== -1 && EIO
== errno
)
4688 else if (nread
== -1 && EAGAIN
== errno
)
4692 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4696 if (total_nread
> 0 && do_display
)
4697 redisplay_preserve_echo_area (10);
4702 /* Wait till there is something to do */
4704 if (wait_proc
&& just_wait_proc
)
4706 if (wait_proc
->infd
< 0) /* Terminated */
4708 FD_SET (wait_proc
->infd
, &Available
);
4712 else if (!NILP (wait_for_cell
))
4714 Available
= non_process_wait_mask
;
4721 Available
= non_keyboard_wait_mask
;
4723 Available
= input_wait_mask
;
4724 Writeok
= write_mask
;
4725 #ifdef SELECT_CANT_DO_WRITE_MASK
4730 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4733 /* If frame size has changed or the window is newly mapped,
4734 redisplay now, before we start to wait. There is a race
4735 condition here; if a SIGIO arrives between now and the select
4736 and indicates that a frame is trashed, the select may block
4737 displaying a trashed screen. */
4738 if (frame_garbaged
&& do_display
)
4740 clear_waiting_for_input ();
4741 redisplay_preserve_echo_area (11);
4743 set_waiting_for_input (&timeout
);
4747 if (read_kbd
&& detect_input_pending ())
4755 #ifdef ADAPTIVE_READ_BUFFERING
4756 /* Set the timeout for adaptive read buffering if any
4757 process has non-zero read_output_skip and non-zero
4758 read_output_delay, and we are not reading output for a
4759 specific wait_channel. It is not executed if
4760 Vprocess_adaptive_read_buffering is nil. */
4761 if (process_output_skip
&& check_delay
> 0)
4763 int usecs
= EMACS_USECS (timeout
);
4764 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4765 usecs
= READ_OUTPUT_DELAY_MAX
;
4766 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4768 proc
= chan_process
[channel
];
4771 /* Find minimum non-zero read_output_delay among the
4772 processes with non-zero read_output_skip. */
4773 if (XPROCESS (proc
)->read_output_delay
> 0)
4776 if (!XPROCESS (proc
)->read_output_skip
)
4778 FD_CLR (channel
, &Available
);
4779 XPROCESS (proc
)->read_output_skip
= 0;
4780 if (XPROCESS (proc
)->read_output_delay
< usecs
)
4781 usecs
= XPROCESS (proc
)->read_output_delay
;
4784 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4785 process_output_skip
= 0;
4788 #if defined (USE_GTK) || defined (HAVE_GCONF)
4790 #elif defined (HAVE_NS)
4795 (max (max_process_desc
, max_input_desc
) + 1,
4797 (check_write
? &Writeok
: (SELECT_TYPE
*)0),
4798 (SELECT_TYPE
*)0, &timeout
);
4803 /* Make C-g and alarm signals set flags again */
4804 clear_waiting_for_input ();
4806 /* If we woke up due to SIGWINCH, actually change size now. */
4807 do_pending_window_change (0);
4809 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4810 /* We wanted the full specified time, so return now. */
4814 if (xerrno
== EINTR
)
4816 else if (xerrno
== EBADF
)
4819 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4820 the child's closure of the pts gives the parent a SIGHUP, and
4821 the ptc file descriptor is automatically closed,
4822 yielding EBADF here or at select() call above.
4823 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4824 in m/ibmrt-aix.h), and here we just ignore the select error.
4825 Cleanup occurs c/o status_notify after SIGCLD. */
4826 no_avail
= 1; /* Cannot depend on values returned */
4832 error ("select error: %s", emacs_strerror (xerrno
));
4837 FD_ZERO (&Available
);
4841 #if 0 /* When polling is used, interrupt_input is 0,
4842 so get_input_pending should read the input.
4843 So this should not be needed. */
4844 /* If we are using polling for input,
4845 and we see input available, make it get read now.
4846 Otherwise it might not actually get read for a second.
4847 And on hpux, since we turn off polling in wait_reading_process_output,
4848 it might never get read at all if we don't spend much time
4849 outside of wait_reading_process_output. */
4850 if (read_kbd
&& interrupt_input
4851 && keyboard_bit_set (&Available
)
4852 && input_polling_used ())
4853 kill (getpid (), SIGALRM
);
4856 /* Check for keyboard input */
4857 /* If there is any, return immediately
4858 to give it higher priority than subprocesses */
4862 int old_timers_run
= timers_run
;
4863 struct buffer
*old_buffer
= current_buffer
;
4864 Lisp_Object old_window
= selected_window
;
4867 if (detect_input_pending_run_timers (do_display
))
4869 swallow_events (do_display
);
4870 if (detect_input_pending_run_timers (do_display
))
4874 /* If a timer has run, this might have changed buffers
4875 an alike. Make read_key_sequence aware of that. */
4876 if (timers_run
!= old_timers_run
4877 && waiting_for_user_input_p
== -1
4878 && (old_buffer
!= current_buffer
4879 || !EQ (old_window
, selected_window
)))
4880 record_asynch_buffer_change ();
4886 /* If there is unread keyboard input, also return. */
4888 && requeued_events_pending_p ())
4891 /* If we are not checking for keyboard input now,
4892 do process events (but don't run any timers).
4893 This is so that X events will be processed.
4894 Otherwise they may have to wait until polling takes place.
4895 That would causes delays in pasting selections, for example.
4897 (We used to do this only if wait_for_cell.) */
4898 if (read_kbd
== 0 && detect_input_pending ())
4900 swallow_events (do_display
);
4901 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4902 if (detect_input_pending ())
4907 /* Exit now if the cell we're waiting for became non-nil. */
4908 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4912 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4913 go read it. This can happen with X on BSD after logging out.
4914 In that case, there really is no input and no SIGIO,
4915 but select says there is input. */
4917 if (read_kbd
&& interrupt_input
4918 && keyboard_bit_set (&Available
) && ! noninteractive
)
4919 kill (getpid (), SIGIO
);
4923 got_some_input
|= nfds
> 0;
4925 /* If checking input just got us a size-change event from X,
4926 obey it now if we should. */
4927 if (read_kbd
|| ! NILP (wait_for_cell
))
4928 do_pending_window_change (0);
4930 /* Check for data from a process. */
4931 if (no_avail
|| nfds
== 0)
4934 for (channel
= 0; channel
<= max_input_desc
; ++channel
)
4936 struct fd_callback_data
*d
= &fd_callback_info
[channel
];
4937 if (FD_ISSET (channel
, &Available
)
4939 && (d
->condition
& FOR_READ
) != 0)
4940 d
->func (channel
, d
->data
, 1);
4941 if (FD_ISSET (channel
, &write_mask
)
4943 && (d
->condition
& FOR_WRITE
) != 0)
4944 d
->func (channel
, d
->data
, 0);
4947 /* Really FIRST_PROC_DESC should be 0 on Unix,
4948 but this is safer in the short run. */
4949 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4951 if (FD_ISSET (channel
, &Available
)
4952 && FD_ISSET (channel
, &non_keyboard_wait_mask
)
4953 && !FD_ISSET (channel
, &non_process_wait_mask
))
4957 /* If waiting for this channel, arrange to return as
4958 soon as no more input to be processed. No more
4960 if (wait_channel
== channel
)
4966 proc
= chan_process
[channel
];
4970 /* If this is a server stream socket, accept connection. */
4971 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4973 server_accept_connection (proc
, channel
);
4977 /* Read data from the process, starting with our
4978 buffered-ahead character if we have one. */
4980 nread
= read_process_output (proc
, channel
);
4983 /* Since read_process_output can run a filter,
4984 which can call accept-process-output,
4985 don't try to read from any other processes
4986 before doing the select again. */
4987 FD_ZERO (&Available
);
4990 redisplay_preserve_echo_area (12);
4993 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4996 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4997 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4999 else if (nread
== -1 && errno
== EAGAIN
)
5003 else if (nread
== -1 && errno
== EAGAIN
)
5005 /* Note that we cannot distinguish between no input
5006 available now and a closed pipe.
5007 With luck, a closed pipe will be accompanied by
5008 subprocess termination and SIGCHLD. */
5009 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
5011 #endif /* O_NDELAY */
5012 #endif /* O_NONBLOCK */
5014 /* On some OSs with ptys, when the process on one end of
5015 a pty exits, the other end gets an error reading with
5016 errno = EIO instead of getting an EOF (0 bytes read).
5017 Therefore, if we get an error reading and errno =
5018 EIO, just continue, because the child process has
5019 exited and should clean itself up soon (e.g. when we
5022 However, it has been known to happen that the SIGCHLD
5023 got lost. So raise the signal again just in case.
5025 else if (nread
== -1 && errno
== EIO
)
5027 /* Clear the descriptor now, so we only raise the
5028 signal once. Don't do this if `process' is only
5030 if (XPROCESS (proc
)->pid
!= -2)
5032 FD_CLR (channel
, &input_wait_mask
);
5033 FD_CLR (channel
, &non_keyboard_wait_mask
);
5035 kill (getpid (), SIGCHLD
);
5038 #endif /* HAVE_PTYS */
5039 /* If we can detect process termination, don't consider the process
5040 gone just because its pipe is closed. */
5042 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
))
5047 /* Preserve status of processes already terminated. */
5048 XPROCESS (proc
)->tick
= ++process_tick
;
5049 deactivate_process (proc
);
5050 if (XPROCESS (proc
)->raw_status_new
)
5051 update_status (XPROCESS (proc
));
5052 if (EQ (XPROCESS (proc
)->status
, Qrun
))
5053 XPROCESS (proc
)->status
5054 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5057 #ifdef NON_BLOCKING_CONNECT
5058 if (FD_ISSET (channel
, &Writeok
)
5059 && FD_ISSET (channel
, &connect_wait_mask
))
5061 struct Lisp_Process
*p
;
5063 FD_CLR (channel
, &connect_wait_mask
);
5064 FD_CLR (channel
, &write_mask
);
5065 if (--num_pending_connects
< 0)
5068 proc
= chan_process
[channel
];
5072 p
= XPROCESS (proc
);
5075 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
5076 So only use it on systems where it is known to work. */
5078 int xlen
= sizeof (xerrno
);
5079 if (getsockopt (channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
5084 struct sockaddr pname
;
5085 int pnamelen
= sizeof (pname
);
5087 /* If connection failed, getpeername will fail. */
5089 if (getpeername (channel
, &pname
, &pnamelen
) < 0)
5091 /* Obtain connect failure code through error slippage. */
5094 if (errno
== ENOTCONN
&& read (channel
, &dummy
, 1) < 0)
5101 p
->tick
= ++process_tick
;
5102 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
5103 deactivate_process (proc
);
5108 /* Execute the sentinel here. If we had relied on
5109 status_notify to do it later, it will read input
5110 from the process before calling the sentinel. */
5111 exec_sentinel (proc
, build_string ("open\n"));
5112 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
5114 FD_SET (p
->infd
, &input_wait_mask
);
5115 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
5119 #endif /* NON_BLOCKING_CONNECT */
5120 } /* end for each file descriptor */
5121 } /* end while exit conditions not met */
5123 unbind_to (count
, Qnil
);
5125 /* If calling from keyboard input, do not quit
5126 since we want to return C-g as an input character.
5127 Otherwise, do pending quit if requested. */
5130 /* Prevent input_pending from remaining set if we quit. */
5131 clear_input_pending ();
5135 return got_some_input
;
5138 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5141 read_process_output_call (Lisp_Object fun_and_args
)
5143 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
5147 read_process_output_error_handler (Lisp_Object error
)
5149 cmd_error_internal (error
, "error in process filter: ");
5151 update_echo_area ();
5152 Fsleep_for (make_number (2), Qnil
);
5156 /* Read pending output from the process channel,
5157 starting with our buffered-ahead character if we have one.
5158 Yield number of decoded characters read.
5160 This function reads at most 4096 characters.
5161 If you want to read all available subprocess output,
5162 you must call it repeatedly until it returns zero.
5164 The characters read are decoded according to PROC's coding-system
5168 read_process_output (Lisp_Object proc
, register int channel
)
5170 register int nbytes
;
5172 register Lisp_Object outstream
;
5173 register struct Lisp_Process
*p
= XPROCESS (proc
);
5174 register EMACS_INT opoint
;
5175 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
5176 int carryover
= p
->decoding_carryover
;
5178 int count
= SPECPDL_INDEX ();
5179 Lisp_Object odeactivate
;
5181 chars
= (char *) alloca (carryover
+ readmax
);
5183 /* See the comment above. */
5184 memcpy (chars
, SDATA (p
->decoding_buf
), carryover
);
5186 #ifdef DATAGRAM_SOCKETS
5187 /* We have a working select, so proc_buffered_char is always -1. */
5188 if (DATAGRAM_CHAN_P (channel
))
5190 int len
= datagram_address
[channel
].len
;
5191 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5192 0, datagram_address
[channel
].sa
, &len
);
5196 if (proc_buffered_char
[channel
] < 0)
5199 if (XPROCESS (proc
)->gnutls_p
)
5200 nbytes
= emacs_gnutls_read (channel
, XPROCESS (proc
),
5201 chars
+ carryover
, readmax
);
5204 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
5205 #ifdef ADAPTIVE_READ_BUFFERING
5206 if (nbytes
> 0 && p
->adaptive_read_buffering
)
5208 int delay
= p
->read_output_delay
;
5211 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5214 process_output_delay_count
++;
5215 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5218 else if (delay
> 0 && (nbytes
== readmax
))
5220 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5222 process_output_delay_count
--;
5224 p
->read_output_delay
= delay
;
5227 p
->read_output_skip
= 1;
5228 process_output_skip
= 1;
5235 chars
[carryover
] = proc_buffered_char
[channel
];
5236 proc_buffered_char
[channel
] = -1;
5238 if (XPROCESS (proc
)->gnutls_p
)
5239 nbytes
= emacs_gnutls_read (channel
, XPROCESS (proc
),
5240 chars
+ carryover
+ 1, readmax
- 1);
5243 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
5247 nbytes
= nbytes
+ 1;
5250 p
->decoding_carryover
= 0;
5252 /* At this point, NBYTES holds number of bytes just received
5253 (including the one in proc_buffered_char[channel]). */
5256 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5258 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5261 /* Now set NBYTES how many bytes we must decode. */
5262 nbytes
+= carryover
;
5264 odeactivate
= Vdeactivate_mark
;
5265 /* There's no good reason to let process filters change the current
5266 buffer, and many callers of accept-process-output, sit-for, and
5267 friends don't expect current-buffer to be changed from under them. */
5268 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
5270 /* Read and dispose of the process output. */
5271 outstream
= p
->filter
;
5272 if (!NILP (outstream
))
5274 Lisp_Object obuffer
, okeymap
;
5276 int outer_running_asynch_code
= running_asynch_code
;
5277 int waiting
= waiting_for_user_input_p
;
5279 /* No need to gcpro these, because all we do with them later
5280 is test them for EQness, and none of them should be a string. */
5281 XSETBUFFER (obuffer
, current_buffer
);
5282 okeymap
= current_buffer
->keymap
;
5284 /* We inhibit quit here instead of just catching it so that
5285 hitting ^G when a filter happens to be running won't screw
5287 specbind (Qinhibit_quit
, Qt
);
5288 specbind (Qlast_nonmenu_event
, Qt
);
5290 /* In case we get recursively called,
5291 and we already saved the match data nonrecursively,
5292 save the same match data in safely recursive fashion. */
5293 if (outer_running_asynch_code
)
5296 /* Don't clobber the CURRENT match data, either! */
5297 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5298 restore_search_regs ();
5299 record_unwind_save_match_data ();
5300 Fset_match_data (tem
, Qt
);
5303 /* For speed, if a search happens within this code,
5304 save the match data in a special nonrecursive fashion. */
5305 running_asynch_code
= 1;
5307 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
5308 text
= coding
->dst_object
;
5309 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5310 /* A new coding system might be found. */
5311 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5313 p
->decode_coding_system
= Vlast_coding_system_used
;
5315 /* Don't call setup_coding_system for
5316 proc_decode_coding_system[channel] here. It is done in
5317 detect_coding called via decode_coding above. */
5319 /* If a coding system for encoding is not yet decided, we set
5320 it as the same as coding-system for decoding.
5322 But, before doing that we must check if
5323 proc_encode_coding_system[p->outfd] surely points to a
5324 valid memory because p->outfd will be changed once EOF is
5325 sent to the process. */
5326 if (NILP (p
->encode_coding_system
)
5327 && proc_encode_coding_system
[p
->outfd
])
5329 p
->encode_coding_system
5330 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5331 setup_coding_system (p
->encode_coding_system
,
5332 proc_encode_coding_system
[p
->outfd
]);
5336 if (coding
->carryover_bytes
> 0)
5338 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5339 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5340 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5341 coding
->carryover_bytes
);
5342 p
->decoding_carryover
= coding
->carryover_bytes
;
5344 if (SBYTES (text
) > 0)
5345 internal_condition_case_1 (read_process_output_call
,
5347 Fcons (proc
, Fcons (text
, Qnil
))),
5348 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5349 read_process_output_error_handler
);
5351 /* If we saved the match data nonrecursively, restore it now. */
5352 restore_search_regs ();
5353 running_asynch_code
= outer_running_asynch_code
;
5355 /* Restore waiting_for_user_input_p as it was
5356 when we were called, in case the filter clobbered it. */
5357 waiting_for_user_input_p
= waiting
;
5359 #if 0 /* Call record_asynch_buffer_change unconditionally,
5360 because we might have changed minor modes or other things
5361 that affect key bindings. */
5362 if (! EQ (Fcurrent_buffer (), obuffer
)
5363 || ! EQ (current_buffer
->keymap
, okeymap
))
5365 /* But do it only if the caller is actually going to read events.
5366 Otherwise there's no need to make him wake up, and it could
5367 cause trouble (for example it would make sit_for return). */
5368 if (waiting_for_user_input_p
== -1)
5369 record_asynch_buffer_change ();
5372 /* If no filter, write into buffer if it isn't dead. */
5373 else if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5375 Lisp_Object old_read_only
;
5376 EMACS_INT old_begv
, old_zv
;
5377 EMACS_INT old_begv_byte
, old_zv_byte
;
5378 EMACS_INT before
, before_byte
;
5379 EMACS_INT opoint_byte
;
5383 Fset_buffer (p
->buffer
);
5385 opoint_byte
= PT_BYTE
;
5386 old_read_only
= current_buffer
->read_only
;
5389 old_begv_byte
= BEGV_BYTE
;
5390 old_zv_byte
= ZV_BYTE
;
5392 current_buffer
->read_only
= Qnil
;
5394 /* Insert new output into buffer
5395 at the current end-of-output marker,
5396 thus preserving logical ordering of input and output. */
5397 if (XMARKER (p
->mark
)->buffer
)
5398 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5399 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5402 SET_PT_BOTH (ZV
, ZV_BYTE
);
5404 before_byte
= PT_BYTE
;
5406 /* If the output marker is outside of the visible region, save
5407 the restriction and widen. */
5408 if (! (BEGV
<= PT
&& PT
<= ZV
))
5411 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
5412 text
= coding
->dst_object
;
5413 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5414 /* A new coding system might be found. See the comment in the
5415 similar code in the previous `if' block. */
5416 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5418 p
->decode_coding_system
= Vlast_coding_system_used
;
5419 if (NILP (p
->encode_coding_system
)
5420 && proc_encode_coding_system
[p
->outfd
])
5422 p
->encode_coding_system
5423 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5424 setup_coding_system (p
->encode_coding_system
,
5425 proc_encode_coding_system
[p
->outfd
]);
5428 if (coding
->carryover_bytes
> 0)
5430 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5431 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5432 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5433 coding
->carryover_bytes
);
5434 p
->decoding_carryover
= coding
->carryover_bytes
;
5436 /* Adjust the multibyteness of TEXT to that of the buffer. */
5437 if (NILP (current_buffer
->enable_multibyte_characters
)
5438 != ! STRING_MULTIBYTE (text
))
5439 text
= (STRING_MULTIBYTE (text
)
5440 ? Fstring_as_unibyte (text
)
5441 : Fstring_to_multibyte (text
));
5442 /* Insert before markers in case we are inserting where
5443 the buffer's mark is, and the user's next command is Meta-y. */
5444 insert_from_string_before_markers (text
, 0, 0,
5445 SCHARS (text
), SBYTES (text
), 0);
5447 /* Make sure the process marker's position is valid when the
5448 process buffer is changed in the signal_after_change above.
5449 W3 is known to do that. */
5450 if (BUFFERP (p
->buffer
)
5451 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5452 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5454 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5456 update_mode_lines
++;
5458 /* Make sure opoint and the old restrictions
5459 float ahead of any new text just as point would. */
5460 if (opoint
>= before
)
5462 opoint
+= PT
- before
;
5463 opoint_byte
+= PT_BYTE
- before_byte
;
5465 if (old_begv
> before
)
5467 old_begv
+= PT
- before
;
5468 old_begv_byte
+= PT_BYTE
- before_byte
;
5470 if (old_zv
>= before
)
5472 old_zv
+= PT
- before
;
5473 old_zv_byte
+= PT_BYTE
- before_byte
;
5476 /* If the restriction isn't what it should be, set it. */
5477 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5478 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5481 current_buffer
->read_only
= old_read_only
;
5482 SET_PT_BOTH (opoint
, opoint_byte
);
5484 /* Handling the process output should not deactivate the mark. */
5485 Vdeactivate_mark
= odeactivate
;
5487 unbind_to (count
, Qnil
);
5491 /* Sending data to subprocess */
5493 jmp_buf send_process_frame
;
5494 Lisp_Object process_sent_to
;
5497 send_process_trap (int ignore
)
5499 SIGNAL_THREAD_CHECK (SIGPIPE
);
5500 sigunblock (sigmask (SIGPIPE
));
5501 longjmp (send_process_frame
, 1);
5504 /* Send some data to process PROC.
5505 BUF is the beginning of the data; LEN is the number of characters.
5506 OBJECT is the Lisp object that the data comes from. If OBJECT is
5507 nil or t, it means that the data comes from C string.
5509 If OBJECT is not nil, the data is encoded by PROC's coding-system
5510 for encoding before it is sent.
5512 This function can evaluate Lisp code and can garbage collect. */
5515 send_process (volatile Lisp_Object proc
, const unsigned char *volatile buf
,
5516 volatile EMACS_INT len
, volatile Lisp_Object object
)
5518 /* Use volatile to protect variables from being clobbered by longjmp. */
5519 struct Lisp_Process
*p
= XPROCESS (proc
);
5521 struct coding_system
*coding
;
5522 struct gcpro gcpro1
;
5523 SIGTYPE (*volatile old_sigpipe
) (int);
5527 if (p
->raw_status_new
)
5529 if (! EQ (p
->status
, Qrun
))
5530 error ("Process %s not running", SDATA (p
->name
));
5532 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5534 coding
= proc_encode_coding_system
[p
->outfd
];
5535 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5537 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5538 || (BUFFERP (object
)
5539 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5542 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
5543 /* The coding system for encoding was changed to raw-text
5544 because we sent a unibyte text previously. Now we are
5545 sending a multibyte text, thus we must encode it by the
5546 original coding system specified for the current process. */
5547 setup_coding_system (p
->encode_coding_system
, coding
);
5548 coding
->src_multibyte
= 1;
5552 /* For sending a unibyte text, character code conversion should
5553 not take place but EOL conversion should. So, setup raw-text
5554 or one of the subsidiary if we have not yet done it. */
5555 if (CODING_REQUIRE_ENCODING (coding
))
5557 if (CODING_REQUIRE_FLUSHING (coding
))
5559 /* But, before changing the coding, we must flush out data. */
5560 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5561 send_process (proc
, "", 0, Qt
);
5562 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
5564 setup_coding_system (raw_text_coding_system
5565 (Vlast_coding_system_used
),
5567 coding
->src_multibyte
= 0;
5570 coding
->dst_multibyte
= 0;
5572 if (CODING_REQUIRE_ENCODING (coding
))
5574 coding
->dst_object
= Qt
;
5575 if (BUFFERP (object
))
5577 EMACS_INT from_byte
, from
, to
;
5578 EMACS_INT save_pt
, save_pt_byte
;
5579 struct buffer
*cur
= current_buffer
;
5581 set_buffer_internal (XBUFFER (object
));
5582 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
5584 from_byte
= PTR_BYTE_POS (buf
);
5585 from
= BYTE_TO_CHAR (from_byte
);
5586 to
= BYTE_TO_CHAR (from_byte
+ len
);
5587 TEMP_SET_PT_BOTH (from
, from_byte
);
5588 encode_coding_object (coding
, object
, from
, from_byte
,
5589 to
, from_byte
+ len
, Qt
);
5590 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
5591 set_buffer_internal (cur
);
5593 else if (STRINGP (object
))
5595 encode_coding_object (coding
, object
, 0, 0, SCHARS (object
),
5596 SBYTES (object
), Qt
);
5600 coding
->dst_object
= make_unibyte_string (buf
, len
);
5601 coding
->produced
= len
;
5604 len
= coding
->produced
;
5605 object
= coding
->dst_object
;
5606 buf
= SDATA (object
);
5609 if (pty_max_bytes
== 0)
5611 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5612 pty_max_bytes
= fpathconf (p
->outfd
, _PC_MAX_CANON
);
5613 if (pty_max_bytes
< 0)
5614 pty_max_bytes
= 250;
5616 pty_max_bytes
= 250;
5618 /* Deduct one, to leave space for the eof. */
5622 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5623 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5624 when returning with longjmp despite being declared volatile. */
5625 if (!setjmp (send_process_frame
))
5627 process_sent_to
= proc
;
5630 EMACS_INT
this = len
;
5632 /* Send this batch, using one or more write calls. */
5635 int outfd
= p
->outfd
;
5636 old_sigpipe
= (SIGTYPE (*) (int)) signal (SIGPIPE
, send_process_trap
);
5637 #ifdef DATAGRAM_SOCKETS
5638 if (DATAGRAM_CHAN_P (outfd
))
5640 rv
= sendto (outfd
, (char *) buf
, this,
5641 0, datagram_address
[outfd
].sa
,
5642 datagram_address
[outfd
].len
);
5643 if (rv
< 0 && errno
== EMSGSIZE
)
5645 signal (SIGPIPE
, old_sigpipe
);
5646 report_file_error ("sending datagram",
5647 Fcons (proc
, Qnil
));
5654 if (XPROCESS (proc
)->gnutls_p
)
5655 rv
= emacs_gnutls_write (outfd
,
5657 (char *) buf
, this);
5660 rv
= emacs_write (outfd
, (char *) buf
, this);
5661 #ifdef ADAPTIVE_READ_BUFFERING
5662 if (p
->read_output_delay
> 0
5663 && p
->adaptive_read_buffering
== 1)
5665 p
->read_output_delay
= 0;
5666 process_output_delay_count
--;
5667 p
->read_output_skip
= 0;
5671 signal (SIGPIPE
, old_sigpipe
);
5677 || errno
== EWOULDBLOCK
5683 /* Buffer is full. Wait, accepting input;
5684 that may allow the program
5685 to finish doing output and read more. */
5689 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5690 /* A gross hack to work around a bug in FreeBSD.
5691 In the following sequence, read(2) returns
5695 write(2) 954 bytes, get EAGAIN
5696 read(2) 1024 bytes in process_read_output
5697 read(2) 11 bytes in process_read_output
5699 That is, read(2) returns more bytes than have
5700 ever been written successfully. The 1033 bytes
5701 read are the 1022 bytes written successfully
5702 after processing (for example with CRs added if
5703 the terminal is set up that way which it is
5704 here). The same bytes will be seen again in a
5705 later read(2), without the CRs. */
5707 if (errno
== EAGAIN
)
5710 ioctl (p
->outfd
, TIOCFLUSH
, &flags
);
5712 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5714 /* Running filters might relocate buffers or strings.
5715 Arrange to relocate BUF. */
5716 if (BUFFERP (object
))
5717 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5718 else if (STRINGP (object
))
5719 offset
= buf
- SDATA (object
);
5721 #ifdef EMACS_HAS_USECS
5722 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5724 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5727 if (BUFFERP (object
))
5728 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5729 else if (STRINGP (object
))
5730 buf
= offset
+ SDATA (object
);
5735 /* This is a real error. */
5736 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5746 signal (SIGPIPE
, old_sigpipe
);
5747 proc
= process_sent_to
;
5748 p
= XPROCESS (proc
);
5749 p
->raw_status_new
= 0;
5750 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5751 p
->tick
= ++process_tick
;
5752 deactivate_process (proc
);
5753 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5759 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5761 doc
: /* Send current contents of region as input to PROCESS.
5762 PROCESS may be a process, a buffer, the name of a process or buffer, or
5763 nil, indicating the current buffer's process.
5764 Called from program, takes three arguments, PROCESS, START and END.
5765 If the region is more than 500 characters long,
5766 it is sent in several bunches. This may happen even for shorter regions.
5767 Output from processes can arrive in between bunches. */)
5768 (Lisp_Object process
, Lisp_Object start
, Lisp_Object end
)
5771 EMACS_INT start1
, end1
;
5773 proc
= get_process (process
);
5774 validate_region (&start
, &end
);
5776 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5777 move_gap (XINT (start
));
5779 start1
= CHAR_TO_BYTE (XINT (start
));
5780 end1
= CHAR_TO_BYTE (XINT (end
));
5781 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5782 Fcurrent_buffer ());
5787 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5789 doc
: /* Send PROCESS the contents of STRING as input.
5790 PROCESS may be a process, a buffer, the name of a process or buffer, or
5791 nil, indicating the current buffer's process.
5792 If STRING is more than 500 characters long,
5793 it is sent in several bunches. This may happen even for shorter strings.
5794 Output from processes can arrive in between bunches. */)
5795 (Lisp_Object process
, Lisp_Object string
)
5798 CHECK_STRING (string
);
5799 proc
= get_process (process
);
5800 send_process (proc
, SDATA (string
),
5801 SBYTES (string
), string
);
5805 /* Return the foreground process group for the tty/pty that
5806 the process P uses. */
5808 emacs_get_tty_pgrp (struct Lisp_Process
*p
)
5813 if (ioctl (p
->infd
, TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5816 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5817 master side. Try the slave side. */
5818 fd
= emacs_open (SDATA (p
->tty_name
), O_RDONLY
, 0);
5822 ioctl (fd
, TIOCGPGRP
, &gid
);
5826 #endif /* defined (TIOCGPGRP ) */
5831 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5832 Sprocess_running_child_p
, 0, 1, 0,
5833 doc
: /* Return t if PROCESS has given the terminal to a child.
5834 If the operating system does not make it possible to find out,
5835 return t unconditionally. */)
5836 (Lisp_Object process
)
5838 /* Initialize in case ioctl doesn't exist or gives an error,
5839 in a way that will cause returning t. */
5842 struct Lisp_Process
*p
;
5844 proc
= get_process (process
);
5845 p
= XPROCESS (proc
);
5847 if (!EQ (p
->type
, Qreal
))
5848 error ("Process %s is not a subprocess",
5851 error ("Process %s is not active",
5854 gid
= emacs_get_tty_pgrp (p
);
5861 /* send a signal number SIGNO to PROCESS.
5862 If CURRENT_GROUP is t, that means send to the process group
5863 that currently owns the terminal being used to communicate with PROCESS.
5864 This is used for various commands in shell mode.
5865 If CURRENT_GROUP is lambda, that means send to the process group
5866 that currently owns the terminal, but only if it is NOT the shell itself.
5868 If NOMSG is zero, insert signal-announcements into process's buffers
5871 If we can, we try to signal PROCESS by sending control characters
5872 down the pty. This allows us to signal inferiors who have changed
5873 their uid, for which killpg would return an EPERM error. */
5876 process_send_signal (Lisp_Object process
, int signo
, Lisp_Object current_group
,
5880 register struct Lisp_Process
*p
;
5884 proc
= get_process (process
);
5885 p
= XPROCESS (proc
);
5887 if (!EQ (p
->type
, Qreal
))
5888 error ("Process %s is not a subprocess",
5891 error ("Process %s is not active",
5895 current_group
= Qnil
;
5897 /* If we are using pgrps, get a pgrp number and make it negative. */
5898 if (NILP (current_group
))
5899 /* Send the signal to the shell's process group. */
5903 #ifdef SIGNALS_VIA_CHARACTERS
5904 /* If possible, send signals to the entire pgrp
5905 by sending an input character to it. */
5908 cc_t
*sig_char
= NULL
;
5910 tcgetattr (p
->infd
, &t
);
5915 sig_char
= &t
.c_cc
[VINTR
];
5919 sig_char
= &t
.c_cc
[VQUIT
];
5923 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5924 sig_char
= &t
.c_cc
[VSWTCH
];
5926 sig_char
= &t
.c_cc
[VSUSP
];
5931 if (sig_char
&& *sig_char
!= CDISABLE
)
5933 send_process (proc
, sig_char
, 1, Qnil
);
5936 /* If we can't send the signal with a character,
5937 fall through and send it another way. */
5939 /* The code above may fall through if it can't
5940 handle the signal. */
5941 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5944 /* Get the current pgrp using the tty itself, if we have that.
5945 Otherwise, use the pty to get the pgrp.
5946 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5947 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5948 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5949 His patch indicates that if TIOCGPGRP returns an error, then
5950 we should just assume that p->pid is also the process group id. */
5952 gid
= emacs_get_tty_pgrp (p
);
5955 /* If we can't get the information, assume
5956 the shell owns the tty. */
5959 /* It is not clear whether anything really can set GID to -1.
5960 Perhaps on some system one of those ioctls can or could do so.
5961 Or perhaps this is vestigial. */
5964 #else /* ! defined (TIOCGPGRP ) */
5965 /* Can't select pgrps on this system, so we know that
5966 the child itself heads the pgrp. */
5968 #endif /* ! defined (TIOCGPGRP ) */
5970 /* If current_group is lambda, and the shell owns the terminal,
5971 don't send any signal. */
5972 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
5980 p
->raw_status_new
= 0;
5982 p
->tick
= ++process_tick
;
5985 status_notify (NULL
);
5986 redisplay_preserve_echo_area (13);
5989 #endif /* ! defined (SIGCONT) */
5993 flush_pending_output (p
->infd
);
5997 /* If we don't have process groups, send the signal to the immediate
5998 subprocess. That isn't really right, but it's better than any
5999 obvious alternative. */
6002 kill (p
->pid
, signo
);
6006 /* gid may be a pid, or minus a pgrp's number */
6008 if (!NILP (current_group
))
6010 if (ioctl (p
->infd
, TIOCSIGSEND
, signo
) == -1)
6011 EMACS_KILLPG (gid
, signo
);
6018 #else /* ! defined (TIOCSIGSEND) */
6019 EMACS_KILLPG (gid
, signo
);
6020 #endif /* ! defined (TIOCSIGSEND) */
6023 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
6024 doc
: /* Interrupt process PROCESS.
6025 PROCESS may be a process, a buffer, or the name of a process or buffer.
6026 No arg or nil means current buffer's process.
6027 Second arg CURRENT-GROUP non-nil means send signal to
6028 the current process-group of the process's controlling terminal
6029 rather than to the process's own process group.
6030 If the process is a shell, this means interrupt current subjob
6031 rather than the shell.
6033 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6034 don't send the signal. */)
6035 (Lisp_Object process
, Lisp_Object current_group
)
6037 process_send_signal (process
, SIGINT
, current_group
, 0);
6041 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
6042 doc
: /* Kill process PROCESS. May be process or name of one.
6043 See function `interrupt-process' for more details on usage. */)
6044 (Lisp_Object process
, Lisp_Object current_group
)
6046 process_send_signal (process
, SIGKILL
, current_group
, 0);
6050 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
6051 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
6052 See function `interrupt-process' for more details on usage. */)
6053 (Lisp_Object process
, Lisp_Object current_group
)
6055 process_send_signal (process
, SIGQUIT
, current_group
, 0);
6059 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
6060 doc
: /* Stop process PROCESS. May be process or name of one.
6061 See function `interrupt-process' for more details on usage.
6062 If PROCESS is a network or serial process, inhibit handling of incoming
6064 (Lisp_Object process
, Lisp_Object current_group
)
6066 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
6068 struct Lisp_Process
*p
;
6070 p
= XPROCESS (process
);
6071 if (NILP (p
->command
)
6074 FD_CLR (p
->infd
, &input_wait_mask
);
6075 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6081 error ("No SIGTSTP support");
6083 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6088 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6089 doc
: /* Continue process PROCESS. May be process or name of one.
6090 See function `interrupt-process' for more details on usage.
6091 If PROCESS is a network or serial process, resume handling of incoming
6093 (Lisp_Object process
, Lisp_Object current_group
)
6095 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)))
6097 struct Lisp_Process
*p
;
6099 p
= XPROCESS (process
);
6100 if (EQ (p
->command
, Qt
)
6102 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6104 FD_SET (p
->infd
, &input_wait_mask
);
6105 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
6107 if (fd_info
[ p
->infd
].flags
& FILE_SERIAL
)
6108 PurgeComm (fd_info
[ p
->infd
].hnd
, PURGE_RXABORT
| PURGE_RXCLEAR
);
6109 #else /* not WINDOWSNT */
6110 tcflush (p
->infd
, TCIFLUSH
);
6111 #endif /* not WINDOWSNT */
6117 process_send_signal (process
, SIGCONT
, current_group
, 0);
6119 error ("No SIGCONT support");
6124 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6125 2, 2, "sProcess (name or number): \nnSignal code: ",
6126 doc
: /* Send PROCESS the signal with code SIGCODE.
6127 PROCESS may also be a number specifying the process id of the
6128 process to signal; in this case, the process need not be a child of
6130 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6131 (Lisp_Object process
, Lisp_Object sigcode
)
6135 if (INTEGERP (process
))
6137 pid
= XINT (process
);
6141 if (FLOATP (process
))
6143 pid
= (pid_t
) XFLOAT_DATA (process
);
6147 if (STRINGP (process
))
6150 if (tem
= Fget_process (process
), NILP (tem
))
6152 pid
= XINT (Fstring_to_number (process
, make_number (10)));
6159 process
= get_process (process
);
6164 CHECK_PROCESS (process
);
6165 pid
= XPROCESS (process
)->pid
;
6167 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6171 #define parse_signal(NAME, VALUE) \
6172 else if (!xstrcasecmp (name, NAME)) \
6173 XSETINT (sigcode, VALUE)
6175 if (INTEGERP (sigcode
))
6179 unsigned char *name
;
6181 CHECK_SYMBOL (sigcode
);
6182 name
= SDATA (SYMBOL_NAME (sigcode
));
6184 if (!strncmp (name
, "SIG", 3) || !strncmp (name
, "sig", 3))
6190 parse_signal ("usr1", SIGUSR1
);
6193 parse_signal ("usr2", SIGUSR2
);
6196 parse_signal ("term", SIGTERM
);
6199 parse_signal ("hup", SIGHUP
);
6202 parse_signal ("int", SIGINT
);
6205 parse_signal ("quit", SIGQUIT
);
6208 parse_signal ("ill", SIGILL
);
6211 parse_signal ("abrt", SIGABRT
);
6214 parse_signal ("emt", SIGEMT
);
6217 parse_signal ("kill", SIGKILL
);
6220 parse_signal ("fpe", SIGFPE
);
6223 parse_signal ("bus", SIGBUS
);
6226 parse_signal ("segv", SIGSEGV
);
6229 parse_signal ("sys", SIGSYS
);
6232 parse_signal ("pipe", SIGPIPE
);
6235 parse_signal ("alrm", SIGALRM
);
6238 parse_signal ("urg", SIGURG
);
6241 parse_signal ("stop", SIGSTOP
);
6244 parse_signal ("tstp", SIGTSTP
);
6247 parse_signal ("cont", SIGCONT
);
6250 parse_signal ("chld", SIGCHLD
);
6253 parse_signal ("ttin", SIGTTIN
);
6256 parse_signal ("ttou", SIGTTOU
);
6259 parse_signal ("io", SIGIO
);
6262 parse_signal ("xcpu", SIGXCPU
);
6265 parse_signal ("xfsz", SIGXFSZ
);
6268 parse_signal ("vtalrm", SIGVTALRM
);
6271 parse_signal ("prof", SIGPROF
);
6274 parse_signal ("winch", SIGWINCH
);
6277 parse_signal ("info", SIGINFO
);
6280 error ("Undefined signal name %s", name
);
6285 return make_number (kill (pid
, XINT (sigcode
)));
6288 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6289 doc
: /* Make PROCESS see end-of-file in its input.
6290 EOF comes after any text already sent to it.
6291 PROCESS may be a process, a buffer, the name of a process or buffer, or
6292 nil, indicating the current buffer's process.
6293 If PROCESS is a network connection, or is a process communicating
6294 through a pipe (as opposed to a pty), then you cannot send any more
6295 text to PROCESS after you call this function.
6296 If PROCESS is a serial process, wait until all output written to the
6297 process has been transmitted to the serial port. */)
6298 (Lisp_Object process
)
6301 struct coding_system
*coding
;
6303 if (DATAGRAM_CONN_P (process
))
6306 proc
= get_process (process
);
6307 coding
= proc_encode_coding_system
[XPROCESS (proc
)->outfd
];
6309 /* Make sure the process is really alive. */
6310 if (XPROCESS (proc
)->raw_status_new
)
6311 update_status (XPROCESS (proc
));
6312 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6313 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6315 if (CODING_REQUIRE_FLUSHING (coding
))
6317 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6318 send_process (proc
, "", 0, Qnil
);
6321 if (XPROCESS (proc
)->pty_flag
)
6322 send_process (proc
, "\004", 1, Qnil
);
6323 else if (EQ (XPROCESS (proc
)->type
, Qserial
))
6326 if (tcdrain (XPROCESS (proc
)->outfd
) != 0)
6327 error ("tcdrain() failed: %s", emacs_strerror (errno
));
6328 #endif /* not WINDOWSNT */
6329 /* Do nothing on Windows because writes are blocking. */
6333 int old_outfd
, new_outfd
;
6335 #ifdef HAVE_SHUTDOWN
6336 /* If this is a network connection, or socketpair is used
6337 for communication with the subprocess, call shutdown to cause EOF.
6338 (In some old system, shutdown to socketpair doesn't work.
6339 Then we just can't win.) */
6340 if (EQ (XPROCESS (proc
)->type
, Qnetwork
)
6341 || XPROCESS (proc
)->outfd
== XPROCESS (proc
)->infd
)
6342 shutdown (XPROCESS (proc
)->outfd
, 1);
6343 /* In case of socketpair, outfd == infd, so don't close it. */
6344 if (XPROCESS (proc
)->outfd
!= XPROCESS (proc
)->infd
)
6345 emacs_close (XPROCESS (proc
)->outfd
);
6346 #else /* not HAVE_SHUTDOWN */
6347 emacs_close (XPROCESS (proc
)->outfd
);
6348 #endif /* not HAVE_SHUTDOWN */
6349 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6352 old_outfd
= XPROCESS (proc
)->outfd
;
6354 if (!proc_encode_coding_system
[new_outfd
])
6355 proc_encode_coding_system
[new_outfd
]
6356 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6357 memcpy (proc_encode_coding_system
[new_outfd
],
6358 proc_encode_coding_system
[old_outfd
],
6359 sizeof (struct coding_system
));
6360 memset (proc_encode_coding_system
[old_outfd
], 0,
6361 sizeof (struct coding_system
));
6363 XPROCESS (proc
)->outfd
= new_outfd
;
6368 /* On receipt of a signal that a child status has changed, loop asking
6369 about children with changed statuses until the system says there
6372 All we do is change the status; we do not run sentinels or print
6373 notifications. That is saved for the next time keyboard input is
6374 done, in order to avoid timing errors.
6376 ** WARNING: this can be called during garbage collection.
6377 Therefore, it must not be fooled by the presence of mark bits in
6380 ** USG WARNING: Although it is not obvious from the documentation
6381 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6382 signal() before executing at least one wait(), otherwise the
6383 handler will be called again, resulting in an infinite loop. The
6384 relevant portion of the documentation reads "SIGCLD signals will be
6385 queued and the signal-catching function will be continually
6386 reentered until the queue is empty". Invoking signal() causes the
6387 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6390 ** Malloc WARNING: This should never call malloc either directly or
6391 indirectly; if it does, that is a bug */
6395 sigchld_handler (int signo
)
6397 int old_errno
= errno
;
6399 struct Lisp_Process
*p
;
6401 SIGNAL_THREAD_CHECK (signo
);
6412 #endif /* no WUNTRACED */
6413 /* Keep trying to get a status until we get a definitive result. */
6417 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6419 while (pid
< 0 && errno
== EINTR
);
6423 /* PID == 0 means no processes found, PID == -1 means a real
6424 failure. We have done all our job, so return. */
6431 #endif /* no WNOHANG */
6433 /* Find the process that signaled us, and record its status. */
6435 /* The process can have been deleted by Fdelete_process. */
6436 for (tail
= deleted_pid_list
; CONSP (tail
); tail
= XCDR (tail
))
6438 Lisp_Object xpid
= XCAR (tail
);
6439 if ((INTEGERP (xpid
) && pid
== (pid_t
) XINT (xpid
))
6440 || (FLOATP (xpid
) && pid
== (pid_t
) XFLOAT_DATA (xpid
)))
6442 XSETCAR (tail
, Qnil
);
6443 goto sigchld_end_of_loop
;
6447 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6449 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6451 proc
= XCDR (XCAR (tail
));
6452 p
= XPROCESS (proc
);
6453 if (EQ (p
->type
, Qreal
) && p
->pid
== pid
)
6458 /* Look for an asynchronous process whose pid hasn't been filled
6461 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6463 proc
= XCDR (XCAR (tail
));
6464 p
= XPROCESS (proc
);
6470 /* Change the status of the process that was found. */
6473 int clear_desc_flag
= 0;
6475 p
->tick
= ++process_tick
;
6477 p
->raw_status_new
= 1;
6479 /* If process has terminated, stop waiting for its output. */
6480 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6482 clear_desc_flag
= 1;
6484 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6485 if (clear_desc_flag
)
6487 FD_CLR (p
->infd
, &input_wait_mask
);
6488 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6491 /* Tell wait_reading_process_output that it needs to wake up and
6493 if (input_available_clear_time
)
6494 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6497 /* There was no asynchronous process found for that pid: we have
6498 a synchronous process. */
6501 synch_process_alive
= 0;
6503 /* Report the status of the synchronous process. */
6505 synch_process_retcode
= WRETCODE (w
);
6506 else if (WIFSIGNALED (w
))
6507 synch_process_termsig
= WTERMSIG (w
);
6509 /* Tell wait_reading_process_output that it needs to wake up and
6511 if (input_available_clear_time
)
6512 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6515 sigchld_end_of_loop
:
6518 /* On some systems, we must return right away.
6519 If any more processes want to signal us, we will
6521 Otherwise (on systems that have WNOHANG), loop around
6522 to use up all the processes that have something to tell us. */
6523 #if (defined WINDOWSNT \
6524 || (defined USG && !defined GNU_LINUX \
6525 && !(defined HPUX && defined WNOHANG)))
6528 #endif /* USG, but not HPUX with WNOHANG */
6531 #endif /* SIGCHLD */
6535 exec_sentinel_unwind (Lisp_Object data
)
6537 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6542 exec_sentinel_error_handler (Lisp_Object error
)
6544 cmd_error_internal (error
, "error in process sentinel: ");
6546 update_echo_area ();
6547 Fsleep_for (make_number (2), Qnil
);
6552 exec_sentinel (Lisp_Object proc
, Lisp_Object reason
)
6554 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6555 register struct Lisp_Process
*p
= XPROCESS (proc
);
6556 int count
= SPECPDL_INDEX ();
6557 int outer_running_asynch_code
= running_asynch_code
;
6558 int waiting
= waiting_for_user_input_p
;
6560 if (inhibit_sentinels
)
6563 /* No need to gcpro these, because all we do with them later
6564 is test them for EQness, and none of them should be a string. */
6565 odeactivate
= Vdeactivate_mark
;
6566 XSETBUFFER (obuffer
, current_buffer
);
6567 okeymap
= current_buffer
->keymap
;
6569 /* There's no good reason to let sentinels change the current
6570 buffer, and many callers of accept-process-output, sit-for, and
6571 friends don't expect current-buffer to be changed from under them. */
6572 record_unwind_protect (set_buffer_if_live
, Fcurrent_buffer ());
6574 sentinel
= p
->sentinel
;
6575 if (NILP (sentinel
))
6578 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6579 assure that it gets restored no matter how the sentinel exits. */
6581 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6582 /* Inhibit quit so that random quits don't screw up a running filter. */
6583 specbind (Qinhibit_quit
, Qt
);
6584 specbind (Qlast_nonmenu_event
, Qt
); /* Why? --Stef */
6586 /* In case we get recursively called,
6587 and we already saved the match data nonrecursively,
6588 save the same match data in safely recursive fashion. */
6589 if (outer_running_asynch_code
)
6592 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6593 restore_search_regs ();
6594 record_unwind_save_match_data ();
6595 Fset_match_data (tem
, Qt
);
6598 /* For speed, if a search happens within this code,
6599 save the match data in a special nonrecursive fashion. */
6600 running_asynch_code
= 1;
6602 internal_condition_case_1 (read_process_output_call
,
6604 Fcons (proc
, Fcons (reason
, Qnil
))),
6605 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6606 exec_sentinel_error_handler
);
6608 /* If we saved the match data nonrecursively, restore it now. */
6609 restore_search_regs ();
6610 running_asynch_code
= outer_running_asynch_code
;
6612 Vdeactivate_mark
= odeactivate
;
6614 /* Restore waiting_for_user_input_p as it was
6615 when we were called, in case the filter clobbered it. */
6616 waiting_for_user_input_p
= waiting
;
6619 if (! EQ (Fcurrent_buffer (), obuffer
)
6620 || ! EQ (current_buffer
->keymap
, okeymap
))
6622 /* But do it only if the caller is actually going to read events.
6623 Otherwise there's no need to make him wake up, and it could
6624 cause trouble (for example it would make sit_for return). */
6625 if (waiting_for_user_input_p
== -1)
6626 record_asynch_buffer_change ();
6628 unbind_to (count
, Qnil
);
6631 /* Report all recent events of a change in process status
6632 (either run the sentinel or output a message).
6633 This is usually done while Emacs is waiting for keyboard input
6634 but can be done at other times. */
6637 status_notify (struct Lisp_Process
*deleting_process
)
6639 register Lisp_Object proc
, buffer
;
6640 Lisp_Object tail
, msg
;
6641 struct gcpro gcpro1
, gcpro2
;
6645 /* We need to gcpro tail; if read_process_output calls a filter
6646 which deletes a process and removes the cons to which tail points
6647 from Vprocess_alist, and then causes a GC, tail is an unprotected
6651 /* Set this now, so that if new processes are created by sentinels
6652 that we run, we get called again to handle their status changes. */
6653 update_tick
= process_tick
;
6655 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6658 register struct Lisp_Process
*p
;
6660 proc
= Fcdr (XCAR (tail
));
6661 p
= XPROCESS (proc
);
6663 if (p
->tick
!= p
->update_tick
)
6665 p
->update_tick
= p
->tick
;
6667 /* If process is still active, read any output that remains. */
6668 while (! EQ (p
->filter
, Qt
)
6669 && ! EQ (p
->status
, Qconnect
)
6670 && ! EQ (p
->status
, Qlisten
)
6671 /* Network or serial process not stopped: */
6672 && ! EQ (p
->command
, Qt
)
6674 && p
!= deleting_process
6675 && read_process_output (proc
, p
->infd
) > 0);
6679 /* Get the text to use for the message. */
6680 if (p
->raw_status_new
)
6682 msg
= status_message (p
);
6684 /* If process is terminated, deactivate it or delete it. */
6686 if (CONSP (p
->status
))
6687 symbol
= XCAR (p
->status
);
6689 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6690 || EQ (symbol
, Qclosed
))
6692 if (delete_exited_processes
)
6693 remove_process (proc
);
6695 deactivate_process (proc
);
6698 /* The actions above may have further incremented p->tick.
6699 So set p->update_tick again
6700 so that an error in the sentinel will not cause
6701 this code to be run again. */
6702 p
->update_tick
= p
->tick
;
6703 /* Now output the message suitably. */
6704 if (!NILP (p
->sentinel
))
6705 exec_sentinel (proc
, msg
);
6706 /* Don't bother with a message in the buffer
6707 when a process becomes runnable. */
6708 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6711 struct buffer
*old
= current_buffer
;
6712 EMACS_INT opoint
, opoint_byte
;
6713 EMACS_INT before
, before_byte
;
6715 /* Avoid error if buffer is deleted
6716 (probably that's why the process is dead, too) */
6717 if (NILP (XBUFFER (buffer
)->name
))
6719 Fset_buffer (buffer
);
6722 opoint_byte
= PT_BYTE
;
6723 /* Insert new output into buffer
6724 at the current end-of-output marker,
6725 thus preserving logical ordering of input and output. */
6726 if (XMARKER (p
->mark
)->buffer
)
6727 Fgoto_char (p
->mark
);
6729 SET_PT_BOTH (ZV
, ZV_BYTE
);
6732 before_byte
= PT_BYTE
;
6734 tem
= current_buffer
->read_only
;
6735 current_buffer
->read_only
= Qnil
;
6736 insert_string ("\nProcess ");
6737 Finsert (1, &p
->name
);
6738 insert_string (" ");
6740 current_buffer
->read_only
= tem
;
6741 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6743 if (opoint
>= before
)
6744 SET_PT_BOTH (opoint
+ (PT
- before
),
6745 opoint_byte
+ (PT_BYTE
- before_byte
));
6747 SET_PT_BOTH (opoint
, opoint_byte
);
6749 set_buffer_internal (old
);
6754 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6759 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6760 Sset_process_coding_system
, 1, 3, 0,
6761 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6762 DECODING will be used to decode subprocess output and ENCODING to
6763 encode subprocess input. */)
6764 (register Lisp_Object process
, Lisp_Object decoding
, Lisp_Object encoding
)
6766 register struct Lisp_Process
*p
;
6768 CHECK_PROCESS (process
);
6769 p
= XPROCESS (process
);
6771 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6773 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6774 Fcheck_coding_system (decoding
);
6775 Fcheck_coding_system (encoding
);
6776 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
6777 p
->decode_coding_system
= decoding
;
6778 p
->encode_coding_system
= encoding
;
6779 setup_process_coding_systems (process
);
6784 DEFUN ("process-coding-system",
6785 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6786 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6787 (register Lisp_Object process
)
6789 CHECK_PROCESS (process
);
6790 return Fcons (XPROCESS (process
)->decode_coding_system
,
6791 XPROCESS (process
)->encode_coding_system
);
6794 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6795 Sset_process_filter_multibyte
, 2, 2, 0,
6796 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6797 If FLAG is non-nil, the filter is given multibyte strings.
6798 If FLAG is nil, the filter is given unibyte strings. In this case,
6799 all character code conversion except for end-of-line conversion is
6801 (Lisp_Object process
, Lisp_Object flag
)
6803 register struct Lisp_Process
*p
;
6805 CHECK_PROCESS (process
);
6806 p
= XPROCESS (process
);
6808 p
->decode_coding_system
= raw_text_coding_system (p
->decode_coding_system
);
6809 setup_process_coding_systems (process
);
6814 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6815 Sprocess_filter_multibyte_p
, 1, 1, 0,
6816 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6817 (Lisp_Object process
)
6819 register struct Lisp_Process
*p
;
6820 struct coding_system
*coding
;
6822 CHECK_PROCESS (process
);
6823 p
= XPROCESS (process
);
6824 coding
= proc_decode_coding_system
[p
->infd
];
6825 return (CODING_FOR_UNIBYTE (coding
) ? Qnil
: Qt
);
6832 add_gpm_wait_descriptor (int desc
)
6834 add_keyboard_wait_descriptor (desc
);
6838 delete_gpm_wait_descriptor (int desc
)
6840 delete_keyboard_wait_descriptor (desc
);
6843 /* Return nonzero if *MASK has a bit set
6844 that corresponds to one of the keyboard input descriptors. */
6847 keyboard_bit_set (fd_set
*mask
)
6851 for (fd
= 0; fd
<= max_input_desc
; fd
++)
6852 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6853 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6859 #else /* not subprocesses */
6861 /* Defined on msdos.c. */
6862 extern int sys_select (int, SELECT_TYPE
*, SELECT_TYPE
*, SELECT_TYPE
*,
6865 /* Implementation of wait_reading_process_output, assuming that there
6866 are no subprocesses. Used only by the MS-DOS build.
6868 Wait for timeout to elapse and/or keyboard input to be available.
6871 timeout in seconds, or
6872 zero for no limit, or
6873 -1 means gobble data immediately available but don't wait for any.
6875 read_kbd is a Lisp_Object:
6876 0 to ignore keyboard input, or
6877 1 to return when input is available, or
6878 -1 means caller will actually read the input, so don't throw to
6881 see full version for other parameters. We know that wait_proc will
6882 always be NULL, since `subprocesses' isn't defined.
6884 do_display != 0 means redisplay should be done to show subprocess
6885 output that arrives.
6887 Return true if we received input from any process. */
6890 wait_reading_process_output (int time_limit
, int microsecs
, int read_kbd
,
6892 Lisp_Object wait_for_cell
,
6893 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
6896 EMACS_TIME end_time
, timeout
;
6897 SELECT_TYPE waitchannels
;
6900 /* What does time_limit really mean? */
6901 if (time_limit
|| microsecs
)
6903 EMACS_GET_TIME (end_time
);
6904 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
6905 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
6908 /* Turn off periodic alarms (in case they are in use)
6909 and then turn off any other atimers,
6910 because the select emulator uses alarms. */
6912 turn_on_atimers (0);
6916 int timeout_reduced_for_timers
= 0;
6918 /* If calling from keyboard input, do not quit
6919 since we want to return C-g as an input character.
6920 Otherwise, do pending quit if requested. */
6924 /* Exit now if the cell we're waiting for became non-nil. */
6925 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6928 /* Compute time from now till when time limit is up */
6929 /* Exit if already run out */
6930 if (time_limit
== -1)
6932 /* -1 specified for timeout means
6933 gobble output available now
6934 but don't wait at all. */
6936 EMACS_SET_SECS_USECS (timeout
, 0, 0);
6938 else if (time_limit
|| microsecs
)
6940 EMACS_GET_TIME (timeout
);
6941 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
6942 if (EMACS_TIME_NEG_P (timeout
))
6947 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
6950 /* If our caller will not immediately handle keyboard events,
6951 run timer events directly.
6952 (Callers that will immediately read keyboard events
6953 call timer_delay on their own.) */
6954 if (NILP (wait_for_cell
))
6956 EMACS_TIME timer_delay
;
6960 int old_timers_run
= timers_run
;
6961 timer_delay
= timer_check (1);
6962 if (timers_run
!= old_timers_run
&& do_display
)
6963 /* We must retry, since a timer may have requeued itself
6964 and that could alter the time delay. */
6965 redisplay_preserve_echo_area (14);
6969 while (!detect_input_pending ());
6971 /* If there is unread keyboard input, also return. */
6973 && requeued_events_pending_p ())
6976 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
6978 EMACS_TIME difference
;
6979 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
6980 if (EMACS_TIME_NEG_P (difference
))
6982 timeout
= timer_delay
;
6983 timeout_reduced_for_timers
= 1;
6988 /* Cause C-g and alarm signals to take immediate action,
6989 and cause input available signals to zero out timeout. */
6991 set_waiting_for_input (&timeout
);
6993 /* Wait till there is something to do. */
6995 if (! read_kbd
&& NILP (wait_for_cell
))
6996 FD_ZERO (&waitchannels
);
6998 FD_SET (0, &waitchannels
);
7000 /* If a frame has been newly mapped and needs updating,
7001 reprocess its display stuff. */
7002 if (frame_garbaged
&& do_display
)
7004 clear_waiting_for_input ();
7005 redisplay_preserve_echo_area (15);
7007 set_waiting_for_input (&timeout
);
7010 if (read_kbd
&& detect_input_pending ())
7013 FD_ZERO (&waitchannels
);
7016 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7021 /* Make C-g and alarm signals set flags again */
7022 clear_waiting_for_input ();
7024 /* If we woke up due to SIGWINCH, actually change size now. */
7025 do_pending_window_change (0);
7027 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7028 /* We waited the full specified time, so return now. */
7033 /* If the system call was interrupted, then go around the
7035 if (xerrno
== EINTR
)
7036 FD_ZERO (&waitchannels
);
7038 error ("select error: %s", emacs_strerror (xerrno
));
7041 /* Check for keyboard input */
7044 && detect_input_pending_run_timers (do_display
))
7046 swallow_events (do_display
);
7047 if (detect_input_pending_run_timers (do_display
))
7051 /* If there is unread keyboard input, also return. */
7053 && requeued_events_pending_p ())
7056 /* If wait_for_cell. check for keyboard input
7057 but don't run any timers.
7058 ??? (It seems wrong to me to check for keyboard
7059 input at all when wait_for_cell, but the code
7060 has been this way since July 1994.
7061 Try changing this after version 19.31.) */
7062 if (! NILP (wait_for_cell
)
7063 && detect_input_pending ())
7065 swallow_events (do_display
);
7066 if (detect_input_pending ())
7070 /* Exit now if the cell we're waiting for became non-nil. */
7071 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7080 #endif /* not subprocesses */
7082 /* The following functions are needed even if async subprocesses are
7083 not supported. Some of them are no-op stubs in that case. */
7085 /* Add DESC to the set of keyboard input descriptors. */
7088 add_keyboard_wait_descriptor (int desc
)
7090 #ifdef subprocesses /* actually means "not MSDOS" */
7091 FD_SET (desc
, &input_wait_mask
);
7092 FD_SET (desc
, &non_process_wait_mask
);
7093 if (desc
> max_input_desc
)
7094 max_input_desc
= desc
;
7098 /* From now on, do not expect DESC to give keyboard input. */
7101 delete_keyboard_wait_descriptor (int desc
)
7105 int lim
= max_input_desc
;
7107 FD_CLR (desc
, &input_wait_mask
);
7108 FD_CLR (desc
, &non_process_wait_mask
);
7110 if (desc
== max_input_desc
)
7111 for (fd
= 0; fd
< lim
; fd
++)
7112 if (FD_ISSET (fd
, &input_wait_mask
) || FD_ISSET (fd
, &write_mask
))
7113 max_input_desc
= fd
;
7117 /* Setup coding systems of PROCESS. */
7120 setup_process_coding_systems (Lisp_Object process
)
7123 struct Lisp_Process
*p
= XPROCESS (process
);
7125 int outch
= p
->outfd
;
7126 Lisp_Object coding_system
;
7128 if (inch
< 0 || outch
< 0)
7131 if (!proc_decode_coding_system
[inch
])
7132 proc_decode_coding_system
[inch
]
7133 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
7134 coding_system
= p
->decode_coding_system
;
7135 if (! NILP (p
->filter
))
7137 else if (BUFFERP (p
->buffer
))
7139 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
7140 coding_system
= raw_text_coding_system (coding_system
);
7142 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
7144 if (!proc_encode_coding_system
[outch
])
7145 proc_encode_coding_system
[outch
]
7146 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
7147 setup_coding_system (p
->encode_coding_system
,
7148 proc_encode_coding_system
[outch
]);
7152 /* Close all descriptors currently in use for communication
7153 with subprocess. This is used in a newly-forked subprocess
7154 to get rid of irrelevant descriptors. */
7157 close_process_descs (void)
7161 for (i
= 0; i
< MAXDESC
; i
++)
7163 Lisp_Object process
;
7164 process
= chan_process
[i
];
7165 if (!NILP (process
))
7167 int in
= XPROCESS (process
)->infd
;
7168 int out
= XPROCESS (process
)->outfd
;
7171 if (out
>= 0 && in
!= out
)
7178 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7179 doc
: /* Return the (or a) process associated with BUFFER.
7180 BUFFER may be a buffer or the name of one. */)
7181 (register Lisp_Object buffer
)
7184 register Lisp_Object buf
, tail
, proc
;
7186 if (NILP (buffer
)) return Qnil
;
7187 buf
= Fget_buffer (buffer
);
7188 if (NILP (buf
)) return Qnil
;
7190 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
7192 proc
= Fcdr (XCAR (tail
));
7193 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
7196 #endif /* subprocesses */
7200 DEFUN ("process-inherit-coding-system-flag",
7201 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7203 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
7204 If this flag is t, `buffer-file-coding-system' of the buffer
7205 associated with PROCESS will inherit the coding system used to decode
7206 the process output. */)
7207 (register Lisp_Object process
)
7210 CHECK_PROCESS (process
);
7211 return XPROCESS (process
)->inherit_coding_system_flag
? Qt
: Qnil
;
7213 /* Ignore the argument and return the value of
7214 inherit-process-coding-system. */
7215 return inherit_process_coding_system
? Qt
: Qnil
;
7219 /* Kill all processes associated with `buffer'.
7220 If `buffer' is nil, kill all processes */
7223 kill_buffer_processes (Lisp_Object buffer
)
7226 Lisp_Object tail
, proc
;
7228 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
7230 proc
= XCDR (XCAR (tail
));
7232 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
7234 if (NETCONN_P (proc
) || SERIALCONN_P (proc
))
7235 Fdelete_process (proc
);
7236 else if (XPROCESS (proc
)->infd
>= 0)
7237 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
7240 #else /* subprocesses */
7241 /* Since we have no subprocesses, this does nothing. */
7242 #endif /* subprocesses */
7245 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
7247 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
7248 This is intended for use by asynchronous process output filters and sentinels. */)
7252 return (waiting_for_user_input_p
? Qt
: Qnil
);
7258 /* Stop reading input from keyboard sources. */
7261 hold_keyboard_input (void)
7266 /* Resume reading input from keyboard sources. */
7269 unhold_keyboard_input (void)
7274 /* Return non-zero if keyboard input is on hold, zero otherwise. */
7277 kbd_on_hold_p (void)
7279 return kbd_is_on_hold
;
7283 /* Enumeration of and access to system processes a-la ps(1). */
7285 DEFUN ("list-system-processes", Flist_system_processes
, Slist_system_processes
,
7287 doc
: /* Return a list of numerical process IDs of all running processes.
7288 If this functionality is unsupported, return nil.
7290 See `process-attributes' for getting attributes of a process given its ID. */)
7293 return list_system_processes ();
7296 DEFUN ("process-attributes", Fprocess_attributes
,
7297 Sprocess_attributes
, 1, 1, 0,
7298 doc
: /* Return attributes of the process given by its PID, a number.
7300 Value is an alist where each element is a cons cell of the form
7304 If this functionality is unsupported, the value is nil.
7306 See `list-system-processes' for getting a list of all process IDs.
7308 The KEYs of the attributes that this function may return are listed
7309 below, together with the type of the associated VALUE (in parentheses).
7310 Not all platforms support all of these attributes; unsupported
7311 attributes will not appear in the returned alist.
7312 Unless explicitly indicated otherwise, numbers can have either
7313 integer or floating point values.
7315 euid -- Effective user User ID of the process (number)
7316 user -- User name corresponding to euid (string)
7317 egid -- Effective user Group ID of the process (number)
7318 group -- Group name corresponding to egid (string)
7319 comm -- Command name (executable name only) (string)
7320 state -- Process state code, such as "S", "R", or "T" (string)
7321 ppid -- Parent process ID (number)
7322 pgrp -- Process group ID (number)
7323 sess -- Session ID, i.e. process ID of session leader (number)
7324 ttname -- Controlling tty name (string)
7325 tpgid -- ID of foreground process group on the process's tty (number)
7326 minflt -- number of minor page faults (number)
7327 majflt -- number of major page faults (number)
7328 cminflt -- cumulative number of minor page faults (number)
7329 cmajflt -- cumulative number of major page faults (number)
7330 utime -- user time used by the process, in the (HIGH LOW USEC) format
7331 stime -- system time used by the process, in the (HIGH LOW USEC) format
7332 time -- sum of utime and stime, in the (HIGH LOW USEC) format
7333 cutime -- user time used by the process and its children, (HIGH LOW USEC)
7334 cstime -- system time used by the process and its children, (HIGH LOW USEC)
7335 ctime -- sum of cutime and cstime, in the (HIGH LOW USEC) format
7336 pri -- priority of the process (number)
7337 nice -- nice value of the process (number)
7338 thcount -- process thread count (number)
7339 start -- time the process started, in the (HIGH LOW USEC) format
7340 vsize -- virtual memory size of the process in KB's (number)
7341 rss -- resident set size of the process in KB's (number)
7342 etime -- elapsed time the process is running, in (HIGH LOW USEC) format
7343 pcpu -- percents of CPU time used by the process (floating-point number)
7344 pmem -- percents of total physical memory used by process's resident set
7345 (floating-point number)
7346 args -- command line which invoked the process (string). */)
7349 return system_process_attributes (pid
);
7359 inhibit_sentinels
= 0;
7363 if (! noninteractive
|| initialized
)
7365 signal (SIGCHLD
, sigchld_handler
);
7368 FD_ZERO (&input_wait_mask
);
7369 FD_ZERO (&non_keyboard_wait_mask
);
7370 FD_ZERO (&non_process_wait_mask
);
7371 FD_ZERO (&write_mask
);
7372 max_process_desc
= 0;
7373 memset (fd_callback_info
, 0, sizeof (fd_callback_info
));
7375 #ifdef NON_BLOCKING_CONNECT
7376 FD_ZERO (&connect_wait_mask
);
7377 num_pending_connects
= 0;
7380 #ifdef ADAPTIVE_READ_BUFFERING
7381 process_output_delay_count
= 0;
7382 process_output_skip
= 0;
7385 /* Don't do this, it caused infinite select loops. The display
7386 method should call add_keyboard_wait_descriptor on stdin if it
7389 FD_SET (0, &input_wait_mask
);
7392 Vprocess_alist
= Qnil
;
7394 deleted_pid_list
= Qnil
;
7396 for (i
= 0; i
< MAXDESC
; i
++)
7398 chan_process
[i
] = Qnil
;
7399 proc_buffered_char
[i
] = -1;
7401 memset (proc_decode_coding_system
, 0, sizeof proc_decode_coding_system
);
7402 memset (proc_encode_coding_system
, 0, sizeof proc_encode_coding_system
);
7403 #ifdef DATAGRAM_SOCKETS
7404 memset (datagram_address
, 0, sizeof datagram_address
);
7408 Lisp_Object subfeatures
= Qnil
;
7409 const struct socket_options
*sopt
;
7411 #define ADD_SUBFEATURE(key, val) \
7412 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
7414 #ifdef NON_BLOCKING_CONNECT
7415 ADD_SUBFEATURE (QCnowait
, Qt
);
7417 #ifdef DATAGRAM_SOCKETS
7418 ADD_SUBFEATURE (QCtype
, Qdatagram
);
7420 #ifdef HAVE_SEQPACKET
7421 ADD_SUBFEATURE (QCtype
, Qseqpacket
);
7423 #ifdef HAVE_LOCAL_SOCKETS
7424 ADD_SUBFEATURE (QCfamily
, Qlocal
);
7426 ADD_SUBFEATURE (QCfamily
, Qipv4
);
7428 ADD_SUBFEATURE (QCfamily
, Qipv6
);
7430 #ifdef HAVE_GETSOCKNAME
7431 ADD_SUBFEATURE (QCservice
, Qt
);
7433 #if defined(O_NONBLOCK) || defined(O_NDELAY)
7434 ADD_SUBFEATURE (QCserver
, Qt
);
7437 for (sopt
= socket_options
; sopt
->name
; sopt
++)
7438 subfeatures
= pure_cons (intern_c_string (sopt
->name
), subfeatures
);
7440 Fprovide (intern_c_string ("make-network-process"), subfeatures
);
7443 #if defined (DARWIN_OS)
7444 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7445 processes. As such, we only change the default value. */
7448 const char *release
= get_operating_system_release ();
7449 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
7450 && release
[1] == '.')) {
7451 Vprocess_connection_type
= Qnil
;
7455 #endif /* subprocesses */
7460 syms_of_process (void)
7464 Qprocessp
= intern_c_string ("processp");
7465 staticpro (&Qprocessp
);
7466 Qrun
= intern_c_string ("run");
7468 Qstop
= intern_c_string ("stop");
7470 Qsignal
= intern_c_string ("signal");
7471 staticpro (&Qsignal
);
7473 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7476 Qexit = intern_c_string ("exit");
7477 staticpro (&Qexit); */
7479 Qopen
= intern_c_string ("open");
7481 Qclosed
= intern_c_string ("closed");
7482 staticpro (&Qclosed
);
7483 Qconnect
= intern_c_string ("connect");
7484 staticpro (&Qconnect
);
7485 Qfailed
= intern_c_string ("failed");
7486 staticpro (&Qfailed
);
7487 Qlisten
= intern_c_string ("listen");
7488 staticpro (&Qlisten
);
7489 Qlocal
= intern_c_string ("local");
7490 staticpro (&Qlocal
);
7491 Qipv4
= intern_c_string ("ipv4");
7494 Qipv6
= intern_c_string ("ipv6");
7497 Qdatagram
= intern_c_string ("datagram");
7498 staticpro (&Qdatagram
);
7499 Qseqpacket
= intern_c_string ("seqpacket");
7500 staticpro (&Qseqpacket
);
7502 QCport
= intern_c_string (":port");
7503 staticpro (&QCport
);
7504 QCspeed
= intern_c_string (":speed");
7505 staticpro (&QCspeed
);
7506 QCprocess
= intern_c_string (":process");
7507 staticpro (&QCprocess
);
7509 QCbytesize
= intern_c_string (":bytesize");
7510 staticpro (&QCbytesize
);
7511 QCstopbits
= intern_c_string (":stopbits");
7512 staticpro (&QCstopbits
);
7513 QCparity
= intern_c_string (":parity");
7514 staticpro (&QCparity
);
7515 Qodd
= intern_c_string ("odd");
7517 Qeven
= intern_c_string ("even");
7519 QCflowcontrol
= intern_c_string (":flowcontrol");
7520 staticpro (&QCflowcontrol
);
7521 Qhw
= intern_c_string ("hw");
7523 Qsw
= intern_c_string ("sw");
7525 QCsummary
= intern_c_string (":summary");
7526 staticpro (&QCsummary
);
7528 Qreal
= intern_c_string ("real");
7530 Qnetwork
= intern_c_string ("network");
7531 staticpro (&Qnetwork
);
7532 Qserial
= intern_c_string ("serial");
7533 staticpro (&Qserial
);
7534 QCbuffer
= intern_c_string (":buffer");
7535 staticpro (&QCbuffer
);
7536 QChost
= intern_c_string (":host");
7537 staticpro (&QChost
);
7538 QCservice
= intern_c_string (":service");
7539 staticpro (&QCservice
);
7540 QClocal
= intern_c_string (":local");
7541 staticpro (&QClocal
);
7542 QCremote
= intern_c_string (":remote");
7543 staticpro (&QCremote
);
7544 QCcoding
= intern_c_string (":coding");
7545 staticpro (&QCcoding
);
7546 QCserver
= intern_c_string (":server");
7547 staticpro (&QCserver
);
7548 QCnowait
= intern_c_string (":nowait");
7549 staticpro (&QCnowait
);
7550 QCsentinel
= intern_c_string (":sentinel");
7551 staticpro (&QCsentinel
);
7552 QClog
= intern_c_string (":log");
7554 QCnoquery
= intern_c_string (":noquery");
7555 staticpro (&QCnoquery
);
7556 QCstop
= intern_c_string (":stop");
7557 staticpro (&QCstop
);
7558 QCoptions
= intern_c_string (":options");
7559 staticpro (&QCoptions
);
7560 QCplist
= intern_c_string (":plist");
7561 staticpro (&QCplist
);
7563 Qlast_nonmenu_event
= intern_c_string ("last-nonmenu-event");
7564 staticpro (&Qlast_nonmenu_event
);
7566 staticpro (&Vprocess_alist
);
7568 staticpro (&deleted_pid_list
);
7571 #endif /* subprocesses */
7573 QCname
= intern_c_string (":name");
7574 staticpro (&QCname
);
7575 QCtype
= intern_c_string (":type");
7576 staticpro (&QCtype
);
7578 Qeuid
= intern_c_string ("euid");
7580 Qegid
= intern_c_string ("egid");
7582 Quser
= intern_c_string ("user");
7584 Qgroup
= intern_c_string ("group");
7585 staticpro (&Qgroup
);
7586 Qcomm
= intern_c_string ("comm");
7588 Qstate
= intern_c_string ("state");
7589 staticpro (&Qstate
);
7590 Qppid
= intern_c_string ("ppid");
7592 Qpgrp
= intern_c_string ("pgrp");
7594 Qsess
= intern_c_string ("sess");
7596 Qttname
= intern_c_string ("ttname");
7597 staticpro (&Qttname
);
7598 Qtpgid
= intern_c_string ("tpgid");
7599 staticpro (&Qtpgid
);
7600 Qminflt
= intern_c_string ("minflt");
7601 staticpro (&Qminflt
);
7602 Qmajflt
= intern_c_string ("majflt");
7603 staticpro (&Qmajflt
);
7604 Qcminflt
= intern_c_string ("cminflt");
7605 staticpro (&Qcminflt
);
7606 Qcmajflt
= intern_c_string ("cmajflt");
7607 staticpro (&Qcmajflt
);
7608 Qutime
= intern_c_string ("utime");
7609 staticpro (&Qutime
);
7610 Qstime
= intern_c_string ("stime");
7611 staticpro (&Qstime
);
7612 Qtime
= intern_c_string ("time");
7614 Qcutime
= intern_c_string ("cutime");
7615 staticpro (&Qcutime
);
7616 Qcstime
= intern_c_string ("cstime");
7617 staticpro (&Qcstime
);
7618 Qctime
= intern_c_string ("ctime");
7619 staticpro (&Qctime
);
7620 Qpri
= intern_c_string ("pri");
7622 Qnice
= intern_c_string ("nice");
7624 Qthcount
= intern_c_string ("thcount");
7625 staticpro (&Qthcount
);
7626 Qstart
= intern_c_string ("start");
7627 staticpro (&Qstart
);
7628 Qvsize
= intern_c_string ("vsize");
7629 staticpro (&Qvsize
);
7630 Qrss
= intern_c_string ("rss");
7632 Qetime
= intern_c_string ("etime");
7633 staticpro (&Qetime
);
7634 Qpcpu
= intern_c_string ("pcpu");
7636 Qpmem
= intern_c_string ("pmem");
7638 Qargs
= intern_c_string ("args");
7641 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
7642 doc
: /* *Non-nil means delete processes immediately when they exit.
7643 A value of nil means don't delete them until `list-processes' is run. */);
7645 delete_exited_processes
= 1;
7648 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
7649 doc
: /* Control type of device used to communicate with subprocesses.
7650 Values are nil to use a pipe, or t or `pty' to use a pty.
7651 The value has no effect if the system has no ptys or if all ptys are busy:
7652 then a pipe is used in any case.
7653 The value takes effect when `start-process' is called. */);
7654 Vprocess_connection_type
= Qt
;
7656 #ifdef ADAPTIVE_READ_BUFFERING
7657 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
7658 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7659 On some systems, when Emacs reads the output from a subprocess, the output data
7660 is read in very small blocks, potentially resulting in very poor performance.
7661 This behavior can be remedied to some extent by setting this variable to a
7662 non-nil value, as it will automatically delay reading from such processes, to
7663 allow them to produce more output before Emacs tries to read it.
7664 If the value is t, the delay is reset after each write to the process; any other
7665 non-nil value means that the delay is not reset on write.
7666 The variable takes effect when `start-process' is called. */);
7667 Vprocess_adaptive_read_buffering
= Qt
;
7670 defsubr (&Sprocessp
);
7671 defsubr (&Sget_process
);
7672 defsubr (&Sdelete_process
);
7673 defsubr (&Sprocess_status
);
7674 defsubr (&Sprocess_exit_status
);
7675 defsubr (&Sprocess_id
);
7676 defsubr (&Sprocess_name
);
7677 defsubr (&Sprocess_tty_name
);
7678 defsubr (&Sprocess_command
);
7679 defsubr (&Sset_process_buffer
);
7680 defsubr (&Sprocess_buffer
);
7681 defsubr (&Sprocess_mark
);
7682 defsubr (&Sset_process_filter
);
7683 defsubr (&Sprocess_filter
);
7684 defsubr (&Sset_process_sentinel
);
7685 defsubr (&Sprocess_sentinel
);
7686 defsubr (&Sset_process_window_size
);
7687 defsubr (&Sset_process_inherit_coding_system_flag
);
7688 defsubr (&Sset_process_query_on_exit_flag
);
7689 defsubr (&Sprocess_query_on_exit_flag
);
7690 defsubr (&Sprocess_contact
);
7691 defsubr (&Sprocess_plist
);
7692 defsubr (&Sset_process_plist
);
7693 defsubr (&Slist_processes
);
7694 defsubr (&Sprocess_list
);
7695 defsubr (&Sstart_process
);
7696 defsubr (&Sserial_process_configure
);
7697 defsubr (&Smake_serial_process
);
7698 defsubr (&Sset_network_process_option
);
7699 defsubr (&Smake_network_process
);
7700 defsubr (&Sformat_network_address
);
7701 #if defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7703 defsubr (&Snetwork_interface_list
);
7705 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7706 defsubr (&Snetwork_interface_info
);
7708 #endif /* defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H) */
7709 #ifdef DATAGRAM_SOCKETS
7710 defsubr (&Sprocess_datagram_address
);
7711 defsubr (&Sset_process_datagram_address
);
7713 defsubr (&Saccept_process_output
);
7714 defsubr (&Sprocess_send_region
);
7715 defsubr (&Sprocess_send_string
);
7716 defsubr (&Sinterrupt_process
);
7717 defsubr (&Skill_process
);
7718 defsubr (&Squit_process
);
7719 defsubr (&Sstop_process
);
7720 defsubr (&Scontinue_process
);
7721 defsubr (&Sprocess_running_child_p
);
7722 defsubr (&Sprocess_send_eof
);
7723 defsubr (&Ssignal_process
);
7724 defsubr (&Swaiting_for_user_input_p
);
7725 defsubr (&Sprocess_type
);
7726 defsubr (&Sset_process_coding_system
);
7727 defsubr (&Sprocess_coding_system
);
7728 defsubr (&Sset_process_filter_multibyte
);
7729 defsubr (&Sprocess_filter_multibyte_p
);
7731 #endif /* subprocesses */
7733 defsubr (&Sget_buffer_process
);
7734 defsubr (&Sprocess_inherit_coding_system_flag
);
7735 defsubr (&Slist_system_processes
);
7736 defsubr (&Sprocess_attributes
);
7739 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7740 (do not change this comment) */