1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999,
3 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
26 /* This file is split into two parts by the following preprocessor
27 conditional. The 'then' clause contains all of the support for
28 asynchronous subprocesses. The 'else' clause contains stub
29 versions of some of the asynchronous subprocess routines that are
30 often called elsewhere in Emacs, so we don't have to #ifdef the
31 sections that call them. */
39 #include <sys/types.h> /* some typedefs are used in sys/file.h */
46 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
49 #endif /* not WINDOWSNT */
51 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
52 #include <sys/socket.h>
54 #include <netinet/in.h>
55 #include <arpa/inet.h>
56 #ifdef NEED_NET_ERRNO_H
57 #include <net/errno.h>
58 #endif /* NEED_NET_ERRNO_H */
60 /* Are local (unix) sockets supported? */
61 #if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
62 #if !defined (AF_LOCAL) && defined (AF_UNIX)
63 #define AF_LOCAL AF_UNIX
66 #define HAVE_LOCAL_SOCKETS
70 #endif /* HAVE_SOCKETS */
72 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
77 /* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
78 #ifdef HAVE_BROKEN_INET_ADDR
79 #define IN_ADDR struct in_addr
80 #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
82 #define IN_ADDR unsigned long
83 #define NUMERIC_ADDR_ERROR (numeric_addr == -1)
86 #if defined(BSD_SYSTEM) || defined(STRIDE)
87 #include <sys/ioctl.h>
88 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
90 #endif /* HAVE_PTYS and no O_NDELAY */
91 #endif /* BSD_SYSTEM || STRIDE */
93 #ifdef BROKEN_O_NONBLOCK
95 #endif /* BROKEN_O_NONBLOCK */
101 /* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
103 #if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
104 /* sys/ioctl.h may have been included already */
106 #include <sys/ioctl.h>
113 #include <sys/sysmacros.h> /* for "minor" */
114 #endif /* not IRIS */
117 #include <sys/wait.h>
129 #include "termhooks.h"
130 #include "termopts.h"
131 #include "commands.h"
132 #include "keyboard.h"
134 #include "blockinput.h"
135 #include "dispextern.h"
136 #include "composite.h"
139 Lisp_Object Qprocessp
;
140 Lisp_Object Qrun
, Qstop
, Qsignal
;
141 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
142 Lisp_Object Qlocal
, Qdatagram
;
143 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
144 Lisp_Object QClocal
, QCremote
, QCcoding
;
145 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
146 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
147 Lisp_Object QCfilter_multibyte
;
148 Lisp_Object Qlast_nonmenu_event
;
149 /* QCfamily is declared and initialized in xfaces.c,
150 QCfilter in keyboard.c. */
151 extern Lisp_Object QCfamily
, QCfilter
;
153 /* Qexit is declared and initialized in eval.c. */
155 /* QCfamily is defined in xfaces.c. */
156 extern Lisp_Object QCfamily
;
157 /* QCfilter is defined in keyboard.c. */
158 extern Lisp_Object QCfilter
;
160 /* a process object is a network connection when its childp field is neither
161 Qt nor Qnil but is instead a property list (KEY VAL ...). */
164 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
165 #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
167 #define NETCONN_P(p) 0
168 #define NETCONN1_P(p) 0
169 #endif /* HAVE_SOCKETS */
171 /* Define first descriptor number available for subprocesses. */
173 #define FIRST_PROC_DESC 1
175 #define FIRST_PROC_DESC 3
178 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
181 #if !defined (SIGCHLD) && defined (SIGCLD)
182 #define SIGCHLD SIGCLD
185 #include "syssignal.h"
189 extern void set_waiting_for_input
P_ ((EMACS_TIME
*));
195 extern char *sys_errlist
[];
202 /* t means use pty, nil means use a pipe,
203 maybe other values to come. */
204 static Lisp_Object Vprocess_connection_type
;
208 #include <sys/socket.h>
212 /* These next two vars are non-static since sysdep.c uses them in the
213 emulation of `select'. */
214 /* Number of events of change of status of a process. */
216 /* Number of events for which the user or sentinel has been notified. */
219 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
221 #ifdef BROKEN_NON_BLOCKING_CONNECT
222 #undef NON_BLOCKING_CONNECT
224 #ifndef NON_BLOCKING_CONNECT
227 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
228 #if defined (O_NONBLOCK) || defined (O_NDELAY)
229 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
230 #define NON_BLOCKING_CONNECT
231 #endif /* EWOULDBLOCK || EINPROGRESS */
232 #endif /* O_NONBLOCK || O_NDELAY */
233 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
234 #endif /* HAVE_SELECT */
235 #endif /* HAVE_SOCKETS */
236 #endif /* NON_BLOCKING_CONNECT */
237 #endif /* BROKEN_NON_BLOCKING_CONNECT */
239 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
240 this system. We need to read full packets, so we need a
241 "non-destructive" select. So we require either native select,
242 or emulation of select using FIONREAD. */
244 #ifdef BROKEN_DATAGRAM_SOCKETS
245 #undef DATAGRAM_SOCKETS
247 #ifndef DATAGRAM_SOCKETS
249 #if defined (HAVE_SELECT) || defined (FIONREAD)
250 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
251 #define DATAGRAM_SOCKETS
252 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
253 #endif /* HAVE_SELECT || FIONREAD */
254 #endif /* HAVE_SOCKETS */
255 #endif /* DATAGRAM_SOCKETS */
256 #endif /* BROKEN_DATAGRAM_SOCKETS */
259 #undef NON_BLOCKING_CONNECT
260 #undef DATAGRAM_SOCKETS
263 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
264 #ifdef EMACS_HAS_USECS
265 #define ADAPTIVE_READ_BUFFERING
269 #ifdef ADAPTIVE_READ_BUFFERING
270 #define READ_OUTPUT_DELAY_INCREMENT 10000
271 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
272 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
274 /* Number of processes which might be delayed. */
276 static int process_output_delay_count
;
278 /* Non-zero if any process has non-nil process_output_skip. */
280 static int process_output_skip
;
282 /* Non-nil means to delay reading process output to improve buffering.
283 A value of t means that delay is reset after each send, any other
284 non-nil value does not reset the delay. */
285 static Lisp_Object Vprocess_adaptive_read_buffering
;
287 #define process_output_delay_count 0
291 #include "sysselect.h"
293 extern int keyboard_bit_set
P_ ((SELECT_TYPE
*));
295 /* If we support a window system, turn on the code to poll periodically
296 to detect C-g. It isn't actually used when doing interrupt input. */
297 #ifdef HAVE_WINDOW_SYSTEM
298 #define POLL_FOR_INPUT
301 /* Mask of bits indicating the descriptors that we wait for input on. */
303 static SELECT_TYPE input_wait_mask
;
305 /* Mask that excludes keyboard input descriptor (s). */
307 static SELECT_TYPE non_keyboard_wait_mask
;
309 /* Mask that excludes process input descriptor (s). */
311 static SELECT_TYPE non_process_wait_mask
;
313 /* Mask of bits indicating the descriptors that we wait for connect to
314 complete on. Once they complete, they are removed from this mask
315 and added to the input_wait_mask and non_keyboard_wait_mask. */
317 static SELECT_TYPE connect_wait_mask
;
319 /* Number of bits set in connect_wait_mask. */
320 static int num_pending_connects
;
322 /* The largest descriptor currently in use for a process object. */
323 static int max_process_desc
;
325 /* The largest descriptor currently in use for keyboard input. */
326 static int max_keyboard_desc
;
328 /* Nonzero means delete a process right away if it exits. */
329 static int delete_exited_processes
;
331 /* Indexed by descriptor, gives the process (if any) for that descriptor */
332 Lisp_Object chan_process
[MAXDESC
];
334 /* Alist of elements (NAME . PROCESS) */
335 Lisp_Object Vprocess_alist
;
337 /* Buffered-ahead input char from process, indexed by channel.
338 -1 means empty (no char is buffered).
339 Used on sys V where the only way to tell if there is any
340 output from the process is to read at least one char.
341 Always -1 on systems that support FIONREAD. */
343 /* Don't make static; need to access externally. */
344 int proc_buffered_char
[MAXDESC
];
346 /* Table of `struct coding-system' for each process. */
347 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
348 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
350 #ifdef DATAGRAM_SOCKETS
351 /* Table of `partner address' for datagram sockets. */
352 struct sockaddr_and_len
{
355 } datagram_address
[MAXDESC
];
356 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
357 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
359 #define DATAGRAM_CHAN_P(chan) (0)
360 #define DATAGRAM_CONN_P(proc) (0)
363 static Lisp_Object
get_process ();
364 static void exec_sentinel ();
366 extern EMACS_TIME
timer_check ();
367 extern int timers_run
;
369 /* Maximum number of bytes to send to a pty without an eof. */
370 static int pty_max_bytes
;
372 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
378 /* The file name of the pty opened by allocate_pty. */
380 static char pty_name
[24];
383 /* Compute the Lisp form of the process status, p->status, from
384 the numeric status that was returned by `wait'. */
386 Lisp_Object
status_convert ();
390 struct Lisp_Process
*p
;
392 union { int i
; WAITTYPE wt
; } u
;
393 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
394 p
->status
= status_convert (u
.wt
);
395 p
->raw_status_low
= Qnil
;
396 p
->raw_status_high
= Qnil
;
399 /* Convert a process status word in Unix format to
400 the list that we use internally. */
407 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
408 else if (WIFEXITED (w
))
409 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
410 WCOREDUMP (w
) ? Qt
: Qnil
));
411 else if (WIFSIGNALED (w
))
412 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
413 WCOREDUMP (w
) ? Qt
: Qnil
));
418 /* Given a status-list, extract the three pieces of information
419 and store them individually through the three pointers. */
422 decode_status (l
, symbol
, code
, coredump
)
440 *code
= XFASTINT (XCAR (tem
));
442 *coredump
= !NILP (tem
);
446 /* Return a string describing a process status list. */
449 status_message (status
)
454 Lisp_Object string
, string2
;
456 decode_status (status
, &symbol
, &code
, &coredump
);
458 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
461 synchronize_system_messages_locale ();
462 signame
= strsignal (code
);
465 string
= build_string (signame
);
466 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
467 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
468 return concat2 (string
, string2
);
470 else if (EQ (symbol
, Qexit
))
473 return build_string ("finished\n");
474 string
= Fnumber_to_string (make_number (code
));
475 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
476 return concat3 (build_string ("exited abnormally with code "),
479 else if (EQ (symbol
, Qfailed
))
481 string
= Fnumber_to_string (make_number (code
));
482 string2
= build_string ("\n");
483 return concat3 (build_string ("failed with code "),
487 return Fcopy_sequence (Fsymbol_name (symbol
));
492 /* Open an available pty, returning a file descriptor.
493 Return -1 on failure.
494 The file name of the terminal corresponding to the pty
495 is left in the variable pty_name. */
506 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
507 for (i
= 0; i
< 16; i
++)
510 struct stat stb
; /* Used in some PTY_OPEN. */
511 #ifdef PTY_NAME_SPRINTF
514 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
515 #endif /* no PTY_NAME_SPRINTF */
519 #else /* no PTY_OPEN */
522 /* Unusual IRIS code */
523 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
526 if (fstat (fd
, &stb
) < 0)
528 # else /* not IRIS */
529 { /* Some systems name their pseudoterminals so that there are gaps in
530 the usual sequence - for example, on HP9000/S700 systems, there
531 are no pseudoterminals with names ending in 'f'. So we wait for
532 three failures in a row before deciding that we've reached the
534 int failed_count
= 0;
536 if (stat (pty_name
, &stb
) < 0)
539 if (failed_count
>= 3)
546 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
548 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
550 # endif /* not IRIS */
552 #endif /* no PTY_OPEN */
556 /* check to make certain that both sides are available
557 this avoids a nasty yet stupid bug in rlogins */
558 #ifdef PTY_TTY_NAME_SPRINTF
561 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
562 #endif /* no PTY_TTY_NAME_SPRINTF */
564 if (access (pty_name
, 6) != 0)
567 # if !defined(IRIS) && !defined(__sgi)
573 #endif /* not UNIPLUS */
580 #endif /* HAVE_PTYS */
586 register Lisp_Object val
, tem
, name1
;
587 register struct Lisp_Process
*p
;
591 p
= allocate_process ();
593 XSETINT (p
->infd
, -1);
594 XSETINT (p
->outfd
, -1);
595 XSETFASTINT (p
->pid
, 0);
596 XSETFASTINT (p
->tick
, 0);
597 XSETFASTINT (p
->update_tick
, 0);
598 p
->raw_status_low
= Qnil
;
599 p
->raw_status_high
= Qnil
;
601 p
->mark
= Fmake_marker ();
603 #ifdef ADAPTIVE_READ_BUFFERING
604 p
->adaptive_read_buffering
= Qnil
;
605 XSETFASTINT (p
->read_output_delay
, 0);
606 p
->read_output_skip
= Qnil
;
609 /* If name is already in use, modify it until it is unused. */
614 tem
= Fget_process (name1
);
615 if (NILP (tem
)) break;
616 sprintf (suffix
, "<%d>", i
);
617 name1
= concat2 (name
, build_string (suffix
));
621 XSETPROCESS (val
, p
);
622 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
627 remove_process (proc
)
628 register Lisp_Object proc
;
630 register Lisp_Object pair
;
632 pair
= Frassq (proc
, Vprocess_alist
);
633 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
635 deactivate_process (proc
);
638 /* Setup coding systems of PROCESS. */
641 setup_process_coding_systems (process
)
644 struct Lisp_Process
*p
= XPROCESS (process
);
645 int inch
= XINT (p
->infd
);
646 int outch
= XINT (p
->outfd
);
648 if (inch
< 0 || outch
< 0)
651 if (!proc_decode_coding_system
[inch
])
652 proc_decode_coding_system
[inch
]
653 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
654 setup_coding_system (p
->decode_coding_system
,
655 proc_decode_coding_system
[inch
]);
656 if (! NILP (p
->filter
))
658 if (NILP (p
->filter_multibyte
))
659 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
661 else if (BUFFERP (p
->buffer
))
663 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
664 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
667 if (!proc_encode_coding_system
[outch
])
668 proc_encode_coding_system
[outch
]
669 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
670 setup_coding_system (p
->encode_coding_system
,
671 proc_encode_coding_system
[outch
]);
674 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
675 doc
: /* Return t if OBJECT is a process. */)
679 return PROCESSP (object
) ? Qt
: Qnil
;
682 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
683 doc
: /* Return the process named NAME, or nil if there is none. */)
685 register Lisp_Object name
;
690 return Fcdr (Fassoc (name
, Vprocess_alist
));
693 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
694 doc
: /* Return the (or a) process associated with BUFFER.
695 BUFFER may be a buffer or the name of one. */)
697 register Lisp_Object buffer
;
699 register Lisp_Object buf
, tail
, proc
;
701 if (NILP (buffer
)) return Qnil
;
702 buf
= Fget_buffer (buffer
);
703 if (NILP (buf
)) return Qnil
;
705 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
707 proc
= Fcdr (Fcar (tail
));
708 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
714 /* This is how commands for the user decode process arguments. It
715 accepts a process, a process name, a buffer, a buffer name, or nil.
716 Buffers denote the first process in the buffer, and nil denotes the
721 register Lisp_Object name
;
723 register Lisp_Object proc
, obj
;
726 obj
= Fget_process (name
);
728 obj
= Fget_buffer (name
);
730 error ("Process %s does not exist", SDATA (name
));
732 else if (NILP (name
))
733 obj
= Fcurrent_buffer ();
737 /* Now obj should be either a buffer object or a process object.
741 proc
= Fget_buffer_process (obj
);
743 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
753 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
754 doc
: /* Delete PROCESS: kill it and forget about it immediately.
755 PROCESS may be a process, a buffer, the name of a process or buffer, or
756 nil, indicating the current buffer's process. */)
758 register Lisp_Object process
;
760 process
= get_process (process
);
761 XPROCESS (process
)->raw_status_low
= Qnil
;
762 XPROCESS (process
)->raw_status_high
= Qnil
;
763 if (NETCONN_P (process
))
765 XPROCESS (process
)->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
766 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
768 else if (XINT (XPROCESS (process
)->infd
) >= 0)
770 Fkill_process (process
, Qnil
);
771 /* Do this now, since remove_process will make sigchld_handler do nothing. */
772 XPROCESS (process
)->status
773 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
774 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
777 remove_process (process
);
781 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
782 doc
: /* Return the status of PROCESS.
783 The returned value is one of the following symbols:
784 run -- for a process that is running.
785 stop -- for a process stopped but continuable.
786 exit -- for a process that has exited.
787 signal -- for a process that has got a fatal signal.
788 open -- for a network stream connection that is open.
789 listen -- for a network stream server that is listening.
790 closed -- for a network stream connection that is closed.
791 connect -- when waiting for a non-blocking connection to complete.
792 failed -- when a non-blocking connection has failed.
793 nil -- if arg is a process name and no such process exists.
794 PROCESS may be a process, a buffer, the name of a process, or
795 nil, indicating the current buffer's process. */)
797 register Lisp_Object process
;
799 register struct Lisp_Process
*p
;
800 register Lisp_Object status
;
802 if (STRINGP (process
))
803 process
= Fget_process (process
);
805 process
= get_process (process
);
810 p
= XPROCESS (process
);
811 if (!NILP (p
->raw_status_low
))
815 status
= XCAR (status
);
818 if (EQ (status
, Qexit
))
820 else if (EQ (p
->command
, Qt
))
822 else if (EQ (status
, Qrun
))
828 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
830 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
831 If PROCESS has not yet exited or died, return 0. */)
833 register Lisp_Object process
;
835 CHECK_PROCESS (process
);
836 if (!NILP (XPROCESS (process
)->raw_status_low
))
837 update_status (XPROCESS (process
));
838 if (CONSP (XPROCESS (process
)->status
))
839 return XCAR (XCDR (XPROCESS (process
)->status
));
840 return make_number (0);
843 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
844 doc
: /* Return the process id of PROCESS.
845 This is the pid of the external process which PROCESS uses or talks to.
846 For a network connection, this value is nil. */)
848 register Lisp_Object process
;
850 CHECK_PROCESS (process
);
851 return XPROCESS (process
)->pid
;
854 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
855 doc
: /* Return the name of PROCESS, as a string.
856 This is the name of the program invoked in PROCESS,
857 possibly modified to make it unique among process names. */)
859 register Lisp_Object process
;
861 CHECK_PROCESS (process
);
862 return XPROCESS (process
)->name
;
865 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
866 doc
: /* Return the command that was executed to start PROCESS.
867 This is a list of strings, the first string being the program executed
868 and the rest of the strings being the arguments given to it.
869 For a non-child channel, this is nil. */)
871 register Lisp_Object process
;
873 CHECK_PROCESS (process
);
874 return XPROCESS (process
)->command
;
877 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
878 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
879 This is the terminal that the process itself reads and writes on,
880 not the name of the pty that Emacs uses to talk with that terminal. */)
882 register Lisp_Object process
;
884 CHECK_PROCESS (process
);
885 return XPROCESS (process
)->tty_name
;
888 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
890 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
892 register Lisp_Object process
, buffer
;
894 struct Lisp_Process
*p
;
896 CHECK_PROCESS (process
);
898 CHECK_BUFFER (buffer
);
899 p
= XPROCESS (process
);
902 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
903 setup_process_coding_systems (process
);
907 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
909 doc
: /* Return the buffer PROCESS is associated with.
910 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
912 register Lisp_Object process
;
914 CHECK_PROCESS (process
);
915 return XPROCESS (process
)->buffer
;
918 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
920 doc
: /* Return the marker for the end of the last output from PROCESS. */)
922 register Lisp_Object process
;
924 CHECK_PROCESS (process
);
925 return XPROCESS (process
)->mark
;
928 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
930 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
931 t means stop accepting output from the process.
933 When a process has a filter, its buffer is not used for output.
934 Instead, each time it does output, the entire string of output is
935 passed to the filter.
937 The filter gets two arguments: the process and the string of output.
938 The string argument is normally a multibyte string, except:
939 - if the process' input coding system is no-conversion or raw-text,
940 it is a unibyte string (the non-converted input), or else
941 - if `default-enable-multibyte-characters' is nil, it is a unibyte
942 string (the result of converting the decoded input multibyte
943 string to unibyte with `string-make-unibyte'). */)
945 register Lisp_Object process
, filter
;
947 struct Lisp_Process
*p
;
949 CHECK_PROCESS (process
);
950 p
= XPROCESS (process
);
952 /* Don't signal an error if the process' input file descriptor
953 is closed. This could make debugging Lisp more difficult,
954 for example when doing something like
956 (setq process (start-process ...))
958 (set-process-filter process ...) */
960 if (XINT (p
->infd
) >= 0)
962 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
964 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
965 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
967 else if (EQ (p
->filter
, Qt
)
968 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
970 FD_SET (XINT (p
->infd
), &input_wait_mask
);
971 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
977 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
978 setup_process_coding_systems (process
);
982 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
984 doc
: /* Returns the filter function of PROCESS; nil if none.
985 See `set-process-filter' for more info on filter functions. */)
987 register Lisp_Object process
;
989 CHECK_PROCESS (process
);
990 return XPROCESS (process
)->filter
;
993 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
995 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
996 The sentinel is called as a function when the process changes state.
997 It gets two arguments: the process, and a string describing the change. */)
999 register Lisp_Object process
, sentinel
;
1001 struct Lisp_Process
*p
;
1003 CHECK_PROCESS (process
);
1004 p
= XPROCESS (process
);
1006 p
->sentinel
= sentinel
;
1008 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1012 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1014 doc
: /* Return the sentinel of PROCESS; nil if none.
1015 See `set-process-sentinel' for more info on sentinels. */)
1017 register Lisp_Object process
;
1019 CHECK_PROCESS (process
);
1020 return XPROCESS (process
)->sentinel
;
1023 DEFUN ("set-process-window-size", Fset_process_window_size
,
1024 Sset_process_window_size
, 3, 3, 0,
1025 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1026 (process
, height
, width
)
1027 register Lisp_Object process
, height
, width
;
1029 CHECK_PROCESS (process
);
1030 CHECK_NATNUM (height
);
1031 CHECK_NATNUM (width
);
1033 if (XINT (XPROCESS (process
)->infd
) < 0
1034 || set_window_size (XINT (XPROCESS (process
)->infd
),
1035 XINT (height
), XINT (width
)) <= 0)
1041 DEFUN ("set-process-inherit-coding-system-flag",
1042 Fset_process_inherit_coding_system_flag
,
1043 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1044 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1045 If the second argument FLAG is non-nil, then the variable
1046 `buffer-file-coding-system' of the buffer associated with PROCESS
1047 will be bound to the value of the coding system used to decode
1050 This is useful when the coding system specified for the process buffer
1051 leaves either the character code conversion or the end-of-line conversion
1052 unspecified, or if the coding system used to decode the process output
1053 is more appropriate for saving the process buffer.
1055 Binding the variable `inherit-process-coding-system' to non-nil before
1056 starting the process is an alternative way of setting the inherit flag
1057 for the process which will run. */)
1059 register Lisp_Object process
, flag
;
1061 CHECK_PROCESS (process
);
1062 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
1066 DEFUN ("process-inherit-coding-system-flag",
1067 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1069 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1070 If this flag is t, `buffer-file-coding-system' of the buffer
1071 associated with PROCESS will inherit the coding system used to decode
1072 the process output. */)
1074 register Lisp_Object process
;
1076 CHECK_PROCESS (process
);
1077 return XPROCESS (process
)->inherit_coding_system_flag
;
1080 DEFUN ("set-process-query-on-exit-flag",
1081 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1083 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1084 If the second argument FLAG is non-nil, Emacs will query the user before
1085 exiting if PROCESS is running. */)
1087 register Lisp_Object process
, flag
;
1089 CHECK_PROCESS (process
);
1090 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
1094 DEFUN ("process-query-on-exit-flag",
1095 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1097 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1099 register Lisp_Object process
;
1101 CHECK_PROCESS (process
);
1102 return Fnull (XPROCESS (process
)->kill_without_query
);
1105 #ifdef DATAGRAM_SOCKETS
1106 Lisp_Object
Fprocess_datagram_address ();
1109 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1111 doc
: /* Return the contact info of PROCESS; t for a real child.
1112 For a net connection, the value depends on the optional KEY arg.
1113 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1114 if KEY is t, the complete contact information for the connection is
1115 returned, else the specific value for the keyword KEY is returned.
1116 See `make-network-process' for a list of keywords. */)
1118 register Lisp_Object process
, key
;
1120 Lisp_Object contact
;
1122 CHECK_PROCESS (process
);
1123 contact
= XPROCESS (process
)->childp
;
1125 #ifdef DATAGRAM_SOCKETS
1126 if (DATAGRAM_CONN_P (process
)
1127 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1128 contact
= Fplist_put (contact
, QCremote
,
1129 Fprocess_datagram_address (process
));
1132 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1135 return Fcons (Fplist_get (contact
, QChost
),
1136 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1137 return Fplist_get (contact
, key
);
1140 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1142 doc
: /* Return the plist of PROCESS. */)
1144 register Lisp_Object process
;
1146 CHECK_PROCESS (process
);
1147 return XPROCESS (process
)->plist
;
1150 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1152 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1154 register Lisp_Object process
, plist
;
1156 CHECK_PROCESS (process
);
1159 XPROCESS (process
)->plist
= plist
;
1163 #if 0 /* Turned off because we don't currently record this info
1164 in the process. Perhaps add it. */
1165 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1166 doc
: /* Return the connection type of PROCESS.
1167 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1168 a socket connection. */)
1170 Lisp_Object process
;
1172 return XPROCESS (process
)->type
;
1177 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1179 doc
: /* Convert network ADDRESS from internal format to a string.
1180 If optional second argument OMIT-PORT is non-nil, don't include a port
1181 number in the string; in this case, interpret a 4 element vector as an
1182 IP address. Returns nil if format of ADDRESS is invalid. */)
1183 (address
, omit_port
)
1184 Lisp_Object address
, omit_port
;
1189 if (STRINGP (address
)) /* AF_LOCAL */
1192 if (VECTORP (address
)) /* AF_INET */
1194 register struct Lisp_Vector
*p
= XVECTOR (address
);
1195 Lisp_Object args
[6];
1198 if (!NILP (omit_port
) && (p
->size
== 4 || p
->size
== 5))
1200 args
[0] = build_string ("%d.%d.%d.%d");
1203 else if (p
->size
== 5)
1205 args
[0] = build_string ("%d.%d.%d.%d:%d");
1211 for (i
= 0; i
< nargs
; i
++)
1212 args
[i
+1] = p
->contents
[i
];
1213 return Fformat (nargs
+1, args
);
1216 if (CONSP (address
))
1218 Lisp_Object args
[2];
1219 args
[0] = build_string ("<Family %d>");
1220 args
[1] = Fcar (address
);
1221 return Fformat (2, args
);
1230 list_processes_1 (query_only
)
1231 Lisp_Object query_only
;
1233 register Lisp_Object tail
, tem
;
1234 Lisp_Object proc
, minspace
, tem1
;
1235 register struct Lisp_Process
*p
;
1237 int w_proc
, w_buffer
, w_tty
;
1238 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1240 w_proc
= 4; /* Proc */
1241 w_buffer
= 6; /* Buffer */
1242 w_tty
= 0; /* Omit if no ttys */
1244 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1248 proc
= Fcdr (Fcar (tail
));
1249 p
= XPROCESS (proc
);
1250 if (NILP (p
->childp
))
1252 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1254 if (STRINGP (p
->name
)
1255 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1257 if (!NILP (p
->buffer
))
1259 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1260 w_buffer
= 8; /* (Killed) */
1261 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1264 if (STRINGP (p
->tty_name
)
1265 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1269 XSETFASTINT (i_status
, w_proc
+ 1);
1270 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1273 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1274 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1277 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1280 XSETFASTINT (minspace
, 1);
1282 set_buffer_internal (XBUFFER (Vstandard_output
));
1283 Fbuffer_disable_undo (Vstandard_output
);
1285 current_buffer
->truncate_lines
= Qt
;
1287 write_string ("Proc", -1);
1288 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1289 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1292 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1294 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1295 write_string ("\n", -1);
1297 write_string ("----", -1);
1298 Findent_to (i_status
, minspace
); write_string ("------", -1);
1299 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1302 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1304 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1305 write_string ("\n", -1);
1307 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1311 proc
= Fcdr (Fcar (tail
));
1312 p
= XPROCESS (proc
);
1313 if (NILP (p
->childp
))
1315 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1318 Finsert (1, &p
->name
);
1319 Findent_to (i_status
, minspace
);
1321 if (!NILP (p
->raw_status_low
))
1324 if (CONSP (p
->status
))
1325 symbol
= XCAR (p
->status
);
1328 if (EQ (symbol
, Qsignal
))
1331 tem
= Fcar (Fcdr (p
->status
));
1333 if (XINT (tem
) < NSIG
)
1334 write_string (sys_errlist
[XINT (tem
)], -1);
1337 Fprinc (symbol
, Qnil
);
1339 else if (NETCONN1_P (p
))
1341 if (EQ (symbol
, Qexit
))
1342 write_string ("closed", -1);
1343 else if (EQ (p
->command
, Qt
))
1344 write_string ("stopped", -1);
1345 else if (EQ (symbol
, Qrun
))
1346 write_string ("open", -1);
1348 Fprinc (symbol
, Qnil
);
1351 Fprinc (symbol
, Qnil
);
1353 if (EQ (symbol
, Qexit
))
1356 tem
= Fcar (Fcdr (p
->status
));
1359 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1360 write_string (tembuf
, -1);
1364 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
1365 remove_process (proc
);
1367 Findent_to (i_buffer
, minspace
);
1368 if (NILP (p
->buffer
))
1369 insert_string ("(none)");
1370 else if (NILP (XBUFFER (p
->buffer
)->name
))
1371 insert_string ("(Killed)");
1373 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1377 Findent_to (i_tty
, minspace
);
1378 if (STRINGP (p
->tty_name
))
1379 Finsert (1, &p
->tty_name
);
1382 Findent_to (i_command
, minspace
);
1384 if (EQ (p
->status
, Qlisten
))
1386 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1387 if (INTEGERP (port
))
1388 port
= Fnumber_to_string (port
);
1390 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1391 sprintf (tembuf
, "(network %s server on %s)\n",
1392 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1393 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1394 insert_string (tembuf
);
1396 else if (NETCONN1_P (p
))
1398 /* For a local socket, there is no host name,
1399 so display service instead. */
1400 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1401 if (!STRINGP (host
))
1403 host
= Fplist_get (p
->childp
, QCservice
);
1404 if (INTEGERP (host
))
1405 host
= Fnumber_to_string (host
);
1408 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1409 sprintf (tembuf
, "(network %s connection to %s)\n",
1410 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1411 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1412 insert_string (tembuf
);
1424 insert_string (" ");
1426 insert_string ("\n");
1432 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1433 doc
: /* Display a list of all processes.
1434 If optional argument QUERY-ONLY is non-nil, only processes with
1435 the query-on-exit flag set will be listed.
1436 Any process listed as exited or signaled is actually eliminated
1437 after the listing is made. */)
1439 Lisp_Object query_only
;
1441 internal_with_output_to_temp_buffer ("*Process List*",
1442 list_processes_1
, query_only
);
1446 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1447 doc
: /* Return a list of all processes. */)
1450 return Fmapcar (Qcdr
, Vprocess_alist
);
1453 /* Starting asynchronous inferior processes. */
1455 static Lisp_Object
start_process_unwind ();
1457 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1458 doc
: /* Start a program in a subprocess. Return the process object for it.
1459 NAME is name for process. It is modified if necessary to make it unique.
1460 BUFFER is the buffer (or buffer name) to associate with the process.
1461 Process output goes at end of that buffer, unless you specify
1462 an output stream or filter function to handle the output.
1463 BUFFER may be also nil, meaning that this process is not associated
1465 PROGRAM is the program file name. It is searched for in PATH.
1466 Remaining arguments are strings to give program as arguments.
1468 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1471 register Lisp_Object
*args
;
1473 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1475 register unsigned char *new_argv
;
1478 register unsigned char **new_argv
;
1481 int count
= SPECPDL_INDEX ();
1485 buffer
= Fget_buffer_create (buffer
);
1487 /* Make sure that the child will be able to chdir to the current
1488 buffer's current directory, or its unhandled equivalent. We
1489 can't just have the child check for an error when it does the
1490 chdir, since it's in a vfork.
1492 We have to GCPRO around this because Fexpand_file_name and
1493 Funhandled_file_name_directory might call a file name handling
1494 function. The argument list is protected by the caller, so all
1495 we really have to worry about is buffer. */
1497 struct gcpro gcpro1
, gcpro2
;
1499 current_dir
= current_buffer
->directory
;
1501 GCPRO2 (buffer
, current_dir
);
1504 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1506 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1507 report_file_error ("Setting current directory",
1508 Fcons (current_buffer
->directory
, Qnil
));
1514 CHECK_STRING (name
);
1518 CHECK_STRING (program
);
1520 proc
= make_process (name
);
1521 /* If an error occurs and we can't start the process, we want to
1522 remove it from the process list. This means that each error
1523 check in create_process doesn't need to call remove_process
1524 itself; it's all taken care of here. */
1525 record_unwind_protect (start_process_unwind
, proc
);
1527 XPROCESS (proc
)->childp
= Qt
;
1528 XPROCESS (proc
)->plist
= Qnil
;
1529 XPROCESS (proc
)->command_channel_p
= Qnil
;
1530 XPROCESS (proc
)->buffer
= buffer
;
1531 XPROCESS (proc
)->sentinel
= Qnil
;
1532 XPROCESS (proc
)->filter
= Qnil
;
1533 XPROCESS (proc
)->filter_multibyte
1534 = buffer_defaults
.enable_multibyte_characters
;
1535 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1537 #ifdef ADAPTIVE_READ_BUFFERING
1538 XPROCESS (proc
)->adaptive_read_buffering
= Vprocess_adaptive_read_buffering
;
1541 /* Make the process marker point into the process buffer (if any). */
1543 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1544 BUF_ZV (XBUFFER (buffer
)),
1545 BUF_ZV_BYTE (XBUFFER (buffer
)));
1548 /* Decide coding systems for communicating with the process. Here
1549 we don't setup the structure coding_system nor pay attention to
1550 unibyte mode. They are done in create_process. */
1552 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1553 Lisp_Object coding_systems
= Qt
;
1554 Lisp_Object val
, *args2
;
1555 struct gcpro gcpro1
, gcpro2
;
1557 val
= Vcoding_system_for_read
;
1560 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1561 args2
[0] = Qstart_process
;
1562 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1563 GCPRO2 (proc
, current_dir
);
1564 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1566 if (CONSP (coding_systems
))
1567 val
= XCAR (coding_systems
);
1568 else if (CONSP (Vdefault_process_coding_system
))
1569 val
= XCAR (Vdefault_process_coding_system
);
1571 XPROCESS (proc
)->decode_coding_system
= val
;
1573 val
= Vcoding_system_for_write
;
1576 if (EQ (coding_systems
, Qt
))
1578 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1579 args2
[0] = Qstart_process
;
1580 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1581 GCPRO2 (proc
, current_dir
);
1582 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1585 if (CONSP (coding_systems
))
1586 val
= XCDR (coding_systems
);
1587 else if (CONSP (Vdefault_process_coding_system
))
1588 val
= XCDR (Vdefault_process_coding_system
);
1590 XPROCESS (proc
)->encode_coding_system
= val
;
1594 /* Make a one member argv with all args concatenated
1595 together separated by a blank. */
1596 len
= SBYTES (program
) + 2;
1597 for (i
= 3; i
< nargs
; i
++)
1601 len
+= SBYTES (tem
) + 1; /* count the blank */
1603 new_argv
= (unsigned char *) alloca (len
);
1604 strcpy (new_argv
, SDATA (program
));
1605 for (i
= 3; i
< nargs
; i
++)
1609 strcat (new_argv
, " ");
1610 strcat (new_argv
, SDATA (tem
));
1612 /* Need to add code here to check for program existence on VMS */
1615 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1617 /* If program file name is not absolute, search our path for it.
1618 Put the name we will really use in TEM. */
1619 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1620 && !(SCHARS (program
) > 1
1621 && IS_DEVICE_SEP (SREF (program
, 1))))
1623 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1626 GCPRO4 (name
, program
, buffer
, current_dir
);
1627 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1630 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1631 tem
= Fexpand_file_name (tem
, Qnil
);
1635 if (!NILP (Ffile_directory_p (program
)))
1636 error ("Specified program for new process is a directory");
1640 /* If program file name starts with /: for quoting a magic name,
1642 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1643 && SREF (tem
, 1) == ':')
1644 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1646 /* Encode the file name and put it in NEW_ARGV.
1647 That's where the child will use it to execute the program. */
1648 tem
= ENCODE_FILE (tem
);
1649 new_argv
[0] = SDATA (tem
);
1651 /* Here we encode arguments by the coding system used for sending
1652 data to the process. We don't support using different coding
1653 systems for encoding arguments and for encoding data sent to the
1656 for (i
= 3; i
< nargs
; i
++)
1660 if (STRING_MULTIBYTE (tem
))
1661 tem
= (code_convert_string_norecord
1662 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1663 new_argv
[i
- 2] = SDATA (tem
);
1665 new_argv
[i
- 2] = 0;
1666 #endif /* not VMS */
1668 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1669 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1670 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1671 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1673 XPROCESS (proc
)->inherit_coding_system_flag
1674 = (NILP (buffer
) || !inherit_process_coding_system
1677 create_process (proc
, (char **) new_argv
, current_dir
);
1679 return unbind_to (count
, proc
);
1682 /* This function is the unwind_protect form for Fstart_process. If
1683 PROC doesn't have its pid set, then we know someone has signaled
1684 an error and the process wasn't started successfully, so we should
1685 remove it from the process list. */
1687 start_process_unwind (proc
)
1690 if (!PROCESSP (proc
))
1693 /* Was PROC started successfully? */
1694 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1695 remove_process (proc
);
1701 create_process_1 (timer
)
1702 struct atimer
*timer
;
1704 /* Nothing to do. */
1708 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1711 /* Mimic blocking of signals on system V, which doesn't really have it. */
1713 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1714 int sigchld_deferred
;
1717 create_process_sigchld ()
1719 signal (SIGCHLD
, create_process_sigchld
);
1721 sigchld_deferred
= 1;
1727 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1729 create_process (process
, new_argv
, current_dir
)
1730 Lisp_Object process
;
1732 Lisp_Object current_dir
;
1734 int pid
, inchannel
, outchannel
;
1736 #ifdef POSIX_SIGNALS
1739 struct sigaction sigint_action
;
1740 struct sigaction sigquit_action
;
1742 struct sigaction sighup_action
;
1744 #else /* !POSIX_SIGNALS */
1747 SIGTYPE (*sigchld
)();
1750 #endif /* !POSIX_SIGNALS */
1751 /* Use volatile to protect variables from being clobbered by longjmp. */
1752 volatile int forkin
, forkout
;
1753 volatile int pty_flag
= 0;
1755 extern char **environ
;
1758 inchannel
= outchannel
= -1;
1761 if (!NILP (Vprocess_connection_type
))
1762 outchannel
= inchannel
= allocate_pty ();
1766 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1767 /* On most USG systems it does not work to open the pty's tty here,
1768 then close it and reopen it in the child. */
1770 /* Don't let this terminal become our controlling terminal
1771 (in case we don't have one). */
1772 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1774 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1777 report_file_error ("Opening pty", Qnil
);
1779 forkin
= forkout
= -1;
1780 #endif /* not USG, or USG_SUBTTY_WORKS */
1784 #endif /* HAVE_PTYS */
1787 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1788 report_file_error ("Opening socketpair", Qnil
);
1789 outchannel
= inchannel
= sv
[0];
1790 forkout
= forkin
= sv
[1];
1792 #else /* not SKTPAIR */
1797 report_file_error ("Creating pipe", Qnil
);
1803 emacs_close (inchannel
);
1804 emacs_close (forkout
);
1805 report_file_error ("Creating pipe", Qnil
);
1810 #endif /* not SKTPAIR */
1813 /* Replaced by close_process_descs */
1814 set_exclusive_use (inchannel
);
1815 set_exclusive_use (outchannel
);
1818 /* Stride people say it's a mystery why this is needed
1819 as well as the O_NDELAY, but that it fails without this. */
1820 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1823 ioctl (inchannel
, FIONBIO
, &one
);
1828 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1829 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1832 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1833 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1837 /* Record this as an active process, with its channels.
1838 As a result, child_setup will close Emacs's side of the pipes. */
1839 chan_process
[inchannel
] = process
;
1840 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1841 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1843 /* Previously we recorded the tty descriptor used in the subprocess.
1844 It was only used for getting the foreground tty process, so now
1845 we just reopen the device (see emacs_get_tty_pgrp) as this is
1846 more portable (see USG_SUBTTY_WORKS above). */
1848 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1849 XPROCESS (process
)->status
= Qrun
;
1850 setup_process_coding_systems (process
);
1852 /* Delay interrupts until we have a chance to store
1853 the new fork's pid in its process structure */
1854 #ifdef POSIX_SIGNALS
1855 sigemptyset (&blocked
);
1857 sigaddset (&blocked
, SIGCHLD
);
1859 #ifdef HAVE_WORKING_VFORK
1860 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1861 this sets the parent's signal handlers as well as the child's.
1862 So delay all interrupts whose handlers the child might munge,
1863 and record the current handlers so they can be restored later. */
1864 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1865 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1867 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1869 #endif /* HAVE_WORKING_VFORK */
1870 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1871 #else /* !POSIX_SIGNALS */
1875 #else /* not BSD4_1 */
1876 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1877 sigsetmask (sigmask (SIGCHLD
));
1878 #else /* ordinary USG */
1880 sigchld_deferred
= 0;
1881 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1883 #endif /* ordinary USG */
1884 #endif /* not BSD4_1 */
1885 #endif /* SIGCHLD */
1886 #endif /* !POSIX_SIGNALS */
1888 FD_SET (inchannel
, &input_wait_mask
);
1889 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1890 if (inchannel
> max_process_desc
)
1891 max_process_desc
= inchannel
;
1893 /* Until we store the proper pid, enable sigchld_handler
1894 to recognize an unknown pid as standing for this process.
1895 It is very important not to let this `marker' value stay
1896 in the table after this function has returned; if it does
1897 it might cause call-process to hang and subsequent asynchronous
1898 processes to get their return values scrambled. */
1899 XSETINT (XPROCESS (process
)->pid
, -1);
1904 /* child_setup must clobber environ on systems with true vfork.
1905 Protect it from permanent change. */
1906 char **save_environ
= environ
;
1908 current_dir
= ENCODE_FILE (current_dir
);
1913 #endif /* not WINDOWSNT */
1915 int xforkin
= forkin
;
1916 int xforkout
= forkout
;
1918 #if 0 /* This was probably a mistake--it duplicates code later on,
1919 but fails to handle all the cases. */
1920 /* Make sure SIGCHLD is not blocked in the child. */
1921 sigsetmask (SIGEMPTYMASK
);
1924 /* Make the pty be the controlling terminal of the process. */
1926 /* First, disconnect its current controlling terminal. */
1928 /* We tried doing setsid only if pty_flag, but it caused
1929 process_set_signal to fail on SGI when using a pipe. */
1931 /* Make the pty's terminal the controlling terminal. */
1935 /* We ignore the return value
1936 because faith@cs.unc.edu says that is necessary on Linux. */
1937 ioctl (xforkin
, TIOCSCTTY
, 0);
1940 #else /* not HAVE_SETSID */
1942 /* It's very important to call setpgrp here and no time
1943 afterwards. Otherwise, we lose our controlling tty which
1944 is set when we open the pty. */
1947 #endif /* not HAVE_SETSID */
1948 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1949 if (pty_flag
&& xforkin
>= 0)
1952 tcgetattr (xforkin
, &t
);
1954 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1955 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1958 #if defined (NTTYDISC) && defined (TIOCSETD)
1959 if (pty_flag
&& xforkin
>= 0)
1961 /* Use new line discipline. */
1962 int ldisc
= NTTYDISC
;
1963 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1968 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1969 can do TIOCSPGRP only to the process's controlling tty. */
1972 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1973 I can't test it since I don't have 4.3. */
1974 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1975 ioctl (j
, TIOCNOTTY
, 0);
1978 /* In order to get a controlling terminal on some versions
1979 of BSD, it is necessary to put the process in pgrp 0
1980 before it opens the terminal. */
1988 #endif /* TIOCNOTTY */
1990 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
1991 /*** There is a suggestion that this ought to be a
1992 conditional on TIOCSPGRP,
1993 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1994 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1995 that system does seem to need this code, even though
1996 both HAVE_SETSID and TIOCSCTTY are defined. */
1997 /* Now close the pty (if we had it open) and reopen it.
1998 This makes the pty the controlling terminal of the subprocess. */
2001 #ifdef SET_CHILD_PTY_PGRP
2002 int pgrp
= getpid ();
2005 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2008 emacs_close (xforkin
);
2009 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2013 emacs_write (1, "Couldn't open the pty terminal ", 31);
2014 emacs_write (1, pty_name
, strlen (pty_name
));
2015 emacs_write (1, "\n", 1);
2019 #ifdef SET_CHILD_PTY_PGRP
2020 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
2021 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
2024 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
2026 #ifdef SETUP_SLAVE_PTY
2031 #endif /* SETUP_SLAVE_PTY */
2033 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2034 Now reenable it in the child, so it will die when we want it to. */
2036 signal (SIGHUP
, SIG_DFL
);
2038 #endif /* HAVE_PTYS */
2040 signal (SIGINT
, SIG_DFL
);
2041 signal (SIGQUIT
, SIG_DFL
);
2043 /* Stop blocking signals in the child. */
2044 #ifdef POSIX_SIGNALS
2045 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2046 #else /* !POSIX_SIGNALS */
2050 #else /* not BSD4_1 */
2051 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2052 sigsetmask (SIGEMPTYMASK
);
2053 #else /* ordinary USG */
2055 signal (SIGCHLD
, sigchld
);
2057 #endif /* ordinary USG */
2058 #endif /* not BSD4_1 */
2059 #endif /* SIGCHLD */
2060 #endif /* !POSIX_SIGNALS */
2063 child_setup_tty (xforkout
);
2065 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2066 new_argv
, 1, current_dir
);
2067 #else /* not WINDOWSNT */
2068 child_setup (xforkin
, xforkout
, xforkout
,
2069 new_argv
, 1, current_dir
);
2070 #endif /* not WINDOWSNT */
2072 environ
= save_environ
;
2077 /* This runs in the Emacs process. */
2081 emacs_close (forkin
);
2082 if (forkin
!= forkout
&& forkout
>= 0)
2083 emacs_close (forkout
);
2087 /* vfork succeeded. */
2088 XSETFASTINT (XPROCESS (process
)->pid
, pid
);
2091 register_child (pid
, inchannel
);
2092 #endif /* WINDOWSNT */
2094 /* If the subfork execv fails, and it exits,
2095 this close hangs. I don't know why.
2096 So have an interrupt jar it loose. */
2098 struct atimer
*timer
;
2102 EMACS_SET_SECS_USECS (offset
, 1, 0);
2103 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2106 emacs_close (forkin
);
2108 cancel_atimer (timer
);
2112 if (forkin
!= forkout
&& forkout
>= 0)
2113 emacs_close (forkout
);
2117 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2120 XPROCESS (process
)->tty_name
= Qnil
;
2123 /* Restore the signal state whether vfork succeeded or not.
2124 (We will signal an error, below, if it failed.) */
2125 #ifdef POSIX_SIGNALS
2126 #ifdef HAVE_WORKING_VFORK
2127 /* Restore the parent's signal handlers. */
2128 sigaction (SIGINT
, &sigint_action
, 0);
2129 sigaction (SIGQUIT
, &sigquit_action
, 0);
2131 sigaction (SIGHUP
, &sighup_action
, 0);
2133 #endif /* HAVE_WORKING_VFORK */
2134 /* Stop blocking signals in the parent. */
2135 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2136 #else /* !POSIX_SIGNALS */
2140 #else /* not BSD4_1 */
2141 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2142 sigsetmask (SIGEMPTYMASK
);
2143 #else /* ordinary USG */
2145 signal (SIGCHLD
, sigchld
);
2146 /* Now really handle any of these signals
2147 that came in during this function. */
2148 if (sigchld_deferred
)
2149 kill (getpid (), SIGCHLD
);
2151 #endif /* ordinary USG */
2152 #endif /* not BSD4_1 */
2153 #endif /* SIGCHLD */
2154 #endif /* !POSIX_SIGNALS */
2156 /* Now generate the error if vfork failed. */
2158 report_file_error ("Doing vfork", Qnil
);
2160 #endif /* not VMS */
2165 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2166 The address family of sa is not included in the result. */
2169 conv_sockaddr_to_lisp (sa
, len
)
2170 struct sockaddr
*sa
;
2173 Lisp_Object address
;
2176 register struct Lisp_Vector
*p
;
2178 switch (sa
->sa_family
)
2182 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2183 len
= sizeof (sin
->sin_addr
) + 1;
2184 address
= Fmake_vector (make_number (len
), Qnil
);
2185 p
= XVECTOR (address
);
2186 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2187 cp
= (unsigned char *)&sin
->sin_addr
;
2190 #ifdef HAVE_LOCAL_SOCKETS
2193 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2194 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2195 if (sockun
->sun_path
[i
] == 0)
2197 return make_unibyte_string (sockun
->sun_path
, i
);
2201 len
-= sizeof (sa
->sa_family
);
2202 address
= Fcons (make_number (sa
->sa_family
),
2203 Fmake_vector (make_number (len
), Qnil
));
2204 p
= XVECTOR (XCDR (address
));
2205 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2211 p
->contents
[i
++] = make_number (*cp
++);
2217 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2220 get_lisp_to_sockaddr_size (address
, familyp
)
2221 Lisp_Object address
;
2224 register struct Lisp_Vector
*p
;
2226 if (VECTORP (address
))
2228 p
= XVECTOR (address
);
2232 return sizeof (struct sockaddr_in
);
2235 #ifdef HAVE_LOCAL_SOCKETS
2236 else if (STRINGP (address
))
2238 *familyp
= AF_LOCAL
;
2239 return sizeof (struct sockaddr_un
);
2242 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2244 struct sockaddr
*sa
;
2245 *familyp
= XINT (XCAR (address
));
2246 p
= XVECTOR (XCDR (address
));
2247 return p
->size
+ sizeof (sa
->sa_family
);
2252 /* Convert an address object (vector or string) to an internal sockaddr.
2253 Format of address has already been validated by size_lisp_to_sockaddr. */
2256 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2258 Lisp_Object address
;
2259 struct sockaddr
*sa
;
2262 register struct Lisp_Vector
*p
;
2263 register unsigned char *cp
= NULL
;
2267 sa
->sa_family
= family
;
2269 if (VECTORP (address
))
2271 p
= XVECTOR (address
);
2272 if (family
== AF_INET
)
2274 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2275 len
= sizeof (sin
->sin_addr
) + 1;
2276 i
= XINT (p
->contents
[--len
]);
2277 sin
->sin_port
= htons (i
);
2278 cp
= (unsigned char *)&sin
->sin_addr
;
2281 else if (STRINGP (address
))
2283 #ifdef HAVE_LOCAL_SOCKETS
2284 if (family
== AF_LOCAL
)
2286 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2287 cp
= SDATA (address
);
2288 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2289 sockun
->sun_path
[i
] = *cp
++;
2296 p
= XVECTOR (XCDR (address
));
2297 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2300 for (i
= 0; i
< len
; i
++)
2301 if (INTEGERP (p
->contents
[i
]))
2302 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2305 #ifdef DATAGRAM_SOCKETS
2306 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2308 doc
: /* Get the current datagram address associated with PROCESS. */)
2310 Lisp_Object process
;
2314 CHECK_PROCESS (process
);
2316 if (!DATAGRAM_CONN_P (process
))
2319 channel
= XINT (XPROCESS (process
)->infd
);
2320 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2321 datagram_address
[channel
].len
);
2324 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2326 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2327 Returns nil upon error setting address, ADDRESS otherwise. */)
2329 Lisp_Object process
, address
;
2334 CHECK_PROCESS (process
);
2336 if (!DATAGRAM_CONN_P (process
))
2339 channel
= XINT (XPROCESS (process
)->infd
);
2341 len
= get_lisp_to_sockaddr_size (address
, &family
);
2342 if (datagram_address
[channel
].len
!= len
)
2344 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2350 static struct socket_options
{
2351 /* The name of this option. Should be lowercase version of option
2352 name without SO_ prefix. */
2354 /* Option level SOL_... */
2356 /* Option number SO_... */
2358 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2359 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2360 } socket_options
[] =
2362 #ifdef SO_BINDTODEVICE
2363 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2366 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2369 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2372 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2375 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2378 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2381 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2384 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2386 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2389 /* Set option OPT to value VAL on socket S.
2391 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2392 Signals an error if setting a known option fails.
2396 set_socket_option (s
, opt
, val
)
2398 Lisp_Object opt
, val
;
2401 struct socket_options
*sopt
;
2406 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2407 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2408 if (strcmp (name
, sopt
->name
) == 0)
2411 switch (sopt
->opttype
)
2416 optval
= NILP (val
) ? 0 : 1;
2417 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2418 &optval
, sizeof (optval
));
2426 optval
= XINT (val
);
2428 error ("Bad option value for %s", name
);
2429 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2430 &optval
, sizeof (optval
));
2434 #ifdef SO_BINDTODEVICE
2437 char devname
[IFNAMSIZ
+1];
2439 /* This is broken, at least in the Linux 2.4 kernel.
2440 To unbind, the arg must be a zero integer, not the empty string.
2441 This should work on all systems. KFS. 2003-09-23. */
2442 bzero (devname
, sizeof devname
);
2445 char *arg
= (char *) SDATA (val
);
2446 int len
= min (strlen (arg
), IFNAMSIZ
);
2447 bcopy (arg
, devname
, len
);
2449 else if (!NILP (val
))
2450 error ("Bad option value for %s", name
);
2451 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2460 struct linger linger
;
2463 linger
.l_linger
= 0;
2465 linger
.l_linger
= XINT (val
);
2467 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2468 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2469 &linger
, sizeof (linger
));
2479 report_file_error ("Cannot set network option",
2480 Fcons (opt
, Fcons (val
, Qnil
)));
2481 return (1 << sopt
->optbit
);
2485 DEFUN ("set-network-process-option",
2486 Fset_network_process_option
, Sset_network_process_option
,
2488 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2489 See `make-network-process' for a list of options and values.
2490 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2491 OPTION is not a supported option, return nil instead; otherwise return t. */)
2492 (process
, option
, value
, no_error
)
2493 Lisp_Object process
, option
, value
;
2494 Lisp_Object no_error
;
2497 struct Lisp_Process
*p
;
2499 CHECK_PROCESS (process
);
2500 p
= XPROCESS (process
);
2501 if (!NETCONN1_P (p
))
2502 error ("Process is not a network process");
2506 error ("Process is not running");
2508 if (set_socket_option (s
, option
, value
))
2510 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2514 if (NILP (no_error
))
2515 error ("Unknown or unsupported option");
2521 /* A version of request_sigio suitable for a record_unwind_protect. */
2524 unwind_request_sigio (dummy
)
2527 if (interrupt_input
)
2532 /* Create a network stream/datagram client/server process. Treated
2533 exactly like a normal process when reading and writing. Primary
2534 differences are in status display and process deletion. A network
2535 connection has no PID; you cannot signal it. All you can do is
2536 stop/continue it and deactivate/close it via delete-process */
2538 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2540 doc
: /* Create and return a network server or client process.
2542 In Emacs, network connections are represented by process objects, so
2543 input and output work as for subprocesses and `delete-process' closes
2544 a network connection. However, a network process has no process id,
2545 it cannot be signalled, and the status codes are different from normal
2548 Arguments are specified as keyword/argument pairs. The following
2549 arguments are defined:
2551 :name NAME -- NAME is name for process. It is modified if necessary
2554 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2555 with the process. Process output goes at end of that buffer, unless
2556 you specify an output stream or filter function to handle the output.
2557 BUFFER may be also nil, meaning that this process is not associated
2560 :host HOST -- HOST is name of the host to connect to, or its IP
2561 address. The symbol `local' specifies the local host. If specified
2562 for a server process, it must be a valid name or address for the local
2563 host, and only clients connecting to that address will be accepted.
2565 :service SERVICE -- SERVICE is name of the service desired, or an
2566 integer specifying a port number to connect to. If SERVICE is t,
2567 a random port number is selected for the server.
2569 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2570 stream type connection, `datagram' creates a datagram type connection.
2572 :family FAMILY -- FAMILY is the address (and protocol) family for the
2573 service specified by HOST and SERVICE. The default address family is
2574 Inet (or IPv4) for the host and port number specified by HOST and
2575 SERVICE. Other address families supported are:
2576 local -- for a local (i.e. UNIX) address specified by SERVICE.
2578 :local ADDRESS -- ADDRESS is the local address used for the connection.
2579 This parameter is ignored when opening a client process. When specified
2580 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2582 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2583 connection. This parameter is ignored when opening a stream server
2584 process. For a datagram server process, it specifies the initial
2585 setting of the remote datagram address. When specified for a client
2586 process, the FAMILY, HOST, and SERVICE args are ignored.
2588 The format of ADDRESS depends on the address family:
2589 - An IPv4 address is represented as an vector of integers [A B C D P]
2590 corresponding to numeric IP address A.B.C.D and port number P.
2591 - A local address is represented as a string with the address in the
2592 local address space.
2593 - An "unsupported family" address is represented by a cons (F . AV)
2594 where F is the family number and AV is a vector containing the socket
2595 address data with one element per address data byte. Do not rely on
2596 this format in portable code, as it may depend on implementation
2597 defined constants, data sizes, and data structure alignment.
2599 :coding CODING -- If CODING is a symbol, it specifies the coding
2600 system used for both reading and writing for this process. If CODING
2601 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2602 ENCODING is used for writing.
2604 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2605 return without waiting for the connection to complete; instead, the
2606 sentinel function will be called with second arg matching "open" (if
2607 successful) or "failed" when the connect completes. Default is to use
2608 a blocking connect (i.e. wait) for stream type connections.
2610 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2611 running when Emacs is exited.
2613 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2614 In the stopped state, a server process does not accept new
2615 connections, and a client process does not handle incoming traffic.
2616 The stopped state is cleared by `continue-process' and set by
2619 :filter FILTER -- Install FILTER as the process filter.
2621 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2622 process filter are multibyte, otherwise they are unibyte.
2623 If this keyword is not specified, the strings are multibyte iff
2624 `default-enable-multibyte-characters' is non-nil.
2626 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2628 :log LOG -- Install LOG as the server process log function. This
2629 function is called when the server accepts a network connection from a
2630 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2631 is the server process, CLIENT is the new process for the connection,
2632 and MESSAGE is a string.
2634 :plist PLIST -- Install PLIST as the new process' initial plist.
2636 :server QLEN -- if QLEN is non-nil, create a server process for the
2637 specified FAMILY, SERVICE, and connection type (stream or datagram).
2638 If QLEN is an integer, it is used as the max. length of the server's
2639 pending connection queue (also known as the backlog); the default
2640 queue length is 5. Default is to create a client process.
2642 The following network options can be specified for this connection:
2644 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2645 :dontroute BOOL -- Only send to directly connected hosts.
2646 :keepalive BOOL -- Send keep-alive messages on network stream.
2647 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2648 :oobinline BOOL -- Place out-of-band data in receive data stream.
2649 :priority INT -- Set protocol defined priority for sent packets.
2650 :reuseaddr BOOL -- Allow reusing a recently used local address
2651 (this is allowed by default for a server process).
2652 :bindtodevice NAME -- bind to interface NAME. Using this may require
2653 special privileges on some systems.
2655 Consult the relevant system programmer's manual pages for more
2656 information on using these options.
2659 A server process will listen for and accept connections from clients.
2660 When a client connection is accepted, a new network process is created
2661 for the connection with the following parameters:
2663 - The client's process name is constructed by concatenating the server
2664 process' NAME and a client identification string.
2665 - If the FILTER argument is non-nil, the client process will not get a
2666 separate process buffer; otherwise, the client's process buffer is a newly
2667 created buffer named after the server process' BUFFER name or process
2668 NAME concatenated with the client identification string.
2669 - The connection type and the process filter and sentinel parameters are
2670 inherited from the server process' TYPE, FILTER and SENTINEL.
2671 - The client process' contact info is set according to the client's
2672 addressing information (typically an IP address and a port number).
2673 - The client process' plist is initialized from the server's plist.
2675 Notice that the FILTER and SENTINEL args are never used directly by
2676 the server process. Also, the BUFFER argument is not used directly by
2677 the server process, but via the optional :log function, accepted (and
2678 failed) connections may be logged in the server process' buffer.
2680 The original argument list, modified with the actual connection
2681 information, is available via the `process-contact' function.
2683 usage: (make-network-process &rest ARGS) */)
2689 Lisp_Object contact
;
2690 struct Lisp_Process
*p
;
2691 #ifdef HAVE_GETADDRINFO
2692 struct addrinfo ai
, *res
, *lres
;
2693 struct addrinfo hints
;
2694 char *portstring
, portbuf
[128];
2695 #else /* HAVE_GETADDRINFO */
2696 struct _emacs_addrinfo
2702 struct sockaddr
*ai_addr
;
2703 struct _emacs_addrinfo
*ai_next
;
2705 #endif /* HAVE_GETADDRINFO */
2706 struct sockaddr_in address_in
;
2707 #ifdef HAVE_LOCAL_SOCKETS
2708 struct sockaddr_un address_un
;
2713 int s
= -1, outch
, inch
;
2714 struct gcpro gcpro1
;
2716 int count
= SPECPDL_INDEX ();
2718 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2720 Lisp_Object name
, buffer
, host
, service
, address
;
2721 Lisp_Object filter
, sentinel
;
2722 int is_non_blocking_client
= 0;
2723 int is_server
= 0, backlog
= 5;
2730 /* Save arguments for process-contact and clone-process. */
2731 contact
= Flist (nargs
, args
);
2735 /* Ensure socket support is loaded if available. */
2736 init_winsock (TRUE
);
2739 /* :type TYPE (nil: stream, datagram */
2740 tem
= Fplist_get (contact
, QCtype
);
2742 socktype
= SOCK_STREAM
;
2743 #ifdef DATAGRAM_SOCKETS
2744 else if (EQ (tem
, Qdatagram
))
2745 socktype
= SOCK_DGRAM
;
2748 error ("Unsupported connection type");
2751 tem
= Fplist_get (contact
, QCserver
);
2754 /* Don't support network sockets when non-blocking mode is
2755 not available, since a blocked Emacs is not useful. */
2756 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2757 error ("Network servers not supported");
2761 backlog
= XINT (tem
);
2765 /* Make QCaddress an alias for :local (server) or :remote (client). */
2766 QCaddress
= is_server
? QClocal
: QCremote
;
2769 if (!is_server
&& socktype
== SOCK_STREAM
2770 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2772 #ifndef NON_BLOCKING_CONNECT
2773 error ("Non-blocking connect not supported");
2775 is_non_blocking_client
= 1;
2779 name
= Fplist_get (contact
, QCname
);
2780 buffer
= Fplist_get (contact
, QCbuffer
);
2781 filter
= Fplist_get (contact
, QCfilter
);
2782 sentinel
= Fplist_get (contact
, QCsentinel
);
2784 CHECK_STRING (name
);
2787 /* Let's handle TERM before things get complicated ... */
2788 host
= Fplist_get (contact
, QChost
);
2789 CHECK_STRING (host
);
2791 service
= Fplist_get (contact
, QCservice
);
2792 if (INTEGERP (service
))
2793 port
= htons ((unsigned short) XINT (service
));
2796 struct servent
*svc_info
;
2797 CHECK_STRING (service
);
2798 svc_info
= getservbyname (SDATA (service
), "tcp");
2800 error ("Unknown service: %s", SDATA (service
));
2801 port
= svc_info
->s_port
;
2804 s
= connect_server (0);
2806 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2807 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2808 send_command (s
, C_DUMB
, 1, 0);
2810 #else /* not TERM */
2812 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2813 ai
.ai_socktype
= socktype
;
2818 /* :local ADDRESS or :remote ADDRESS */
2819 address
= Fplist_get (contact
, QCaddress
);
2820 if (!NILP (address
))
2822 host
= service
= Qnil
;
2824 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2825 error ("Malformed :address");
2826 ai
.ai_family
= family
;
2827 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2828 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2832 /* :family FAMILY -- nil (for Inet), local, or integer. */
2833 tem
= Fplist_get (contact
, QCfamily
);
2835 family
= XINT (tem
);
2840 #ifdef HAVE_LOCAL_SOCKETS
2841 else if (EQ (tem
, Qlocal
))
2846 error ("Unknown address family");
2847 ai
.ai_family
= family
;
2849 /* :service SERVICE -- string, integer (port number), or t (random port). */
2850 service
= Fplist_get (contact
, QCservice
);
2852 #ifdef HAVE_LOCAL_SOCKETS
2853 if (family
== AF_LOCAL
)
2855 /* Host is not used. */
2857 CHECK_STRING (service
);
2858 bzero (&address_un
, sizeof address_un
);
2859 address_un
.sun_family
= AF_LOCAL
;
2860 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
2861 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
2862 ai
.ai_addrlen
= sizeof address_un
;
2867 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2868 host
= Fplist_get (contact
, QChost
);
2871 if (EQ (host
, Qlocal
))
2872 host
= build_string ("localhost");
2873 CHECK_STRING (host
);
2876 /* Slow down polling to every ten seconds.
2877 Some kernels have a bug which causes retrying connect to fail
2878 after a connect. Polling can interfere with gethostbyname too. */
2879 #ifdef POLL_FOR_INPUT
2880 if (socktype
== SOCK_STREAM
)
2882 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
2883 bind_polling_period (10);
2887 #ifdef HAVE_GETADDRINFO
2888 /* If we have a host, use getaddrinfo to resolve both host and service.
2889 Otherwise, use getservbyname to lookup the service. */
2893 /* SERVICE can either be a string or int.
2894 Convert to a C string for later use by getaddrinfo. */
2895 if (EQ (service
, Qt
))
2897 else if (INTEGERP (service
))
2899 sprintf (portbuf
, "%ld", (long) XINT (service
));
2900 portstring
= portbuf
;
2904 CHECK_STRING (service
);
2905 portstring
= SDATA (service
);
2910 memset (&hints
, 0, sizeof (hints
));
2912 hints
.ai_family
= NILP (Fplist_member (contact
, QCfamily
)) ? AF_UNSPEC
: family
;
2913 hints
.ai_socktype
= socktype
;
2914 hints
.ai_protocol
= 0;
2915 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
2917 #ifdef HAVE_GAI_STRERROR
2918 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
2920 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
2926 #endif /* HAVE_GETADDRINFO */
2928 /* We end up here if getaddrinfo is not defined, or in case no hostname
2929 has been specified (e.g. for a local server process). */
2931 if (EQ (service
, Qt
))
2933 else if (INTEGERP (service
))
2934 port
= htons ((unsigned short) XINT (service
));
2937 struct servent
*svc_info
;
2938 CHECK_STRING (service
);
2939 svc_info
= getservbyname (SDATA (service
),
2940 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
2942 error ("Unknown service: %s", SDATA (service
));
2943 port
= svc_info
->s_port
;
2946 bzero (&address_in
, sizeof address_in
);
2947 address_in
.sin_family
= family
;
2948 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
2949 address_in
.sin_port
= port
;
2951 #ifndef HAVE_GETADDRINFO
2954 struct hostent
*host_info_ptr
;
2956 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
2957 as it may `hang' Emacs for a very long time. */
2960 host_info_ptr
= gethostbyname (SDATA (host
));
2965 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
2966 host_info_ptr
->h_length
);
2967 family
= host_info_ptr
->h_addrtype
;
2968 address_in
.sin_family
= family
;
2971 /* Attempt to interpret host as numeric inet address */
2973 IN_ADDR numeric_addr
;
2974 numeric_addr
= inet_addr ((char *) SDATA (host
));
2975 if (NUMERIC_ADDR_ERROR
)
2976 error ("Unknown host \"%s\"", SDATA (host
));
2978 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
2979 sizeof (address_in
.sin_addr
));
2983 #endif /* not HAVE_GETADDRINFO */
2985 ai
.ai_family
= family
;
2986 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
2987 ai
.ai_addrlen
= sizeof address_in
;
2991 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
2992 when connect is interrupted. So let's not let it get interrupted.
2993 Note we do not turn off polling, because polling is only used
2994 when not interrupt_input, and thus not normally used on the systems
2995 which have this bug. On systems which use polling, there's no way
2996 to quit if polling is turned off. */
2998 && !is_server
&& socktype
== SOCK_STREAM
)
3000 /* Comment from KFS: The original open-network-stream code
3001 didn't unwind protect this, but it seems like the proper
3002 thing to do. In any case, I don't see how it could harm to
3003 do this -- and it makes cleanup (using unbind_to) easier. */
3004 record_unwind_protect (unwind_request_sigio
, Qnil
);
3008 /* Do this in case we never enter the for-loop below. */
3009 count1
= SPECPDL_INDEX ();
3012 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3016 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3023 #ifdef DATAGRAM_SOCKETS
3024 if (!is_server
&& socktype
== SOCK_DGRAM
)
3026 #endif /* DATAGRAM_SOCKETS */
3028 #ifdef NON_BLOCKING_CONNECT
3029 if (is_non_blocking_client
)
3032 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3034 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3046 /* Make us close S if quit. */
3047 record_unwind_protect (close_file_unwind
, make_number (s
));
3049 /* Parse network options in the arg list.
3050 We simply ignore anything which isn't a known option (including other keywords).
3051 An error is signalled if setting a known option fails. */
3052 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3053 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3057 /* Configure as a server socket. */
3059 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3060 explicit :reuseaddr key to override this. */
3061 #ifdef HAVE_LOCAL_SOCKETS
3062 if (family
!= AF_LOCAL
)
3064 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3067 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3068 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3071 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3072 report_file_error ("Cannot bind server socket", Qnil
);
3074 #ifdef HAVE_GETSOCKNAME
3075 if (EQ (service
, Qt
))
3077 struct sockaddr_in sa1
;
3078 int len1
= sizeof (sa1
);
3079 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3081 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3082 service
= make_number (ntohs (sa1
.sin_port
));
3083 contact
= Fplist_put (contact
, QCservice
, service
);
3088 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3089 report_file_error ("Cannot listen on server socket", Qnil
);
3099 /* This turns off all alarm-based interrupts; the
3100 bind_polling_period call above doesn't always turn all the
3101 short-interval ones off, especially if interrupt_input is
3104 It'd be nice to be able to control the connect timeout
3105 though. Would non-blocking connect calls be portable?
3107 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3109 turn_on_atimers (0);
3111 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3114 turn_on_atimers (1);
3116 if (ret
== 0 || xerrno
== EISCONN
)
3118 /* The unwind-protect will be discarded afterwards.
3119 Likewise for immediate_quit. */
3123 #ifdef NON_BLOCKING_CONNECT
3125 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3129 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3137 if (xerrno
== EINTR
)
3139 if (xerrno
== EADDRINUSE
&& retry
< 20)
3141 /* A delay here is needed on some FreeBSD systems,
3142 and it is harmless, since this retrying takes time anyway
3143 and should be infrequent. */
3144 Fsleep_for (make_number (1), Qnil
);
3149 /* Discard the unwind protect closing S. */
3150 specpdl_ptr
= specpdl
+ count1
;
3157 #ifdef DATAGRAM_SOCKETS
3158 if (socktype
== SOCK_DGRAM
)
3160 if (datagram_address
[s
].sa
)
3162 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3163 datagram_address
[s
].len
= lres
->ai_addrlen
;
3167 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3168 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3171 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3172 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3173 conv_lisp_to_sockaddr (rfamily
, remote
,
3174 datagram_address
[s
].sa
, rlen
);
3178 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3181 contact
= Fplist_put (contact
, QCaddress
,
3182 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3183 #ifdef HAVE_GETSOCKNAME
3186 struct sockaddr_in sa1
;
3187 int len1
= sizeof (sa1
);
3188 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3189 contact
= Fplist_put (contact
, QClocal
,
3190 conv_sockaddr_to_lisp (&sa1
, len1
));
3195 #ifdef HAVE_GETADDRINFO
3202 /* Discard the unwind protect for closing S, if any. */
3203 specpdl_ptr
= specpdl
+ count1
;
3205 /* Unwind bind_polling_period and request_sigio. */
3206 unbind_to (count
, Qnil
);
3210 /* If non-blocking got this far - and failed - assume non-blocking is
3211 not supported after all. This is probably a wrong assumption, but
3212 the normal blocking calls to open-network-stream handles this error
3214 if (is_non_blocking_client
)
3219 report_file_error ("make server process failed", contact
);
3221 report_file_error ("make client process failed", contact
);
3224 #endif /* not TERM */
3230 buffer
= Fget_buffer_create (buffer
);
3231 proc
= make_process (name
);
3233 chan_process
[inch
] = proc
;
3236 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3239 fcntl (inch
, F_SETFL
, O_NDELAY
);
3243 p
= XPROCESS (proc
);
3245 p
->childp
= contact
;
3246 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3249 p
->sentinel
= sentinel
;
3251 p
->filter_multibyte
= buffer_defaults
.enable_multibyte_characters
;
3252 /* Override the above only if :filter-multibyte is specified. */
3253 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3254 p
->filter_multibyte
= Fplist_get (contact
, QCfilter_multibyte
);
3255 p
->log
= Fplist_get (contact
, QClog
);
3256 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3257 p
->kill_without_query
= Qt
;
3258 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3261 XSETINT (p
->infd
, inch
);
3262 XSETINT (p
->outfd
, outch
);
3263 if (is_server
&& socktype
== SOCK_STREAM
)
3264 p
->status
= Qlisten
;
3266 #ifdef NON_BLOCKING_CONNECT
3267 if (is_non_blocking_client
)
3269 /* We may get here if connect did succeed immediately. However,
3270 in that case, we still need to signal this like a non-blocking
3272 p
->status
= Qconnect
;
3273 if (!FD_ISSET (inch
, &connect_wait_mask
))
3275 FD_SET (inch
, &connect_wait_mask
);
3276 num_pending_connects
++;
3281 /* A server may have a client filter setting of Qt, but it must
3282 still listen for incoming connects unless it is stopped. */
3283 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3284 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3286 FD_SET (inch
, &input_wait_mask
);
3287 FD_SET (inch
, &non_keyboard_wait_mask
);
3290 if (inch
> max_process_desc
)
3291 max_process_desc
= inch
;
3293 tem
= Fplist_member (contact
, QCcoding
);
3294 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3295 tem
= Qnil
; /* No error message (too late!). */
3298 /* Setup coding systems for communicating with the network stream. */
3299 struct gcpro gcpro1
;
3300 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3301 Lisp_Object coding_systems
= Qt
;
3302 Lisp_Object args
[5], val
;
3306 val
= XCAR (XCDR (tem
));
3310 else if (!NILP (Vcoding_system_for_read
))
3311 val
= Vcoding_system_for_read
;
3312 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3313 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3314 /* We dare not decode end-of-line format by setting VAL to
3315 Qraw_text, because the existing Emacs Lisp libraries
3316 assume that they receive bare code including a sequene of
3321 if (NILP (host
) || NILP (service
))
3322 coding_systems
= Qnil
;
3325 args
[0] = Qopen_network_stream
, args
[1] = name
,
3326 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3328 coding_systems
= Ffind_operation_coding_system (5, args
);
3331 if (CONSP (coding_systems
))
3332 val
= XCAR (coding_systems
);
3333 else if (CONSP (Vdefault_process_coding_system
))
3334 val
= XCAR (Vdefault_process_coding_system
);
3338 p
->decode_coding_system
= val
;
3342 val
= XCAR (XCDR (tem
));
3346 else if (!NILP (Vcoding_system_for_write
))
3347 val
= Vcoding_system_for_write
;
3348 else if (NILP (current_buffer
->enable_multibyte_characters
))
3352 if (EQ (coding_systems
, Qt
))
3354 if (NILP (host
) || NILP (service
))
3355 coding_systems
= Qnil
;
3358 args
[0] = Qopen_network_stream
, args
[1] = name
,
3359 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3361 coding_systems
= Ffind_operation_coding_system (5, args
);
3365 if (CONSP (coding_systems
))
3366 val
= XCDR (coding_systems
);
3367 else if (CONSP (Vdefault_process_coding_system
))
3368 val
= XCDR (Vdefault_process_coding_system
);
3372 p
->encode_coding_system
= val
;
3374 setup_process_coding_systems (proc
);
3376 p
->decoding_buf
= make_uninit_string (0);
3377 p
->decoding_carryover
= make_number (0);
3378 p
->encoding_buf
= make_uninit_string (0);
3379 p
->encoding_carryover
= make_number (0);
3381 p
->inherit_coding_system_flag
3382 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3388 #endif /* HAVE_SOCKETS */
3391 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3394 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3395 doc
: /* Return an alist of all network interfaces and their network address.
3396 Each element is a cons, the car of which is a string containing the
3397 interface name, and the cdr is the network address in internal
3398 format; see the description of ADDRESS in `make-network-process'. */)
3401 struct ifconf ifconf
;
3402 struct ifreq
*ifreqs
= NULL
;
3407 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3413 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3414 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3421 ifconf
.ifc_len
= buf_size
;
3422 ifconf
.ifc_req
= ifreqs
;
3423 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3429 if (ifconf
.ifc_len
== buf_size
)
3433 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3436 while (--ifaces
>= 0)
3438 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3439 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3440 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3442 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3443 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3444 res
= Fcons (Fcons (build_string (namebuf
),
3445 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3446 sizeof (struct sockaddr
))),
3452 #endif /* SIOCGIFCONF */
3454 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3461 static struct ifflag_def ifflag_table
[] = {
3465 #ifdef IFF_BROADCAST
3466 { IFF_BROADCAST
, "broadcast" },
3469 { IFF_DEBUG
, "debug" },
3472 { IFF_LOOPBACK
, "loopback" },
3474 #ifdef IFF_POINTOPOINT
3475 { IFF_POINTOPOINT
, "pointopoint" },
3478 { IFF_RUNNING
, "running" },
3481 { IFF_NOARP
, "noarp" },
3484 { IFF_PROMISC
, "promisc" },
3486 #ifdef IFF_NOTRAILERS
3487 { IFF_NOTRAILERS
, "notrailers" },
3490 { IFF_ALLMULTI
, "allmulti" },
3493 { IFF_MASTER
, "master" },
3496 { IFF_SLAVE
, "slave" },
3498 #ifdef IFF_MULTICAST
3499 { IFF_MULTICAST
, "multicast" },
3502 { IFF_PORTSEL
, "portsel" },
3504 #ifdef IFF_AUTOMEDIA
3505 { IFF_AUTOMEDIA
, "automedia" },
3508 { IFF_DYNAMIC
, "dynamic" },
3513 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3514 doc
: /* Return information about network interface named IFNAME.
3515 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3516 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3517 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3518 FLAGS is the current flags of the interface. */)
3523 Lisp_Object res
= Qnil
;
3528 CHECK_STRING (ifname
);
3530 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3531 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3533 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3538 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3539 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3541 int flags
= rq
.ifr_flags
;
3542 struct ifflag_def
*fp
;
3546 for (fp
= ifflag_table
; flags
!= 0 && fp
; fp
++)
3548 if (flags
& fp
->flag_bit
)
3550 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3551 flags
-= fp
->flag_bit
;
3554 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3556 if (flags
& (1 << fnum
))
3558 elt
= Fcons (make_number (fnum
), elt
);
3563 res
= Fcons (elt
, res
);
3566 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3567 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3569 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3570 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3574 for (n
= 0; n
< 6; n
++)
3575 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3576 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3579 res
= Fcons (elt
, res
);
3582 #if defined(SIOCGIFNETMASK) && defined(ifr_netmask)
3583 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3586 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3589 res
= Fcons (elt
, res
);
3592 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3593 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3596 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3599 res
= Fcons (elt
, res
);
3602 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3603 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3606 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3609 res
= Fcons (elt
, res
);
3613 return any
? res
: Qnil
;
3616 #endif /* HAVE_SOCKETS */
3619 deactivate_process (proc
)
3622 register int inchannel
, outchannel
;
3623 register struct Lisp_Process
*p
= XPROCESS (proc
);
3625 inchannel
= XINT (p
->infd
);
3626 outchannel
= XINT (p
->outfd
);
3628 #ifdef ADAPTIVE_READ_BUFFERING
3629 if (XINT (p
->read_output_delay
) > 0)
3631 if (--process_output_delay_count
< 0)
3632 process_output_delay_count
= 0;
3633 XSETINT (p
->read_output_delay
, 0);
3634 p
->read_output_skip
= Qnil
;
3640 /* Beware SIGCHLD hereabouts. */
3641 flush_pending_output (inchannel
);
3644 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3645 sys$
dassgn (outchannel
);
3646 vs
= get_vms_process_pointer (p
->pid
);
3648 give_back_vms_process_stuff (vs
);
3651 emacs_close (inchannel
);
3652 if (outchannel
>= 0 && outchannel
!= inchannel
)
3653 emacs_close (outchannel
);
3656 XSETINT (p
->infd
, -1);
3657 XSETINT (p
->outfd
, -1);
3658 #ifdef DATAGRAM_SOCKETS
3659 if (DATAGRAM_CHAN_P (inchannel
))
3661 xfree (datagram_address
[inchannel
].sa
);
3662 datagram_address
[inchannel
].sa
= 0;
3663 datagram_address
[inchannel
].len
= 0;
3666 chan_process
[inchannel
] = Qnil
;
3667 FD_CLR (inchannel
, &input_wait_mask
);
3668 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3669 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3671 FD_CLR (inchannel
, &connect_wait_mask
);
3672 if (--num_pending_connects
< 0)
3675 if (inchannel
== max_process_desc
)
3678 /* We just closed the highest-numbered process input descriptor,
3679 so recompute the highest-numbered one now. */
3680 max_process_desc
= 0;
3681 for (i
= 0; i
< MAXDESC
; i
++)
3682 if (!NILP (chan_process
[i
]))
3683 max_process_desc
= i
;
3688 /* Close all descriptors currently in use for communication
3689 with subprocess. This is used in a newly-forked subprocess
3690 to get rid of irrelevant descriptors. */
3693 close_process_descs ()
3697 for (i
= 0; i
< MAXDESC
; i
++)
3699 Lisp_Object process
;
3700 process
= chan_process
[i
];
3701 if (!NILP (process
))
3703 int in
= XINT (XPROCESS (process
)->infd
);
3704 int out
= XINT (XPROCESS (process
)->outfd
);
3707 if (out
>= 0 && in
!= out
)
3714 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3716 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3717 It is read into the process' buffers or given to their filter functions.
3718 Non-nil arg PROCESS means do not return until some output has been received
3720 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of
3721 seconds and microseconds to wait; return after that much time whether
3722 or not there is input.
3723 Return non-nil iff we received any output before the timeout expired. */)
3724 (process
, timeout
, timeout_msecs
)
3725 register Lisp_Object process
, timeout
, timeout_msecs
;
3730 if (! NILP (process
))
3731 CHECK_PROCESS (process
);
3733 if (! NILP (timeout_msecs
))
3735 CHECK_NUMBER (timeout_msecs
);
3736 useconds
= XINT (timeout_msecs
);
3737 if (!INTEGERP (timeout
))
3738 XSETINT (timeout
, 0);
3741 int carry
= useconds
/ 1000000;
3743 XSETINT (timeout
, XINT (timeout
) + carry
);
3744 useconds
-= carry
* 1000000;
3746 /* I think this clause is necessary because C doesn't
3747 guarantee a particular rounding direction for negative
3751 XSETINT (timeout
, XINT (timeout
) - 1);
3752 useconds
+= 1000000;
3759 if (! NILP (timeout
))
3761 CHECK_NUMBER (timeout
);
3762 seconds
= XINT (timeout
);
3763 if (seconds
< 0 || (seconds
== 0 && useconds
== 0))
3767 seconds
= NILP (process
) ? -1 : 0;
3770 XSETFASTINT (process
, 0);
3773 (wait_reading_process_input (seconds
, useconds
, process
, 0)
3777 /* Accept a connection for server process SERVER on CHANNEL. */
3779 static int connect_counter
= 0;
3782 server_accept_connection (server
, channel
)
3786 Lisp_Object proc
, caller
, name
, buffer
;
3787 Lisp_Object contact
, host
, service
;
3788 struct Lisp_Process
*ps
= XPROCESS (server
);
3789 struct Lisp_Process
*p
;
3793 struct sockaddr_in in
;
3794 #ifdef HAVE_LOCAL_SOCKETS
3795 struct sockaddr_un un
;
3798 int len
= sizeof saddr
;
3800 s
= accept (channel
, &saddr
.sa
, &len
);
3809 if (code
== EWOULDBLOCK
)
3813 if (!NILP (ps
->log
))
3814 call3 (ps
->log
, server
, Qnil
,
3815 concat3 (build_string ("accept failed with code"),
3816 Fnumber_to_string (make_number (code
)),
3817 build_string ("\n")));
3823 /* Setup a new process to handle the connection. */
3825 /* Generate a unique identification of the caller, and build contact
3826 information for this process. */
3829 switch (saddr
.sa
.sa_family
)
3833 Lisp_Object args
[5];
3834 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
3835 args
[0] = build_string ("%d.%d.%d.%d");
3836 args
[1] = make_number (*ip
++);
3837 args
[2] = make_number (*ip
++);
3838 args
[3] = make_number (*ip
++);
3839 args
[4] = make_number (*ip
++);
3840 host
= Fformat (5, args
);
3841 service
= make_number (ntohs (saddr
.in
.sin_port
));
3843 args
[0] = build_string (" <%s:%d>");
3846 caller
= Fformat (3, args
);
3850 #ifdef HAVE_LOCAL_SOCKETS
3854 caller
= Fnumber_to_string (make_number (connect_counter
));
3855 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
3859 /* Create a new buffer name for this process if it doesn't have a
3860 filter. The new buffer name is based on the buffer name or
3861 process name of the server process concatenated with the caller
3864 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
3868 buffer
= ps
->buffer
;
3870 buffer
= Fbuffer_name (buffer
);
3875 buffer
= concat2 (buffer
, caller
);
3876 buffer
= Fget_buffer_create (buffer
);
3880 /* Generate a unique name for the new server process. Combine the
3881 server process name with the caller identification. */
3883 name
= concat2 (ps
->name
, caller
);
3884 proc
= make_process (name
);
3886 chan_process
[s
] = proc
;
3889 fcntl (s
, F_SETFL
, O_NONBLOCK
);
3892 fcntl (s
, F_SETFL
, O_NDELAY
);
3896 p
= XPROCESS (proc
);
3898 /* Build new contact information for this setup. */
3899 contact
= Fcopy_sequence (ps
->childp
);
3900 contact
= Fplist_put (contact
, QCserver
, Qnil
);
3901 contact
= Fplist_put (contact
, QChost
, host
);
3902 if (!NILP (service
))
3903 contact
= Fplist_put (contact
, QCservice
, service
);
3904 contact
= Fplist_put (contact
, QCremote
,
3905 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
3906 #ifdef HAVE_GETSOCKNAME
3908 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
3909 contact
= Fplist_put (contact
, QClocal
,
3910 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
3913 p
->childp
= contact
;
3914 p
->plist
= Fcopy_sequence (ps
->plist
);
3917 p
->sentinel
= ps
->sentinel
;
3918 p
->filter
= ps
->filter
;
3921 XSETINT (p
->infd
, s
);
3922 XSETINT (p
->outfd
, s
);
3925 /* Client processes for accepted connections are not stopped initially. */
3926 if (!EQ (p
->filter
, Qt
))
3928 FD_SET (s
, &input_wait_mask
);
3929 FD_SET (s
, &non_keyboard_wait_mask
);
3932 if (s
> max_process_desc
)
3933 max_process_desc
= s
;
3935 /* Setup coding system for new process based on server process.
3936 This seems to be the proper thing to do, as the coding system
3937 of the new process should reflect the settings at the time the
3938 server socket was opened; not the current settings. */
3940 p
->decode_coding_system
= ps
->decode_coding_system
;
3941 p
->encode_coding_system
= ps
->encode_coding_system
;
3942 setup_process_coding_systems (proc
);
3944 p
->decoding_buf
= make_uninit_string (0);
3945 p
->decoding_carryover
= make_number (0);
3946 p
->encoding_buf
= make_uninit_string (0);
3947 p
->encoding_carryover
= make_number (0);
3949 p
->inherit_coding_system_flag
3950 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
3952 if (!NILP (ps
->log
))
3953 call3 (ps
->log
, server
, proc
,
3954 concat3 (build_string ("accept from "),
3955 (STRINGP (host
) ? host
: build_string ("-")),
3956 build_string ("\n")));
3958 if (!NILP (p
->sentinel
))
3959 exec_sentinel (proc
,
3960 concat3 (build_string ("open from "),
3961 (STRINGP (host
) ? host
: build_string ("-")),
3962 build_string ("\n")));
3965 /* This variable is different from waiting_for_input in keyboard.c.
3966 It is used to communicate to a lisp process-filter/sentinel (via the
3967 function Fwaiting_for_user_input_p below) whether Emacs was waiting
3968 for user-input when that process-filter was called.
3969 waiting_for_input cannot be used as that is by definition 0 when
3970 lisp code is being evalled.
3971 This is also used in record_asynch_buffer_change.
3972 For that purpose, this must be 0
3973 when not inside wait_reading_process_input. */
3974 static int waiting_for_user_input_p
;
3976 /* This is here so breakpoints can be put on it. */
3978 wait_reading_process_input_1 ()
3982 /* Read and dispose of subprocess output while waiting for timeout to
3983 elapse and/or keyboard input to be available.
3986 timeout in seconds, or
3987 zero for no limit, or
3988 -1 means gobble data immediately available but don't wait for any.
3991 an additional duration to wait, measured in microseconds.
3992 If this is nonzero and time_limit is 0, then the timeout
3993 consists of MICROSECS only.
3995 READ_KBD is a lisp value:
3996 0 to ignore keyboard input, or
3997 1 to return when input is available, or
3998 -1 meaning caller will actually read the input, so don't throw to
3999 the quit handler, or
4000 a cons cell, meaning wait until its car is non-nil
4001 (and gobble terminal input into the buffer if any arrives), or
4002 a process object, meaning wait until something arrives from that
4003 process. The return value is true iff we read some input from
4006 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4007 output that arrives.
4009 If READ_KBD is a pointer to a struct Lisp_Process, then the
4010 function returns true iff we received input from that process
4011 before the timeout elapsed.
4012 Otherwise, return true iff we received input from any process. */
4015 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
4016 int time_limit
, microsecs
;
4017 Lisp_Object read_kbd
;
4020 register int channel
, nfds
;
4021 SELECT_TYPE Available
;
4022 SELECT_TYPE Connecting
;
4023 int check_connect
, check_delay
, no_avail
;
4026 EMACS_TIME timeout
, end_time
;
4027 int wait_channel
= -1;
4028 struct Lisp_Process
*wait_proc
= 0;
4029 int got_some_input
= 0;
4030 /* Either nil or a cons cell, the car of which is of interest and
4031 may be changed outside of this routine. */
4032 Lisp_Object wait_for_cell
= Qnil
;
4033 int saved_waiting_for_user_input_p
= waiting_for_user_input_p
;
4035 FD_ZERO (&Available
);
4036 FD_ZERO (&Connecting
);
4038 /* If read_kbd is a process to watch, set wait_proc and wait_channel
4040 if (PROCESSP (read_kbd
))
4042 wait_proc
= XPROCESS (read_kbd
);
4043 wait_channel
= XINT (wait_proc
->infd
);
4044 XSETFASTINT (read_kbd
, 0);
4047 /* If waiting for non-nil in a cell, record where. */
4048 if (CONSP (read_kbd
))
4050 wait_for_cell
= read_kbd
;
4051 XSETFASTINT (read_kbd
, 0);
4054 waiting_for_user_input_p
= XINT (read_kbd
);
4056 /* Since we may need to wait several times,
4057 compute the absolute time to return at. */
4058 if (time_limit
|| microsecs
)
4060 EMACS_GET_TIME (end_time
);
4061 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4062 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4064 #ifdef POLL_INTERRUPTED_SYS_CALL
4065 /* AlainF 5-Jul-1996
4066 HP-UX 10.10 seem to have problems with signals coming in
4067 Causes "poll: interrupted system call" messages when Emacs is run
4069 Turn off periodic alarms (in case they are in use),
4070 and then turn off any other atimers. */
4072 turn_on_atimers (0);
4073 #endif /* POLL_INTERRUPTED_SYS_CALL */
4077 int timeout_reduced_for_timers
= 0;
4079 /* If calling from keyboard input, do not quit
4080 since we want to return C-g as an input character.
4081 Otherwise, do pending quit if requested. */
4082 if (XINT (read_kbd
) >= 0)
4085 else if (interrupt_input_pending
)
4086 handle_async_input ();
4089 /* Exit now if the cell we're waiting for became non-nil. */
4090 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4093 /* Compute time from now till when time limit is up */
4094 /* Exit if already run out */
4095 if (time_limit
== -1)
4097 /* -1 specified for timeout means
4098 gobble output available now
4099 but don't wait at all. */
4101 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4103 else if (time_limit
|| microsecs
)
4105 EMACS_GET_TIME (timeout
);
4106 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4107 if (EMACS_TIME_NEG_P (timeout
))
4112 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4115 /* Normally we run timers here.
4116 But not if wait_for_cell; in those cases,
4117 the wait is supposed to be short,
4118 and those callers cannot handle running arbitrary Lisp code here. */
4119 if (NILP (wait_for_cell
))
4121 EMACS_TIME timer_delay
;
4125 int old_timers_run
= timers_run
;
4126 struct buffer
*old_buffer
= current_buffer
;
4128 timer_delay
= timer_check (1);
4130 /* If a timer has run, this might have changed buffers
4131 an alike. Make read_key_sequence aware of that. */
4132 if (timers_run
!= old_timers_run
4133 && old_buffer
!= current_buffer
4134 && waiting_for_user_input_p
== -1)
4135 record_asynch_buffer_change ();
4137 if (timers_run
!= old_timers_run
&& do_display
)
4138 /* We must retry, since a timer may have requeued itself
4139 and that could alter the time_delay. */
4140 redisplay_preserve_echo_area (9);
4144 while (!detect_input_pending ());
4146 /* If there is unread keyboard input, also return. */
4147 if (XINT (read_kbd
) != 0
4148 && requeued_events_pending_p ())
4151 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4153 EMACS_TIME difference
;
4154 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4155 if (EMACS_TIME_NEG_P (difference
))
4157 timeout
= timer_delay
;
4158 timeout_reduced_for_timers
= 1;
4161 /* If time_limit is -1, we are not going to wait at all. */
4162 else if (time_limit
!= -1)
4164 /* This is so a breakpoint can be put here. */
4165 wait_reading_process_input_1 ();
4169 /* Cause C-g and alarm signals to take immediate action,
4170 and cause input available signals to zero out timeout.
4172 It is important that we do this before checking for process
4173 activity. If we get a SIGCHLD after the explicit checks for
4174 process activity, timeout is the only way we will know. */
4175 if (XINT (read_kbd
) < 0)
4176 set_waiting_for_input (&timeout
);
4178 /* If status of something has changed, and no input is
4179 available, notify the user of the change right away. After
4180 this explicit check, we'll let the SIGCHLD handler zap
4181 timeout to get our attention. */
4182 if (update_tick
!= process_tick
&& do_display
)
4184 SELECT_TYPE Atemp
, Ctemp
;
4186 Atemp
= input_wait_mask
;
4188 /* On Mac OS X, the SELECT system call always says input is
4189 present (for reading) at stdin, even when none is. This
4190 causes the call to SELECT below to return 1 and
4191 status_notify not to be called. As a result output of
4192 subprocesses are incorrectly discarded. */
4195 Ctemp
= connect_wait_mask
;
4196 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4197 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
4199 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4200 (SELECT_TYPE
*)0, &timeout
)
4203 /* It's okay for us to do this and then continue with
4204 the loop, since timeout has already been zeroed out. */
4205 clear_waiting_for_input ();
4210 /* Don't wait for output from a non-running process. Just
4211 read whatever data has already been received. */
4212 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
4213 update_status (wait_proc
);
4215 && ! EQ (wait_proc
->status
, Qrun
)
4216 && ! EQ (wait_proc
->status
, Qconnect
))
4218 int nread
, total_nread
= 0;
4220 clear_waiting_for_input ();
4221 XSETPROCESS (proc
, wait_proc
);
4223 /* Read data from the process, until we exhaust it. */
4224 while (XINT (wait_proc
->infd
) >= 0)
4226 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
4232 total_nread
+= nread
;
4234 else if (nread
== -1 && EIO
== errno
)
4238 else if (nread
== -1 && EAGAIN
== errno
)
4242 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4246 if (total_nread
> 0 && do_display
)
4247 redisplay_preserve_echo_area (10);
4252 /* Wait till there is something to do */
4254 if (!NILP (wait_for_cell
))
4256 Available
= non_process_wait_mask
;
4257 check_connect
= check_delay
= 0;
4261 if (! XINT (read_kbd
))
4262 Available
= non_keyboard_wait_mask
;
4264 Available
= input_wait_mask
;
4265 check_connect
= (num_pending_connects
> 0);
4266 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4269 /* If frame size has changed or the window is newly mapped,
4270 redisplay now, before we start to wait. There is a race
4271 condition here; if a SIGIO arrives between now and the select
4272 and indicates that a frame is trashed, the select may block
4273 displaying a trashed screen. */
4274 if (frame_garbaged
&& do_display
)
4276 clear_waiting_for_input ();
4277 redisplay_preserve_echo_area (11);
4278 if (XINT (read_kbd
) < 0)
4279 set_waiting_for_input (&timeout
);
4283 if (XINT (read_kbd
) && detect_input_pending ())
4291 Connecting
= connect_wait_mask
;
4293 #ifdef ADAPTIVE_READ_BUFFERING
4294 if (process_output_skip
&& check_delay
> 0)
4296 int usecs
= EMACS_USECS (timeout
);
4297 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4298 usecs
= READ_OUTPUT_DELAY_MAX
;
4299 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4301 proc
= chan_process
[channel
];
4304 if (XINT (XPROCESS (proc
)->read_output_delay
) > 0)
4307 if (NILP (XPROCESS (proc
)->read_output_skip
))
4309 FD_CLR (channel
, &Available
);
4310 XPROCESS (proc
)->read_output_skip
= Qnil
;
4311 if (XINT (XPROCESS (proc
)->read_output_delay
) < usecs
)
4312 usecs
= XINT (XPROCESS (proc
)->read_output_delay
);
4315 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4316 process_output_skip
= 0;
4320 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4322 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4323 (SELECT_TYPE
*)0, &timeout
);
4328 /* Make C-g and alarm signals set flags again */
4329 clear_waiting_for_input ();
4331 /* If we woke up due to SIGWINCH, actually change size now. */
4332 do_pending_window_change (0);
4334 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4335 /* We wanted the full specified time, so return now. */
4339 if (xerrno
== EINTR
)
4342 /* Ultrix select seems to return ENOMEM when it is
4343 interrupted. Treat it just like EINTR. Bleah. Note
4344 that we want to test for the "ultrix" CPP symbol, not
4345 "__ultrix__"; the latter is only defined under GCC, but
4346 not by DEC's bundled CC. -JimB */
4347 else if (xerrno
== ENOMEM
)
4351 /* This happens for no known reason on ALLIANT.
4352 I am guessing that this is the right response. -- RMS. */
4353 else if (xerrno
== EFAULT
)
4356 else if (xerrno
== EBADF
)
4359 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4360 the child's closure of the pts gives the parent a SIGHUP, and
4361 the ptc file descriptor is automatically closed,
4362 yielding EBADF here or at select() call above.
4363 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4364 in m/ibmrt-aix.h), and here we just ignore the select error.
4365 Cleanup occurs c/o status_notify after SIGCLD. */
4366 no_avail
= 1; /* Cannot depend on values returned */
4372 error ("select error: %s", emacs_strerror (xerrno
));
4377 FD_ZERO (&Available
);
4381 #if defined(sun) && !defined(USG5_4)
4382 if (nfds
> 0 && keyboard_bit_set (&Available
)
4384 /* System sometimes fails to deliver SIGIO.
4386 David J. Mackenzie says that Emacs doesn't compile under
4387 Solaris if this code is enabled, thus the USG5_4 in the CPP
4388 conditional. "I haven't noticed any ill effects so far.
4389 If you find a Solaris expert somewhere, they might know
4391 kill (getpid (), SIGIO
);
4394 #if 0 /* When polling is used, interrupt_input is 0,
4395 so get_input_pending should read the input.
4396 So this should not be needed. */
4397 /* If we are using polling for input,
4398 and we see input available, make it get read now.
4399 Otherwise it might not actually get read for a second.
4400 And on hpux, since we turn off polling in wait_reading_process_input,
4401 it might never get read at all if we don't spend much time
4402 outside of wait_reading_process_input. */
4403 if (XINT (read_kbd
) && interrupt_input
4404 && keyboard_bit_set (&Available
)
4405 && input_polling_used ())
4406 kill (getpid (), SIGALRM
);
4409 /* Check for keyboard input */
4410 /* If there is any, return immediately
4411 to give it higher priority than subprocesses */
4413 if (XINT (read_kbd
) != 0)
4415 int old_timers_run
= timers_run
;
4416 struct buffer
*old_buffer
= current_buffer
;
4419 if (detect_input_pending_run_timers (do_display
))
4421 swallow_events (do_display
);
4422 if (detect_input_pending_run_timers (do_display
))
4426 /* If a timer has run, this might have changed buffers
4427 an alike. Make read_key_sequence aware of that. */
4428 if (timers_run
!= old_timers_run
4429 && waiting_for_user_input_p
== -1
4430 && old_buffer
!= current_buffer
)
4431 record_asynch_buffer_change ();
4437 /* If there is unread keyboard input, also return. */
4438 if (XINT (read_kbd
) != 0
4439 && requeued_events_pending_p ())
4442 /* If we are not checking for keyboard input now,
4443 do process events (but don't run any timers).
4444 This is so that X events will be processed.
4445 Otherwise they may have to wait until polling takes place.
4446 That would causes delays in pasting selections, for example.
4448 (We used to do this only if wait_for_cell.) */
4449 if (XINT (read_kbd
) == 0 && detect_input_pending ())
4451 swallow_events (do_display
);
4452 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4453 if (detect_input_pending ())
4458 /* Exit now if the cell we're waiting for became non-nil. */
4459 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4463 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4464 go read it. This can happen with X on BSD after logging out.
4465 In that case, there really is no input and no SIGIO,
4466 but select says there is input. */
4468 if (XINT (read_kbd
) && interrupt_input
4469 && keyboard_bit_set (&Available
) && ! noninteractive
)
4470 kill (getpid (), SIGIO
);
4474 got_some_input
|= nfds
> 0;
4476 /* If checking input just got us a size-change event from X,
4477 obey it now if we should. */
4478 if (XINT (read_kbd
) || ! NILP (wait_for_cell
))
4479 do_pending_window_change (0);
4481 /* Check for data from a process. */
4482 if (no_avail
|| nfds
== 0)
4485 /* Really FIRST_PROC_DESC should be 0 on Unix,
4486 but this is safer in the short run. */
4487 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4489 if (FD_ISSET (channel
, &Available
)
4490 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4494 /* If waiting for this channel, arrange to return as
4495 soon as no more input to be processed. No more
4497 if (wait_channel
== channel
)
4503 proc
= chan_process
[channel
];
4507 /* If this is a server stream socket, accept connection. */
4508 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4510 server_accept_connection (proc
, channel
);
4514 /* Read data from the process, starting with our
4515 buffered-ahead character if we have one. */
4517 nread
= read_process_output (proc
, channel
);
4520 /* Since read_process_output can run a filter,
4521 which can call accept-process-output,
4522 don't try to read from any other processes
4523 before doing the select again. */
4524 FD_ZERO (&Available
);
4527 redisplay_preserve_echo_area (12);
4530 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4533 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4534 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4536 else if (nread
== -1 && errno
== EAGAIN
)
4540 else if (nread
== -1 && errno
== EAGAIN
)
4542 /* Note that we cannot distinguish between no input
4543 available now and a closed pipe.
4544 With luck, a closed pipe will be accompanied by
4545 subprocess termination and SIGCHLD. */
4546 else if (nread
== 0 && !NETCONN_P (proc
))
4548 #endif /* O_NDELAY */
4549 #endif /* O_NONBLOCK */
4551 /* On some OSs with ptys, when the process on one end of
4552 a pty exits, the other end gets an error reading with
4553 errno = EIO instead of getting an EOF (0 bytes read).
4554 Therefore, if we get an error reading and errno =
4555 EIO, just continue, because the child process has
4556 exited and should clean itself up soon (e.g. when we
4559 However, it has been known to happen that the SIGCHLD
4560 got lost. So raise the signl again just in case.
4562 else if (nread
== -1 && errno
== EIO
)
4563 kill (getpid (), SIGCHLD
);
4564 #endif /* HAVE_PTYS */
4565 /* If we can detect process termination, don't consider the process
4566 gone just because its pipe is closed. */
4568 else if (nread
== 0 && !NETCONN_P (proc
))
4573 /* Preserve status of processes already terminated. */
4574 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4575 deactivate_process (proc
);
4576 if (!NILP (XPROCESS (proc
)->raw_status_low
))
4577 update_status (XPROCESS (proc
));
4578 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4579 XPROCESS (proc
)->status
4580 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4583 #ifdef NON_BLOCKING_CONNECT
4584 if (check_connect
&& FD_ISSET (channel
, &Connecting
))
4586 struct Lisp_Process
*p
;
4588 FD_CLR (channel
, &connect_wait_mask
);
4589 if (--num_pending_connects
< 0)
4592 proc
= chan_process
[channel
];
4596 p
= XPROCESS (proc
);
4599 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4600 So only use it on systems where it is known to work. */
4602 int xlen
= sizeof(xerrno
);
4603 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4608 struct sockaddr pname
;
4609 int pnamelen
= sizeof(pname
);
4611 /* If connection failed, getpeername will fail. */
4613 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4615 /* Obtain connect failure code through error slippage. */
4618 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4625 XSETINT (p
->tick
, ++process_tick
);
4626 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4627 deactivate_process (proc
);
4632 /* Execute the sentinel here. If we had relied on
4633 status_notify to do it later, it will read input
4634 from the process before calling the sentinel. */
4635 exec_sentinel (proc
, build_string ("open\n"));
4636 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4638 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4639 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4643 #endif /* NON_BLOCKING_CONNECT */
4644 } /* end for each file descriptor */
4645 } /* end while exit conditions not met */
4647 waiting_for_user_input_p
= saved_waiting_for_user_input_p
;
4649 /* If calling from keyboard input, do not quit
4650 since we want to return C-g as an input character.
4651 Otherwise, do pending quit if requested. */
4652 if (XINT (read_kbd
) >= 0)
4654 /* Prevent input_pending from remaining set if we quit. */
4655 clear_input_pending ();
4658 #ifdef POLL_INTERRUPTED_SYS_CALL
4659 /* AlainF 5-Jul-1996
4660 HP-UX 10.10 seems to have problems with signals coming in
4661 Causes "poll: interrupted system call" messages when Emacs is run
4663 Turn periodic alarms back on */
4665 #endif /* POLL_INTERRUPTED_SYS_CALL */
4667 return got_some_input
;
4670 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4673 read_process_output_call (fun_and_args
)
4674 Lisp_Object fun_and_args
;
4676 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4680 read_process_output_error_handler (error
)
4683 cmd_error_internal (error
, "error in process filter: ");
4685 update_echo_area ();
4686 Fsleep_for (make_number (2), Qnil
);
4690 /* Read pending output from the process channel,
4691 starting with our buffered-ahead character if we have one.
4692 Yield number of decoded characters read.
4694 This function reads at most 1024 characters.
4695 If you want to read all available subprocess output,
4696 you must call it repeatedly until it returns zero.
4698 The characters read are decoded according to PROC's coding-system
4702 read_process_output (proc
, channel
)
4704 register int channel
;
4706 register int nbytes
;
4708 register Lisp_Object outstream
;
4709 register struct buffer
*old
= current_buffer
;
4710 register struct Lisp_Process
*p
= XPROCESS (proc
);
4711 register int opoint
;
4712 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4713 int carryover
= XINT (p
->decoding_carryover
);
4717 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4719 vs
= get_vms_process_pointer (p
->pid
);
4723 return (0); /* Really weird if it does this */
4724 if (!(vs
->iosb
[0] & 1))
4725 return -1; /* I/O error */
4728 error ("Could not get VMS process pointer");
4729 chars
= vs
->inputBuffer
;
4730 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4733 start_vms_process_read (vs
); /* Crank up the next read on the process */
4734 return 1; /* Nothing worth printing, say we got 1 */
4738 /* The data carried over in the previous decoding (which are at
4739 the tail of decoding buffer) should be prepended to the new
4740 data read to decode all together. */
4741 chars
= (char *) alloca (nbytes
+ carryover
);
4742 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4743 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4747 #ifdef DATAGRAM_SOCKETS
4748 /* A datagram is one packet; allow at least 1500+ bytes of data
4749 corresponding to the typical Ethernet frame size. */
4750 if (DATAGRAM_CHAN_P (channel
))
4752 /* carryover = 0; */ /* Does carryover make sense for datagrams? */
4757 chars
= (char *) alloca (carryover
+ readmax
);
4759 /* See the comment above. */
4760 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
4762 #ifdef DATAGRAM_SOCKETS
4763 /* We have a working select, so proc_buffered_char is always -1. */
4764 if (DATAGRAM_CHAN_P (channel
))
4766 int len
= datagram_address
[channel
].len
;
4767 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
- carryover
,
4768 0, datagram_address
[channel
].sa
, &len
);
4772 if (proc_buffered_char
[channel
] < 0)
4774 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
- carryover
);
4775 #ifdef ADAPTIVE_READ_BUFFERING
4776 if (!NILP (p
->adaptive_read_buffering
))
4778 int delay
= XINT (p
->read_output_delay
);
4781 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
4784 process_output_delay_count
++;
4785 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
4788 else if (delay
> 0 && (nbytes
== readmax
- carryover
))
4790 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
4792 process_output_delay_count
--;
4794 XSETINT (p
->read_output_delay
, delay
);
4797 p
->read_output_skip
= Qt
;
4798 process_output_skip
= 1;
4805 chars
[carryover
] = proc_buffered_char
[channel
];
4806 proc_buffered_char
[channel
] = -1;
4807 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1 - carryover
);
4811 nbytes
= nbytes
+ 1;
4813 #endif /* not VMS */
4815 XSETINT (p
->decoding_carryover
, 0);
4817 /* At this point, NBYTES holds number of bytes just received
4818 (including the one in proc_buffered_char[channel]). */
4821 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
4823 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4826 /* Now set NBYTES how many bytes we must decode. */
4827 nbytes
+= carryover
;
4829 /* Read and dispose of the process output. */
4830 outstream
= p
->filter
;
4831 if (!NILP (outstream
))
4833 /* We inhibit quit here instead of just catching it so that
4834 hitting ^G when a filter happens to be running won't screw
4836 int count
= SPECPDL_INDEX ();
4837 Lisp_Object odeactivate
;
4838 Lisp_Object obuffer
, okeymap
;
4840 int outer_running_asynch_code
= running_asynch_code
;
4841 int waiting
= waiting_for_user_input_p
;
4843 /* No need to gcpro these, because all we do with them later
4844 is test them for EQness, and none of them should be a string. */
4845 odeactivate
= Vdeactivate_mark
;
4846 XSETBUFFER (obuffer
, current_buffer
);
4847 okeymap
= current_buffer
->keymap
;
4849 specbind (Qinhibit_quit
, Qt
);
4850 specbind (Qlast_nonmenu_event
, Qt
);
4852 /* In case we get recursively called,
4853 and we already saved the match data nonrecursively,
4854 save the same match data in safely recursive fashion. */
4855 if (outer_running_asynch_code
)
4858 /* Don't clobber the CURRENT match data, either! */
4859 tem
= Fmatch_data (Qnil
, Qnil
);
4860 restore_match_data ();
4861 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
4862 Fset_match_data (tem
);
4865 /* For speed, if a search happens within this code,
4866 save the match data in a special nonrecursive fashion. */
4867 running_asynch_code
= 1;
4869 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
4871 Vlast_coding_system_used
= coding
->symbol
;
4872 /* A new coding system might be found. */
4873 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
4875 p
->decode_coding_system
= coding
->symbol
;
4877 /* Don't call setup_coding_system for
4878 proc_decode_coding_system[channel] here. It is done in
4879 detect_coding called via decode_coding above. */
4881 /* If a coding system for encoding is not yet decided, we set
4882 it as the same as coding-system for decoding.
4884 But, before doing that we must check if
4885 proc_encode_coding_system[p->outfd] surely points to a
4886 valid memory because p->outfd will be changed once EOF is
4887 sent to the process. */
4888 if (NILP (p
->encode_coding_system
)
4889 && proc_encode_coding_system
[XINT (p
->outfd
)])
4891 p
->encode_coding_system
= coding
->symbol
;
4892 setup_coding_system (coding
->symbol
,
4893 proc_encode_coding_system
[XINT (p
->outfd
)]);
4897 carryover
= nbytes
- coding
->consumed
;
4898 if (SCHARS (p
->decoding_buf
) < carryover
)
4899 p
->decoding_buf
= make_uninit_string (carryover
);
4900 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
4902 XSETINT (p
->decoding_carryover
, carryover
);
4903 /* Adjust the multibyteness of TEXT to that of the filter. */
4904 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
4905 text
= (STRING_MULTIBYTE (text
)
4906 ? Fstring_as_unibyte (text
)
4907 : Fstring_to_multibyte (text
));
4908 if (SBYTES (text
) > 0)
4909 internal_condition_case_1 (read_process_output_call
,
4911 Fcons (proc
, Fcons (text
, Qnil
))),
4912 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
4913 read_process_output_error_handler
);
4915 /* If we saved the match data nonrecursively, restore it now. */
4916 restore_match_data ();
4917 running_asynch_code
= outer_running_asynch_code
;
4919 /* Handling the process output should not deactivate the mark. */
4920 Vdeactivate_mark
= odeactivate
;
4922 /* Restore waiting_for_user_input_p as it was
4923 when we were called, in case the filter clobbered it. */
4924 waiting_for_user_input_p
= waiting
;
4926 #if 0 /* Call record_asynch_buffer_change unconditionally,
4927 because we might have changed minor modes or other things
4928 that affect key bindings. */
4929 if (! EQ (Fcurrent_buffer (), obuffer
)
4930 || ! EQ (current_buffer
->keymap
, okeymap
))
4932 /* But do it only if the caller is actually going to read events.
4933 Otherwise there's no need to make him wake up, and it could
4934 cause trouble (for example it would make Fsit_for return). */
4935 if (waiting_for_user_input_p
== -1)
4936 record_asynch_buffer_change ();
4939 start_vms_process_read (vs
);
4941 unbind_to (count
, Qnil
);
4945 /* If no filter, write into buffer if it isn't dead. */
4946 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
4948 Lisp_Object old_read_only
;
4949 int old_begv
, old_zv
;
4950 int old_begv_byte
, old_zv_byte
;
4951 Lisp_Object odeactivate
;
4952 int before
, before_byte
;
4957 odeactivate
= Vdeactivate_mark
;
4959 Fset_buffer (p
->buffer
);
4961 opoint_byte
= PT_BYTE
;
4962 old_read_only
= current_buffer
->read_only
;
4965 old_begv_byte
= BEGV_BYTE
;
4966 old_zv_byte
= ZV_BYTE
;
4968 current_buffer
->read_only
= Qnil
;
4970 /* Insert new output into buffer
4971 at the current end-of-output marker,
4972 thus preserving logical ordering of input and output. */
4973 if (XMARKER (p
->mark
)->buffer
)
4974 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
4975 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
4978 SET_PT_BOTH (ZV
, ZV_BYTE
);
4980 before_byte
= PT_BYTE
;
4982 /* If the output marker is outside of the visible region, save
4983 the restriction and widen. */
4984 if (! (BEGV
<= PT
&& PT
<= ZV
))
4987 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
4989 Vlast_coding_system_used
= coding
->symbol
;
4990 /* A new coding system might be found. See the comment in the
4991 similar code in the previous `if' block. */
4992 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
4994 p
->decode_coding_system
= coding
->symbol
;
4995 if (NILP (p
->encode_coding_system
)
4996 && proc_encode_coding_system
[XINT (p
->outfd
)])
4998 p
->encode_coding_system
= coding
->symbol
;
4999 setup_coding_system (coding
->symbol
,
5000 proc_encode_coding_system
[XINT (p
->outfd
)]);
5003 carryover
= nbytes
- coding
->consumed
;
5004 if (SCHARS (p
->decoding_buf
) < carryover
)
5005 p
->decoding_buf
= make_uninit_string (carryover
);
5006 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5008 XSETINT (p
->decoding_carryover
, carryover
);
5009 /* Adjust the multibyteness of TEXT to that of the buffer. */
5010 if (NILP (current_buffer
->enable_multibyte_characters
)
5011 != ! STRING_MULTIBYTE (text
))
5012 text
= (STRING_MULTIBYTE (text
)
5013 ? Fstring_as_unibyte (text
)
5014 : Fstring_to_multibyte (text
));
5015 /* Insert before markers in case we are inserting where
5016 the buffer's mark is, and the user's next command is Meta-y. */
5017 insert_from_string_before_markers (text
, 0, 0,
5018 SCHARS (text
), SBYTES (text
), 0);
5020 /* Make sure the process marker's position is valid when the
5021 process buffer is changed in the signal_after_change above.
5022 W3 is known to do that. */
5023 if (BUFFERP (p
->buffer
)
5024 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5025 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5027 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5029 update_mode_lines
++;
5031 /* Make sure opoint and the old restrictions
5032 float ahead of any new text just as point would. */
5033 if (opoint
>= before
)
5035 opoint
+= PT
- before
;
5036 opoint_byte
+= PT_BYTE
- before_byte
;
5038 if (old_begv
> before
)
5040 old_begv
+= PT
- before
;
5041 old_begv_byte
+= PT_BYTE
- before_byte
;
5043 if (old_zv
>= before
)
5045 old_zv
+= PT
- before
;
5046 old_zv_byte
+= PT_BYTE
- before_byte
;
5049 /* If the restriction isn't what it should be, set it. */
5050 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5051 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5053 /* Handling the process output should not deactivate the mark. */
5054 Vdeactivate_mark
= odeactivate
;
5056 current_buffer
->read_only
= old_read_only
;
5057 SET_PT_BOTH (opoint
, opoint_byte
);
5058 set_buffer_internal (old
);
5061 start_vms_process_read (vs
);
5066 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5068 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5069 This is intended for use by asynchronous process output filters and sentinels. */)
5072 return (waiting_for_user_input_p
? Qt
: Qnil
);
5075 /* Sending data to subprocess */
5077 jmp_buf send_process_frame
;
5078 Lisp_Object process_sent_to
;
5081 send_process_trap ()
5087 longjmp (send_process_frame
, 1);
5090 /* Send some data to process PROC.
5091 BUF is the beginning of the data; LEN is the number of characters.
5092 OBJECT is the Lisp object that the data comes from. If OBJECT is
5093 nil or t, it means that the data comes from C string.
5095 If OBJECT is not nil, the data is encoded by PROC's coding-system
5096 for encoding before it is sent.
5098 This function can evaluate Lisp code and can garbage collect. */
5101 send_process (proc
, buf
, len
, object
)
5102 volatile Lisp_Object proc
;
5103 unsigned char *volatile buf
;
5105 volatile Lisp_Object object
;
5107 /* Use volatile to protect variables from being clobbered by longjmp. */
5108 struct Lisp_Process
*p
= XPROCESS (proc
);
5110 struct coding_system
*coding
;
5111 struct gcpro gcpro1
;
5116 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5119 if (! NILP (p
->raw_status_low
))
5121 if (! EQ (p
->status
, Qrun
))
5122 error ("Process %s not running", SDATA (p
->name
));
5123 if (XINT (p
->outfd
) < 0)
5124 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5126 coding
= proc_encode_coding_system
[XINT (p
->outfd
)];
5127 Vlast_coding_system_used
= coding
->symbol
;
5129 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5130 || (BUFFERP (object
)
5131 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5134 if (!EQ (coding
->symbol
, p
->encode_coding_system
))
5135 /* The coding system for encoding was changed to raw-text
5136 because we sent a unibyte text previously. Now we are
5137 sending a multibyte text, thus we must encode it by the
5138 original coding system specified for the current process. */
5139 setup_coding_system (p
->encode_coding_system
, coding
);
5140 /* src_multibyte should be set to 1 _after_ a call to
5141 setup_coding_system, since it resets src_multibyte to
5143 coding
->src_multibyte
= 1;
5147 /* For sending a unibyte text, character code conversion should
5148 not take place but EOL conversion should. So, setup raw-text
5149 or one of the subsidiary if we have not yet done it. */
5150 if (coding
->type
!= coding_type_raw_text
)
5152 if (CODING_REQUIRE_FLUSHING (coding
))
5154 /* But, before changing the coding, we must flush out data. */
5155 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5156 send_process (proc
, "", 0, Qt
);
5158 coding
->src_multibyte
= 0;
5159 setup_raw_text_coding_system (coding
);
5162 coding
->dst_multibyte
= 0;
5164 if (CODING_REQUIRE_ENCODING (coding
))
5166 int require
= encoding_buffer_size (coding
, len
);
5167 int from_byte
= -1, from
= -1, to
= -1;
5169 if (BUFFERP (object
))
5171 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5172 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
5173 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
5175 else if (STRINGP (object
))
5177 from_byte
= buf
- SDATA (object
);
5178 from
= string_byte_to_char (object
, from_byte
);
5179 to
= string_byte_to_char (object
, from_byte
+ len
);
5182 if (coding
->composing
!= COMPOSITION_DISABLED
)
5185 coding_save_composition (coding
, from
, to
, object
);
5187 coding
->composing
= COMPOSITION_DISABLED
;
5190 if (SBYTES (p
->encoding_buf
) < require
)
5191 p
->encoding_buf
= make_uninit_string (require
);
5194 buf
= (BUFFERP (object
)
5195 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
5196 : SDATA (object
) + from_byte
);
5198 object
= p
->encoding_buf
;
5199 encode_coding (coding
, (char *) buf
, SDATA (object
),
5200 len
, SBYTES (object
));
5201 len
= coding
->produced
;
5202 buf
= SDATA (object
);
5206 vs
= get_vms_process_pointer (p
->pid
);
5208 error ("Could not find this process: %x", p
->pid
);
5209 else if (write_to_vms_process (vs
, buf
, len
))
5213 if (pty_max_bytes
== 0)
5215 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5216 pty_max_bytes
= fpathconf (XFASTINT (p
->outfd
), _PC_MAX_CANON
);
5217 if (pty_max_bytes
< 0)
5218 pty_max_bytes
= 250;
5220 pty_max_bytes
= 250;
5222 /* Deduct one, to leave space for the eof. */
5226 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5227 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5228 when returning with longjmp despite being declared volatile. */
5229 if (!setjmp (send_process_frame
))
5231 process_sent_to
= proc
;
5235 SIGTYPE (*old_sigpipe
)();
5237 /* Decide how much data we can send in one batch.
5238 Long lines need to be split into multiple batches. */
5239 if (!NILP (p
->pty_flag
))
5241 /* Starting this at zero is always correct when not the first
5242 iteration because the previous iteration ended by sending C-d.
5243 It may not be correct for the first iteration
5244 if a partial line was sent in a separate send_process call.
5245 If that proves worth handling, we need to save linepos
5246 in the process object. */
5248 unsigned char *ptr
= (unsigned char *) buf
;
5249 unsigned char *end
= (unsigned char *) buf
+ len
;
5251 /* Scan through this text for a line that is too long. */
5252 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5260 /* If we found one, break the line there
5261 and put in a C-d to force the buffer through. */
5265 /* Send this batch, using one or more write calls. */
5268 int outfd
= XINT (p
->outfd
);
5269 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5270 #ifdef DATAGRAM_SOCKETS
5271 if (DATAGRAM_CHAN_P (outfd
))
5273 rv
= sendto (outfd
, (char *) buf
, this,
5274 0, datagram_address
[outfd
].sa
,
5275 datagram_address
[outfd
].len
);
5276 if (rv
< 0 && errno
== EMSGSIZE
)
5277 report_file_error ("sending datagram", Fcons (proc
, Qnil
));
5282 rv
= emacs_write (outfd
, (char *) buf
, this);
5283 #ifdef ADAPTIVE_READ_BUFFERING
5284 if (XINT (p
->read_output_delay
) > 0
5285 && EQ (p
->adaptive_read_buffering
, Qt
))
5287 XSETFASTINT (p
->read_output_delay
, 0);
5288 process_output_delay_count
--;
5289 p
->read_output_skip
= Qnil
;
5293 signal (SIGPIPE
, old_sigpipe
);
5299 || errno
== EWOULDBLOCK
5305 /* Buffer is full. Wait, accepting input;
5306 that may allow the program
5307 to finish doing output and read more. */
5312 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5313 /* A gross hack to work around a bug in FreeBSD.
5314 In the following sequence, read(2) returns
5318 write(2) 954 bytes, get EAGAIN
5319 read(2) 1024 bytes in process_read_output
5320 read(2) 11 bytes in process_read_output
5322 That is, read(2) returns more bytes than have
5323 ever been written successfully. The 1033 bytes
5324 read are the 1022 bytes written successfully
5325 after processing (for example with CRs added if
5326 the terminal is set up that way which it is
5327 here). The same bytes will be seen again in a
5328 later read(2), without the CRs. */
5330 if (errno
== EAGAIN
)
5333 ioctl (XINT (p
->outfd
), TIOCFLUSH
, &flags
);
5335 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5337 /* Running filters might relocate buffers or strings.
5338 Arrange to relocate BUF. */
5339 if (BUFFERP (object
))
5340 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5341 else if (STRINGP (object
))
5342 offset
= buf
- SDATA (object
);
5344 XSETFASTINT (zero
, 0);
5345 #ifdef EMACS_HAS_USECS
5346 wait_reading_process_input (0, 20000, zero
, 0);
5348 wait_reading_process_input (1, 0, zero
, 0);
5351 if (BUFFERP (object
))
5352 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5353 else if (STRINGP (object
))
5354 buf
= offset
+ SDATA (object
);
5359 /* This is a real error. */
5360 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5367 /* If we sent just part of the string, put in an EOF
5368 to force it through, before we send the rest. */
5370 Fprocess_send_eof (proc
);
5373 #endif /* not VMS */
5377 proc
= process_sent_to
;
5378 p
= XPROCESS (proc
);
5380 p
->raw_status_low
= Qnil
;
5381 p
->raw_status_high
= Qnil
;
5382 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5383 XSETINT (p
->tick
, ++process_tick
);
5384 deactivate_process (proc
);
5386 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5388 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5395 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5397 doc
: /* Send current contents of region as input to PROCESS.
5398 PROCESS may be a process, a buffer, the name of a process or buffer, or
5399 nil, indicating the current buffer's process.
5400 Called from program, takes three arguments, PROCESS, START and END.
5401 If the region is more than 500 characters long,
5402 it is sent in several bunches. This may happen even for shorter regions.
5403 Output from processes can arrive in between bunches. */)
5404 (process
, start
, end
)
5405 Lisp_Object process
, start
, end
;
5410 proc
= get_process (process
);
5411 validate_region (&start
, &end
);
5413 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5414 move_gap (XINT (start
));
5416 start1
= CHAR_TO_BYTE (XINT (start
));
5417 end1
= CHAR_TO_BYTE (XINT (end
));
5418 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5419 Fcurrent_buffer ());
5424 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5426 doc
: /* Send PROCESS the contents of STRING as input.
5427 PROCESS may be a process, a buffer, the name of a process or buffer, or
5428 nil, indicating the current buffer's process.
5429 If STRING is more than 500 characters long,
5430 it is sent in several bunches. This may happen even for shorter strings.
5431 Output from processes can arrive in between bunches. */)
5433 Lisp_Object process
, string
;
5436 CHECK_STRING (string
);
5437 proc
= get_process (process
);
5438 send_process (proc
, SDATA (string
),
5439 SBYTES (string
), string
);
5443 /* Return the foreground process group for the tty/pty that
5444 the process P uses. */
5446 emacs_get_tty_pgrp (p
)
5447 struct Lisp_Process
*p
;
5452 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5455 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5456 master side. Try the slave side. */
5457 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5461 ioctl (fd
, TIOCGPGRP
, &gid
);
5465 #endif /* defined (TIOCGPGRP ) */
5470 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5471 Sprocess_running_child_p
, 0, 1, 0,
5472 doc
: /* Return t if PROCESS has given the terminal to a child.
5473 If the operating system does not make it possible to find out,
5474 return t unconditionally. */)
5476 Lisp_Object process
;
5478 /* Initialize in case ioctl doesn't exist or gives an error,
5479 in a way that will cause returning t. */
5482 struct Lisp_Process
*p
;
5484 proc
= get_process (process
);
5485 p
= XPROCESS (proc
);
5487 if (!EQ (p
->childp
, Qt
))
5488 error ("Process %s is not a subprocess",
5490 if (XINT (p
->infd
) < 0)
5491 error ("Process %s is not active",
5494 gid
= emacs_get_tty_pgrp (p
);
5496 if (gid
== XFASTINT (p
->pid
))
5501 /* send a signal number SIGNO to PROCESS.
5502 If CURRENT_GROUP is t, that means send to the process group
5503 that currently owns the terminal being used to communicate with PROCESS.
5504 This is used for various commands in shell mode.
5505 If CURRENT_GROUP is lambda, that means send to the process group
5506 that currently owns the terminal, but only if it is NOT the shell itself.
5508 If NOMSG is zero, insert signal-announcements into process's buffers
5511 If we can, we try to signal PROCESS by sending control characters
5512 down the pty. This allows us to signal inferiors who have changed
5513 their uid, for which killpg would return an EPERM error. */
5516 process_send_signal (process
, signo
, current_group
, nomsg
)
5517 Lisp_Object process
;
5519 Lisp_Object current_group
;
5523 register struct Lisp_Process
*p
;
5527 proc
= get_process (process
);
5528 p
= XPROCESS (proc
);
5530 if (!EQ (p
->childp
, Qt
))
5531 error ("Process %s is not a subprocess",
5533 if (XINT (p
->infd
) < 0)
5534 error ("Process %s is not active",
5537 if (NILP (p
->pty_flag
))
5538 current_group
= Qnil
;
5540 /* If we are using pgrps, get a pgrp number and make it negative. */
5541 if (NILP (current_group
))
5542 /* Send the signal to the shell's process group. */
5543 gid
= XFASTINT (p
->pid
);
5546 #ifdef SIGNALS_VIA_CHARACTERS
5547 /* If possible, send signals to the entire pgrp
5548 by sending an input character to it. */
5550 /* TERMIOS is the latest and bestest, and seems most likely to
5551 work. If the system has it, use it. */
5558 tcgetattr (XINT (p
->infd
), &t
);
5559 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5563 tcgetattr (XINT (p
->infd
), &t
);
5564 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5568 tcgetattr (XINT (p
->infd
), &t
);
5569 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5570 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5572 send_process (proc
, &t
.c_cc
[VSUSP
], 1, Qnil
);
5577 #else /* ! HAVE_TERMIOS */
5579 /* On Berkeley descendants, the following IOCTL's retrieve the
5580 current control characters. */
5581 #if defined (TIOCGLTC) && defined (TIOCGETC)
5589 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5590 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5593 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5594 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5598 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5599 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5601 #endif /* ! defined (SIGTSTP) */
5604 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5606 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5613 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5614 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5617 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5618 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5622 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5623 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5625 #endif /* ! defined (SIGTSTP) */
5627 #else /* ! defined (TCGETA) */
5628 Your configuration files are messed up
.
5629 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5630 you'd better be using one of the alternatives above! */
5631 #endif /* ! defined (TCGETA) */
5632 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5633 #endif /* ! defined HAVE_TERMIOS */
5635 /* The code above always returns from the function. */
5636 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5639 /* Get the current pgrp using the tty itself, if we have that.
5640 Otherwise, use the pty to get the pgrp.
5641 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5642 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5643 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5644 His patch indicates that if TIOCGPGRP returns an error, then
5645 we should just assume that p->pid is also the process group id. */
5647 gid
= emacs_get_tty_pgrp (p
);
5650 /* If we can't get the information, assume
5651 the shell owns the tty. */
5652 gid
= XFASTINT (p
->pid
);
5654 /* It is not clear whether anything really can set GID to -1.
5655 Perhaps on some system one of those ioctls can or could do so.
5656 Or perhaps this is vestigial. */
5659 #else /* ! defined (TIOCGPGRP ) */
5660 /* Can't select pgrps on this system, so we know that
5661 the child itself heads the pgrp. */
5662 gid
= XFASTINT (p
->pid
);
5663 #endif /* ! defined (TIOCGPGRP ) */
5665 /* If current_group is lambda, and the shell owns the terminal,
5666 don't send any signal. */
5667 if (EQ (current_group
, Qlambda
) && gid
== XFASTINT (p
->pid
))
5675 p
->raw_status_low
= Qnil
;
5676 p
->raw_status_high
= Qnil
;
5678 XSETINT (p
->tick
, ++process_tick
);
5682 #endif /* ! defined (SIGCONT) */
5685 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5690 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5695 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
5698 flush_pending_output (XINT (p
->infd
));
5702 /* If we don't have process groups, send the signal to the immediate
5703 subprocess. That isn't really right, but it's better than any
5704 obvious alternative. */
5707 kill (XFASTINT (p
->pid
), signo
);
5711 /* gid may be a pid, or minus a pgrp's number */
5713 if (!NILP (current_group
))
5715 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
5716 EMACS_KILLPG (gid
, signo
);
5720 gid
= - XFASTINT (p
->pid
);
5723 #else /* ! defined (TIOCSIGSEND) */
5724 EMACS_KILLPG (gid
, signo
);
5725 #endif /* ! defined (TIOCSIGSEND) */
5728 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5729 doc
: /* Interrupt process PROCESS.
5730 PROCESS may be a process, a buffer, or the name of a process or buffer.
5731 No arg or nil means current buffer's process.
5732 Second arg CURRENT-GROUP non-nil means send signal to
5733 the current process-group of the process's controlling terminal
5734 rather than to the process's own process group.
5735 If the process is a shell, this means interrupt current subjob
5736 rather than the shell.
5738 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5739 don't send the signal. */)
5740 (process
, current_group
)
5741 Lisp_Object process
, current_group
;
5743 process_send_signal (process
, SIGINT
, current_group
, 0);
5747 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5748 doc
: /* Kill process PROCESS. May be process or name of one.
5749 See function `interrupt-process' for more details on usage. */)
5750 (process
, current_group
)
5751 Lisp_Object process
, current_group
;
5753 process_send_signal (process
, SIGKILL
, current_group
, 0);
5757 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5758 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5759 See function `interrupt-process' for more details on usage. */)
5760 (process
, current_group
)
5761 Lisp_Object process
, current_group
;
5763 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5767 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5768 doc
: /* Stop process PROCESS. May be process or name of one.
5769 See function `interrupt-process' for more details on usage.
5770 If PROCESS is a network process, inhibit handling of incoming traffic. */)
5771 (process
, current_group
)
5772 Lisp_Object process
, current_group
;
5775 if (PROCESSP (process
) && NETCONN_P (process
))
5777 struct Lisp_Process
*p
;
5779 p
= XPROCESS (process
);
5780 if (NILP (p
->command
)
5781 && XINT (p
->infd
) >= 0)
5783 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5784 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5791 error ("no SIGTSTP support");
5793 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5798 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5799 doc
: /* Continue process PROCESS. May be process or name of one.
5800 See function `interrupt-process' for more details on usage.
5801 If PROCESS is a network process, resume handling of incoming traffic. */)
5802 (process
, current_group
)
5803 Lisp_Object process
, current_group
;
5806 if (PROCESSP (process
) && NETCONN_P (process
))
5808 struct Lisp_Process
*p
;
5810 p
= XPROCESS (process
);
5811 if (EQ (p
->command
, Qt
)
5812 && XINT (p
->infd
) >= 0
5813 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
5815 FD_SET (XINT (p
->infd
), &input_wait_mask
);
5816 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
5823 process_send_signal (process
, SIGCONT
, current_group
, 0);
5825 error ("no SIGCONT support");
5830 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
5831 2, 2, "sProcess (name or number): \nnSignal code: ",
5832 doc
: /* Send PROCESS the signal with code SIGCODE.
5833 PROCESS may also be an integer specifying the process id of the
5834 process to signal; in this case, the process need not be a child of
5836 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
5838 Lisp_Object process
, sigcode
;
5842 if (INTEGERP (process
))
5848 if (STRINGP (process
))
5851 if (tem
= Fget_process (process
), NILP (tem
))
5853 pid
= Fstring_to_number (process
, make_number (10));
5854 if (XINT (pid
) != 0)
5860 process
= get_process (process
);
5865 CHECK_PROCESS (process
);
5866 pid
= XPROCESS (process
)->pid
;
5867 if (!INTEGERP (pid
) || XINT (pid
) <= 0)
5868 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
5872 #define handle_signal(NAME, VALUE) \
5873 else if (!strcmp (name, NAME)) \
5874 XSETINT (sigcode, VALUE)
5876 if (INTEGERP (sigcode
))
5880 unsigned char *name
;
5882 CHECK_SYMBOL (sigcode
);
5883 name
= SDATA (SYMBOL_NAME (sigcode
));
5888 handle_signal ("SIGHUP", SIGHUP
);
5891 handle_signal ("SIGINT", SIGINT
);
5894 handle_signal ("SIGQUIT", SIGQUIT
);
5897 handle_signal ("SIGILL", SIGILL
);
5900 handle_signal ("SIGABRT", SIGABRT
);
5903 handle_signal ("SIGEMT", SIGEMT
);
5906 handle_signal ("SIGKILL", SIGKILL
);
5909 handle_signal ("SIGFPE", SIGFPE
);
5912 handle_signal ("SIGBUS", SIGBUS
);
5915 handle_signal ("SIGSEGV", SIGSEGV
);
5918 handle_signal ("SIGSYS", SIGSYS
);
5921 handle_signal ("SIGPIPE", SIGPIPE
);
5924 handle_signal ("SIGALRM", SIGALRM
);
5927 handle_signal ("SIGTERM", SIGTERM
);
5930 handle_signal ("SIGURG", SIGURG
);
5933 handle_signal ("SIGSTOP", SIGSTOP
);
5936 handle_signal ("SIGTSTP", SIGTSTP
);
5939 handle_signal ("SIGCONT", SIGCONT
);
5942 handle_signal ("SIGCHLD", SIGCHLD
);
5945 handle_signal ("SIGTTIN", SIGTTIN
);
5948 handle_signal ("SIGTTOU", SIGTTOU
);
5951 handle_signal ("SIGIO", SIGIO
);
5954 handle_signal ("SIGXCPU", SIGXCPU
);
5957 handle_signal ("SIGXFSZ", SIGXFSZ
);
5960 handle_signal ("SIGVTALRM", SIGVTALRM
);
5963 handle_signal ("SIGPROF", SIGPROF
);
5966 handle_signal ("SIGWINCH", SIGWINCH
);
5969 handle_signal ("SIGINFO", SIGINFO
);
5972 handle_signal ("SIGUSR1", SIGUSR1
);
5975 handle_signal ("SIGUSR2", SIGUSR2
);
5978 error ("Undefined signal name %s", name
);
5981 #undef handle_signal
5983 return make_number (kill (XINT (pid
), XINT (sigcode
)));
5986 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
5987 doc
: /* Make PROCESS see end-of-file in its input.
5988 EOF comes after any text already sent to it.
5989 PROCESS may be a process, a buffer, the name of a process or buffer, or
5990 nil, indicating the current buffer's process.
5991 If PROCESS is a network connection, or is a process communicating
5992 through a pipe (as opposed to a pty), then you cannot send any more
5993 text to PROCESS after you call this function. */)
5995 Lisp_Object process
;
5998 struct coding_system
*coding
;
6000 if (DATAGRAM_CONN_P (process
))
6003 proc
= get_process (process
);
6004 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
6006 /* Make sure the process is really alive. */
6007 if (! NILP (XPROCESS (proc
)->raw_status_low
))
6008 update_status (XPROCESS (proc
));
6009 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6010 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6012 if (CODING_REQUIRE_FLUSHING (coding
))
6014 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6015 send_process (proc
, "", 0, Qnil
);
6019 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6021 if (!NILP (XPROCESS (proc
)->pty_flag
))
6022 send_process (proc
, "\004", 1, Qnil
);
6025 int old_outfd
, new_outfd
;
6027 #ifdef HAVE_SHUTDOWN
6028 /* If this is a network connection, or socketpair is used
6029 for communication with the subprocess, call shutdown to cause EOF.
6030 (In some old system, shutdown to socketpair doesn't work.
6031 Then we just can't win.) */
6032 if (NILP (XPROCESS (proc
)->pid
)
6033 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
6034 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
6035 /* In case of socketpair, outfd == infd, so don't close it. */
6036 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
6037 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6038 #else /* not HAVE_SHUTDOWN */
6039 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6040 #endif /* not HAVE_SHUTDOWN */
6041 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6042 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
6044 if (!proc_encode_coding_system
[new_outfd
])
6045 proc_encode_coding_system
[new_outfd
]
6046 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6047 bcopy (proc_encode_coding_system
[old_outfd
],
6048 proc_encode_coding_system
[new_outfd
],
6049 sizeof (struct coding_system
));
6050 bzero (proc_encode_coding_system
[old_outfd
],
6051 sizeof (struct coding_system
));
6053 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
6059 /* Kill all processes associated with `buffer'.
6060 If `buffer' is nil, kill all processes */
6063 kill_buffer_processes (buffer
)
6066 Lisp_Object tail
, proc
;
6068 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6070 proc
= XCDR (XCAR (tail
));
6071 if (GC_PROCESSP (proc
)
6072 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6074 if (NETCONN_P (proc
))
6075 Fdelete_process (proc
);
6076 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
6077 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6082 /* On receipt of a signal that a child status has changed, loop asking
6083 about children with changed statuses until the system says there
6086 All we do is change the status; we do not run sentinels or print
6087 notifications. That is saved for the next time keyboard input is
6088 done, in order to avoid timing errors.
6090 ** WARNING: this can be called during garbage collection.
6091 Therefore, it must not be fooled by the presence of mark bits in
6094 ** USG WARNING: Although it is not obvious from the documentation
6095 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6096 signal() before executing at least one wait(), otherwise the
6097 handler will be called again, resulting in an infinite loop. The
6098 relevant portion of the documentation reads "SIGCLD signals will be
6099 queued and the signal-catching function will be continually
6100 reentered until the queue is empty". Invoking signal() causes the
6101 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6104 ** Malloc WARNING: This should never call malloc either directly or
6105 indirectly; if it does, that is a bug */
6108 sigchld_handler (signo
)
6111 int old_errno
= errno
;
6113 register struct Lisp_Process
*p
;
6114 extern EMACS_TIME
*input_available_clear_time
;
6118 sigheld
|= sigbit (SIGCHLD
);
6130 #endif /* no WUNTRACED */
6131 /* Keep trying to get a status until we get a definitive result. */
6135 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6137 while (pid
< 0 && errno
== EINTR
);
6141 /* PID == 0 means no processes found, PID == -1 means a real
6142 failure. We have done all our job, so return. */
6144 /* USG systems forget handlers when they are used;
6145 must reestablish each time */
6146 #if defined (USG) && !defined (POSIX_SIGNALS)
6147 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6150 sigheld
&= ~sigbit (SIGCHLD
);
6158 #endif /* no WNOHANG */
6160 /* Find the process that signaled us, and record its status. */
6163 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6165 proc
= XCDR (XCAR (tail
));
6166 p
= XPROCESS (proc
);
6167 if (GC_EQ (p
->childp
, Qt
) && XINT (p
->pid
) == pid
)
6172 /* Look for an asynchronous process whose pid hasn't been filled
6175 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6177 proc
= XCDR (XCAR (tail
));
6178 p
= XPROCESS (proc
);
6179 if (GC_INTEGERP (p
->pid
) && XINT (p
->pid
) == -1)
6184 /* Change the status of the process that was found. */
6187 union { int i
; WAITTYPE wt
; } u
;
6188 int clear_desc_flag
= 0;
6190 XSETINT (p
->tick
, ++process_tick
);
6192 XSETINT (p
->raw_status_low
, u
.i
& 0xffff);
6193 XSETINT (p
->raw_status_high
, u
.i
>> 16);
6195 /* If process has terminated, stop waiting for its output. */
6196 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6197 && XINT (p
->infd
) >= 0)
6198 clear_desc_flag
= 1;
6200 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6201 if (clear_desc_flag
)
6203 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6204 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6207 /* Tell wait_reading_process_input that it needs to wake up and
6209 if (input_available_clear_time
)
6210 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6213 /* There was no asynchronous process found for that id. Check
6214 if we have a synchronous process. */
6217 synch_process_alive
= 0;
6219 /* Report the status of the synchronous process. */
6221 synch_process_retcode
= WRETCODE (w
);
6222 else if (WIFSIGNALED (w
))
6223 synch_process_termsig
= WTERMSIG (w
);
6225 /* Tell wait_reading_process_input that it needs to wake up and
6227 if (input_available_clear_time
)
6228 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6231 /* On some systems, we must return right away.
6232 If any more processes want to signal us, we will
6234 Otherwise (on systems that have WNOHANG), loop around
6235 to use up all the processes that have something to tell us. */
6236 #if (defined WINDOWSNT \
6237 || (defined USG && !defined GNU_LINUX \
6238 && !(defined HPUX && defined WNOHANG)))
6239 #if defined (USG) && ! defined (POSIX_SIGNALS)
6240 signal (signo
, sigchld_handler
);
6244 #endif /* USG, but not HPUX with WNOHANG */
6250 exec_sentinel_unwind (data
)
6253 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6258 exec_sentinel_error_handler (error
)
6261 cmd_error_internal (error
, "error in process sentinel: ");
6263 update_echo_area ();
6264 Fsleep_for (make_number (2), Qnil
);
6269 exec_sentinel (proc
, reason
)
6270 Lisp_Object proc
, reason
;
6272 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6273 register struct Lisp_Process
*p
= XPROCESS (proc
);
6274 int count
= SPECPDL_INDEX ();
6275 int outer_running_asynch_code
= running_asynch_code
;
6276 int waiting
= waiting_for_user_input_p
;
6278 /* No need to gcpro these, because all we do with them later
6279 is test them for EQness, and none of them should be a string. */
6280 odeactivate
= Vdeactivate_mark
;
6281 XSETBUFFER (obuffer
, current_buffer
);
6282 okeymap
= current_buffer
->keymap
;
6284 sentinel
= p
->sentinel
;
6285 if (NILP (sentinel
))
6288 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6289 assure that it gets restored no matter how the sentinel exits. */
6291 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6292 /* Inhibit quit so that random quits don't screw up a running filter. */
6293 specbind (Qinhibit_quit
, Qt
);
6294 specbind (Qlast_nonmenu_event
, Qt
);
6296 /* In case we get recursively called,
6297 and we already saved the match data nonrecursively,
6298 save the same match data in safely recursive fashion. */
6299 if (outer_running_asynch_code
)
6302 tem
= Fmatch_data (Qnil
, Qnil
);
6303 restore_match_data ();
6304 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
6305 Fset_match_data (tem
);
6308 /* For speed, if a search happens within this code,
6309 save the match data in a special nonrecursive fashion. */
6310 running_asynch_code
= 1;
6312 internal_condition_case_1 (read_process_output_call
,
6314 Fcons (proc
, Fcons (reason
, Qnil
))),
6315 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6316 exec_sentinel_error_handler
);
6318 /* If we saved the match data nonrecursively, restore it now. */
6319 restore_match_data ();
6320 running_asynch_code
= outer_running_asynch_code
;
6322 Vdeactivate_mark
= odeactivate
;
6324 /* Restore waiting_for_user_input_p as it was
6325 when we were called, in case the filter clobbered it. */
6326 waiting_for_user_input_p
= waiting
;
6329 if (! EQ (Fcurrent_buffer (), obuffer
)
6330 || ! EQ (current_buffer
->keymap
, okeymap
))
6332 /* But do it only if the caller is actually going to read events.
6333 Otherwise there's no need to make him wake up, and it could
6334 cause trouble (for example it would make Fsit_for return). */
6335 if (waiting_for_user_input_p
== -1)
6336 record_asynch_buffer_change ();
6338 unbind_to (count
, Qnil
);
6341 /* Report all recent events of a change in process status
6342 (either run the sentinel or output a message).
6343 This is usually done while Emacs is waiting for keyboard input
6344 but can be done at other times. */
6349 register Lisp_Object proc
, buffer
;
6350 Lisp_Object tail
, msg
;
6351 struct gcpro gcpro1
, gcpro2
;
6355 /* We need to gcpro tail; if read_process_output calls a filter
6356 which deletes a process and removes the cons to which tail points
6357 from Vprocess_alist, and then causes a GC, tail is an unprotected
6361 /* Set this now, so that if new processes are created by sentinels
6362 that we run, we get called again to handle their status changes. */
6363 update_tick
= process_tick
;
6365 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6368 register struct Lisp_Process
*p
;
6370 proc
= Fcdr (Fcar (tail
));
6371 p
= XPROCESS (proc
);
6373 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6375 XSETINT (p
->update_tick
, XINT (p
->tick
));
6377 /* If process is still active, read any output that remains. */
6378 while (! EQ (p
->filter
, Qt
)
6379 && ! EQ (p
->status
, Qconnect
)
6380 && ! EQ (p
->status
, Qlisten
)
6381 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6382 && XINT (p
->infd
) >= 0
6383 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6387 /* Get the text to use for the message. */
6388 if (!NILP (p
->raw_status_low
))
6390 msg
= status_message (p
->status
);
6392 /* If process is terminated, deactivate it or delete it. */
6394 if (CONSP (p
->status
))
6395 symbol
= XCAR (p
->status
);
6397 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6398 || EQ (symbol
, Qclosed
))
6400 if (delete_exited_processes
)
6401 remove_process (proc
);
6403 deactivate_process (proc
);
6406 /* The actions above may have further incremented p->tick.
6407 So set p->update_tick again
6408 so that an error in the sentinel will not cause
6409 this code to be run again. */
6410 XSETINT (p
->update_tick
, XINT (p
->tick
));
6411 /* Now output the message suitably. */
6412 if (!NILP (p
->sentinel
))
6413 exec_sentinel (proc
, msg
);
6414 /* Don't bother with a message in the buffer
6415 when a process becomes runnable. */
6416 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6418 Lisp_Object ro
, tem
;
6419 struct buffer
*old
= current_buffer
;
6420 int opoint
, opoint_byte
;
6421 int before
, before_byte
;
6423 ro
= XBUFFER (buffer
)->read_only
;
6425 /* Avoid error if buffer is deleted
6426 (probably that's why the process is dead, too) */
6427 if (NILP (XBUFFER (buffer
)->name
))
6429 Fset_buffer (buffer
);
6432 opoint_byte
= PT_BYTE
;
6433 /* Insert new output into buffer
6434 at the current end-of-output marker,
6435 thus preserving logical ordering of input and output. */
6436 if (XMARKER (p
->mark
)->buffer
)
6437 Fgoto_char (p
->mark
);
6439 SET_PT_BOTH (ZV
, ZV_BYTE
);
6442 before_byte
= PT_BYTE
;
6444 tem
= current_buffer
->read_only
;
6445 current_buffer
->read_only
= Qnil
;
6446 insert_string ("\nProcess ");
6447 Finsert (1, &p
->name
);
6448 insert_string (" ");
6450 current_buffer
->read_only
= tem
;
6451 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6453 if (opoint
>= before
)
6454 SET_PT_BOTH (opoint
+ (PT
- before
),
6455 opoint_byte
+ (PT_BYTE
- before_byte
));
6457 SET_PT_BOTH (opoint
, opoint_byte
);
6459 set_buffer_internal (old
);
6464 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6465 redisplay_preserve_echo_area (13);
6471 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6472 Sset_process_coding_system
, 1, 3, 0,
6473 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6474 DECODING will be used to decode subprocess output and ENCODING to
6475 encode subprocess input. */)
6476 (process
, decoding
, encoding
)
6477 register Lisp_Object process
, decoding
, encoding
;
6479 register struct Lisp_Process
*p
;
6481 CHECK_PROCESS (process
);
6482 p
= XPROCESS (process
);
6483 if (XINT (p
->infd
) < 0)
6484 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6485 if (XINT (p
->outfd
) < 0)
6486 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6487 Fcheck_coding_system (decoding
);
6488 Fcheck_coding_system (encoding
);
6490 p
->decode_coding_system
= decoding
;
6491 p
->encode_coding_system
= encoding
;
6492 setup_process_coding_systems (process
);
6497 DEFUN ("process-coding-system",
6498 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6499 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6501 register Lisp_Object process
;
6503 CHECK_PROCESS (process
);
6504 return Fcons (XPROCESS (process
)->decode_coding_system
,
6505 XPROCESS (process
)->encode_coding_system
);
6508 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6509 Sset_process_filter_multibyte
, 2, 2, 0,
6510 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6511 If FLAG is non-nil, the filter is given multibyte strings.
6512 If FLAG is nil, the filter is given unibyte strings. In this case,
6513 all character code conversion except for end-of-line conversion is
6516 Lisp_Object process
, flag
;
6518 register struct Lisp_Process
*p
;
6520 CHECK_PROCESS (process
);
6521 p
= XPROCESS (process
);
6522 p
->filter_multibyte
= flag
;
6523 setup_process_coding_systems (process
);
6528 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6529 Sprocess_filter_multibyte_p
, 1, 1, 0,
6530 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6532 Lisp_Object process
;
6534 register struct Lisp_Process
*p
;
6536 CHECK_PROCESS (process
);
6537 p
= XPROCESS (process
);
6539 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6544 /* The first time this is called, assume keyboard input comes from DESC
6545 instead of from where we used to expect it.
6546 Subsequent calls mean assume input keyboard can come from DESC
6547 in addition to other places. */
6549 static int add_keyboard_wait_descriptor_called_flag
;
6552 add_keyboard_wait_descriptor (desc
)
6555 if (! add_keyboard_wait_descriptor_called_flag
)
6556 FD_CLR (0, &input_wait_mask
);
6557 add_keyboard_wait_descriptor_called_flag
= 1;
6558 FD_SET (desc
, &input_wait_mask
);
6559 FD_SET (desc
, &non_process_wait_mask
);
6560 if (desc
> max_keyboard_desc
)
6561 max_keyboard_desc
= desc
;
6564 /* From now on, do not expect DESC to give keyboard input. */
6567 delete_keyboard_wait_descriptor (desc
)
6571 int lim
= max_keyboard_desc
;
6573 FD_CLR (desc
, &input_wait_mask
);
6574 FD_CLR (desc
, &non_process_wait_mask
);
6576 if (desc
== max_keyboard_desc
)
6577 for (fd
= 0; fd
< lim
; fd
++)
6578 if (FD_ISSET (fd
, &input_wait_mask
)
6579 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6580 max_keyboard_desc
= fd
;
6583 /* Return nonzero if *MASK has a bit set
6584 that corresponds to one of the keyboard input descriptors. */
6587 keyboard_bit_set (mask
)
6592 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6593 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6594 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6607 if (! noninteractive
|| initialized
)
6609 signal (SIGCHLD
, sigchld_handler
);
6612 FD_ZERO (&input_wait_mask
);
6613 FD_ZERO (&non_keyboard_wait_mask
);
6614 FD_ZERO (&non_process_wait_mask
);
6615 max_process_desc
= 0;
6617 #ifdef ADAPTIVE_READ_BUFFERING
6618 process_output_delay_count
= 0;
6619 process_output_skip
= 0;
6622 FD_SET (0, &input_wait_mask
);
6624 Vprocess_alist
= Qnil
;
6625 for (i
= 0; i
< MAXDESC
; i
++)
6627 chan_process
[i
] = Qnil
;
6628 proc_buffered_char
[i
] = -1;
6630 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6631 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6632 #ifdef DATAGRAM_SOCKETS
6633 bzero (datagram_address
, sizeof datagram_address
);
6638 Lisp_Object subfeatures
= Qnil
;
6639 struct socket_options
*sopt
;
6641 #define ADD_SUBFEATURE(key, val) \
6642 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6644 #ifdef NON_BLOCKING_CONNECT
6645 ADD_SUBFEATURE (QCnowait
, Qt
);
6647 #ifdef DATAGRAM_SOCKETS
6648 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6650 #ifdef HAVE_LOCAL_SOCKETS
6651 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6653 #ifdef HAVE_GETSOCKNAME
6654 ADD_SUBFEATURE (QCservice
, Qt
);
6656 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6657 ADD_SUBFEATURE (QCserver
, Qt
);
6660 for (sopt
= socket_options
; sopt
->name
; sopt
++)
6661 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
6663 Fprovide (intern ("make-network-process"), subfeatures
);
6665 #endif /* HAVE_SOCKETS */
6671 Qprocessp
= intern ("processp");
6672 staticpro (&Qprocessp
);
6673 Qrun
= intern ("run");
6675 Qstop
= intern ("stop");
6677 Qsignal
= intern ("signal");
6678 staticpro (&Qsignal
);
6680 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6683 Qexit = intern ("exit");
6684 staticpro (&Qexit); */
6686 Qopen
= intern ("open");
6688 Qclosed
= intern ("closed");
6689 staticpro (&Qclosed
);
6690 Qconnect
= intern ("connect");
6691 staticpro (&Qconnect
);
6692 Qfailed
= intern ("failed");
6693 staticpro (&Qfailed
);
6694 Qlisten
= intern ("listen");
6695 staticpro (&Qlisten
);
6696 Qlocal
= intern ("local");
6697 staticpro (&Qlocal
);
6698 Qdatagram
= intern ("datagram");
6699 staticpro (&Qdatagram
);
6701 QCname
= intern (":name");
6702 staticpro (&QCname
);
6703 QCbuffer
= intern (":buffer");
6704 staticpro (&QCbuffer
);
6705 QChost
= intern (":host");
6706 staticpro (&QChost
);
6707 QCservice
= intern (":service");
6708 staticpro (&QCservice
);
6709 QCtype
= intern (":type");
6710 staticpro (&QCtype
);
6711 QClocal
= intern (":local");
6712 staticpro (&QClocal
);
6713 QCremote
= intern (":remote");
6714 staticpro (&QCremote
);
6715 QCcoding
= intern (":coding");
6716 staticpro (&QCcoding
);
6717 QCserver
= intern (":server");
6718 staticpro (&QCserver
);
6719 QCnowait
= intern (":nowait");
6720 staticpro (&QCnowait
);
6721 QCsentinel
= intern (":sentinel");
6722 staticpro (&QCsentinel
);
6723 QClog
= intern (":log");
6725 QCnoquery
= intern (":noquery");
6726 staticpro (&QCnoquery
);
6727 QCstop
= intern (":stop");
6728 staticpro (&QCstop
);
6729 QCoptions
= intern (":options");
6730 staticpro (&QCoptions
);
6731 QCplist
= intern (":plist");
6732 staticpro (&QCplist
);
6733 QCfilter_multibyte
= intern (":filter-multibyte");
6734 staticpro (&QCfilter_multibyte
);
6736 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
6737 staticpro (&Qlast_nonmenu_event
);
6739 staticpro (&Vprocess_alist
);
6741 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
6742 doc
: /* *Non-nil means delete processes immediately when they exit.
6743 nil means don't delete them until `list-processes' is run. */);
6745 delete_exited_processes
= 1;
6747 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
6748 doc
: /* Control type of device used to communicate with subprocesses.
6749 Values are nil to use a pipe, or t or `pty' to use a pty.
6750 The value has no effect if the system has no ptys or if all ptys are busy:
6751 then a pipe is used in any case.
6752 The value takes effect when `start-process' is called. */);
6753 Vprocess_connection_type
= Qt
;
6755 #ifdef ADAPTIVE_READ_BUFFERING
6756 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
6757 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
6758 On some systems, when Emacs reads the output from a subprocess, the output data
6759 is read in very small blocks, potentially resulting in very poor performance.
6760 This behaviour can be remedied to some extent by setting this variable to a
6761 non-nil value, as it will automatically delay reading from such processes, to
6762 allowing them to produce more output before Emacs tries to read it.
6763 If the value is t, the delay is reset after each write to the process; any other
6764 non-nil value means that the delay is not reset on write.
6765 The variable takes effect when `start-process' is called. */);
6766 Vprocess_adaptive_read_buffering
= Qt
;
6769 defsubr (&Sprocessp
);
6770 defsubr (&Sget_process
);
6771 defsubr (&Sget_buffer_process
);
6772 defsubr (&Sdelete_process
);
6773 defsubr (&Sprocess_status
);
6774 defsubr (&Sprocess_exit_status
);
6775 defsubr (&Sprocess_id
);
6776 defsubr (&Sprocess_name
);
6777 defsubr (&Sprocess_tty_name
);
6778 defsubr (&Sprocess_command
);
6779 defsubr (&Sset_process_buffer
);
6780 defsubr (&Sprocess_buffer
);
6781 defsubr (&Sprocess_mark
);
6782 defsubr (&Sset_process_filter
);
6783 defsubr (&Sprocess_filter
);
6784 defsubr (&Sset_process_sentinel
);
6785 defsubr (&Sprocess_sentinel
);
6786 defsubr (&Sset_process_window_size
);
6787 defsubr (&Sset_process_inherit_coding_system_flag
);
6788 defsubr (&Sprocess_inherit_coding_system_flag
);
6789 defsubr (&Sset_process_query_on_exit_flag
);
6790 defsubr (&Sprocess_query_on_exit_flag
);
6791 defsubr (&Sprocess_contact
);
6792 defsubr (&Sprocess_plist
);
6793 defsubr (&Sset_process_plist
);
6794 defsubr (&Slist_processes
);
6795 defsubr (&Sprocess_list
);
6796 defsubr (&Sstart_process
);
6798 defsubr (&Sset_network_process_option
);
6799 defsubr (&Smake_network_process
);
6800 defsubr (&Sformat_network_address
);
6801 #endif /* HAVE_SOCKETS */
6802 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
6804 defsubr (&Snetwork_interface_list
);
6806 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
6807 defsubr (&Snetwork_interface_info
);
6809 #endif /* HAVE_SOCKETS ... */
6810 #ifdef DATAGRAM_SOCKETS
6811 defsubr (&Sprocess_datagram_address
);
6812 defsubr (&Sset_process_datagram_address
);
6814 defsubr (&Saccept_process_output
);
6815 defsubr (&Sprocess_send_region
);
6816 defsubr (&Sprocess_send_string
);
6817 defsubr (&Sinterrupt_process
);
6818 defsubr (&Skill_process
);
6819 defsubr (&Squit_process
);
6820 defsubr (&Sstop_process
);
6821 defsubr (&Scontinue_process
);
6822 defsubr (&Sprocess_running_child_p
);
6823 defsubr (&Sprocess_send_eof
);
6824 defsubr (&Ssignal_process
);
6825 defsubr (&Swaiting_for_user_input_p
);
6826 /* defsubr (&Sprocess_connection); */
6827 defsubr (&Sset_process_coding_system
);
6828 defsubr (&Sprocess_coding_system
);
6829 defsubr (&Sset_process_filter_multibyte
);
6830 defsubr (&Sprocess_filter_multibyte_p
);
6834 #else /* not subprocesses */
6836 #include <sys/types.h>
6840 #include "systime.h"
6841 #include "charset.h"
6843 #include "termopts.h"
6844 #include "sysselect.h"
6846 extern int frame_garbaged
;
6848 extern EMACS_TIME
timer_check ();
6849 extern int timers_run
;
6853 /* As described above, except assuming that there are no subprocesses:
6855 Wait for timeout to elapse and/or keyboard input to be available.
6858 timeout in seconds, or
6859 zero for no limit, or
6860 -1 means gobble data immediately available but don't wait for any.
6862 read_kbd is a Lisp_Object:
6863 0 to ignore keyboard input, or
6864 1 to return when input is available, or
6865 -1 means caller will actually read the input, so don't throw to
6867 a cons cell, meaning wait until its car is non-nil
6868 (and gobble terminal input into the buffer if any arrives), or
6869 We know that read_kbd will never be a Lisp_Process, since
6870 `subprocesses' isn't defined.
6872 do_display != 0 means redisplay should be done to show subprocess
6873 output that arrives.
6875 Return true iff we received input from any process. */
6878 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
6879 int time_limit
, microsecs
;
6880 Lisp_Object read_kbd
;
6884 EMACS_TIME end_time
, timeout
;
6885 SELECT_TYPE waitchannels
;
6887 /* Either nil or a cons cell, the car of which is of interest and
6888 may be changed outside of this routine. */
6889 Lisp_Object wait_for_cell
;
6891 wait_for_cell
= Qnil
;
6893 /* If waiting for non-nil in a cell, record where. */
6894 if (CONSP (read_kbd
))
6896 wait_for_cell
= read_kbd
;
6897 XSETFASTINT (read_kbd
, 0);
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. */
6921 if (XINT (read_kbd
) >= 0)
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. */
6972 if (XINT (read_kbd
) != 0
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. */
6990 if (XINT (read_kbd
) < 0)
6991 set_waiting_for_input (&timeout
);
6993 /* Wait till there is something to do. */
6995 if (! XINT (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);
7006 if (XINT (read_kbd
) < 0)
7007 set_waiting_for_input (&timeout
);
7010 if (XINT (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 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7042 /* System sometimes fails to deliver SIGIO. */
7043 kill (getpid (), SIGIO
);
7046 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
7047 kill (getpid (), SIGIO
);
7050 /* Check for keyboard input */
7052 if ((XINT (read_kbd
) != 0)
7053 && detect_input_pending_run_timers (do_display
))
7055 swallow_events (do_display
);
7056 if (detect_input_pending_run_timers (do_display
))
7060 /* If there is unread keyboard input, also return. */
7061 if (XINT (read_kbd
) != 0
7062 && requeued_events_pending_p ())
7065 /* If wait_for_cell. check for keyboard input
7066 but don't run any timers.
7067 ??? (It seems wrong to me to check for keyboard
7068 input at all when wait_for_cell, but the code
7069 has been this way since July 1994.
7070 Try changing this after version 19.31.) */
7071 if (! NILP (wait_for_cell
)
7072 && detect_input_pending ())
7074 swallow_events (do_display
);
7075 if (detect_input_pending ())
7079 /* Exit now if the cell we're waiting for became non-nil. */
7080 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7090 /* Don't confuse make-docfile by having two doc strings for this function.
7091 make-docfile does not pay attention to #if, for good reason! */
7092 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7095 register Lisp_Object name
;
7100 /* Don't confuse make-docfile by having two doc strings for this function.
7101 make-docfile does not pay attention to #if, for good reason! */
7102 DEFUN ("process-inherit-coding-system-flag",
7103 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7107 register Lisp_Object process
;
7109 /* Ignore the argument and return the value of
7110 inherit-process-coding-system. */
7111 return inherit_process_coding_system
? Qt
: Qnil
;
7114 /* Kill all processes associated with `buffer'.
7115 If `buffer' is nil, kill all processes.
7116 Since we have no subprocesses, this does nothing. */
7119 kill_buffer_processes (buffer
)
7132 QCtype
= intern (":type");
7133 staticpro (&QCtype
);
7135 defsubr (&Sget_buffer_process
);
7136 defsubr (&Sprocess_inherit_coding_system_flag
);
7140 #endif /* not subprocesses */
7142 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7143 (do not change this comment) */