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 Unix 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 Third arg is 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 static SELECT_TYPE Available
;
4022 static 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
;
4034 FD_ZERO (&Available
);
4035 FD_ZERO (&Connecting
);
4037 /* If read_kbd is a process to watch, set wait_proc and wait_channel
4039 if (PROCESSP (read_kbd
))
4041 wait_proc
= XPROCESS (read_kbd
);
4042 wait_channel
= XINT (wait_proc
->infd
);
4043 XSETFASTINT (read_kbd
, 0);
4046 /* If waiting for non-nil in a cell, record where. */
4047 if (CONSP (read_kbd
))
4049 wait_for_cell
= read_kbd
;
4050 XSETFASTINT (read_kbd
, 0);
4053 waiting_for_user_input_p
= XINT (read_kbd
);
4055 /* Since we may need to wait several times,
4056 compute the absolute time to return at. */
4057 if (time_limit
|| microsecs
)
4059 EMACS_GET_TIME (end_time
);
4060 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4061 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4063 #ifdef POLL_INTERRUPTED_SYS_CALL
4064 /* AlainF 5-Jul-1996
4065 HP-UX 10.10 seem to have problems with signals coming in
4066 Causes "poll: interrupted system call" messages when Emacs is run
4068 Turn off periodic alarms (in case they are in use),
4069 and then turn off any other atimers. */
4071 turn_on_atimers (0);
4072 #endif /* POLL_INTERRUPTED_SYS_CALL */
4076 int timeout_reduced_for_timers
= 0;
4078 /* If calling from keyboard input, do not quit
4079 since we want to return C-g as an input character.
4080 Otherwise, do pending quit if requested. */
4081 if (XINT (read_kbd
) >= 0)
4084 else if (interrupt_input_pending
)
4085 handle_async_input ();
4088 /* Exit now if the cell we're waiting for became non-nil. */
4089 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4092 /* Compute time from now till when time limit is up */
4093 /* Exit if already run out */
4094 if (time_limit
== -1)
4096 /* -1 specified for timeout means
4097 gobble output available now
4098 but don't wait at all. */
4100 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4102 else if (time_limit
|| microsecs
)
4104 EMACS_GET_TIME (timeout
);
4105 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4106 if (EMACS_TIME_NEG_P (timeout
))
4111 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4114 /* Normally we run timers here.
4115 But not if wait_for_cell; in those cases,
4116 the wait is supposed to be short,
4117 and those callers cannot handle running arbitrary Lisp code here. */
4118 if (NILP (wait_for_cell
))
4120 EMACS_TIME timer_delay
;
4124 int old_timers_run
= timers_run
;
4125 struct buffer
*old_buffer
= current_buffer
;
4127 timer_delay
= timer_check (1);
4129 /* If a timer has run, this might have changed buffers
4130 an alike. Make read_key_sequence aware of that. */
4131 if (timers_run
!= old_timers_run
4132 && old_buffer
!= current_buffer
4133 && waiting_for_user_input_p
== -1)
4134 record_asynch_buffer_change ();
4136 if (timers_run
!= old_timers_run
&& do_display
)
4137 /* We must retry, since a timer may have requeued itself
4138 and that could alter the time_delay. */
4139 redisplay_preserve_echo_area (9);
4143 while (!detect_input_pending ());
4145 /* If there is unread keyboard input, also return. */
4146 if (XINT (read_kbd
) != 0
4147 && requeued_events_pending_p ())
4150 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4152 EMACS_TIME difference
;
4153 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4154 if (EMACS_TIME_NEG_P (difference
))
4156 timeout
= timer_delay
;
4157 timeout_reduced_for_timers
= 1;
4160 /* If time_limit is -1, we are not going to wait at all. */
4161 else if (time_limit
!= -1)
4163 /* This is so a breakpoint can be put here. */
4164 wait_reading_process_input_1 ();
4168 /* Cause C-g and alarm signals to take immediate action,
4169 and cause input available signals to zero out timeout.
4171 It is important that we do this before checking for process
4172 activity. If we get a SIGCHLD after the explicit checks for
4173 process activity, timeout is the only way we will know. */
4174 if (XINT (read_kbd
) < 0)
4175 set_waiting_for_input (&timeout
);
4177 /* If status of something has changed, and no input is
4178 available, notify the user of the change right away. After
4179 this explicit check, we'll let the SIGCHLD handler zap
4180 timeout to get our attention. */
4181 if (update_tick
!= process_tick
&& do_display
)
4183 SELECT_TYPE Atemp
, Ctemp
;
4185 Atemp
= input_wait_mask
;
4187 /* On Mac OS X, the SELECT system call always says input is
4188 present (for reading) at stdin, even when none is. This
4189 causes the call to SELECT below to return 1 and
4190 status_notify not to be called. As a result output of
4191 subprocesses are incorrectly discarded. */
4194 Ctemp
= connect_wait_mask
;
4195 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4196 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
4198 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4199 (SELECT_TYPE
*)0, &timeout
)
4202 /* It's okay for us to do this and then continue with
4203 the loop, since timeout has already been zeroed out. */
4204 clear_waiting_for_input ();
4209 /* Don't wait for output from a non-running process. Just
4210 read whatever data has already been received. */
4211 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
4212 update_status (wait_proc
);
4214 && ! EQ (wait_proc
->status
, Qrun
)
4215 && ! EQ (wait_proc
->status
, Qconnect
))
4217 int nread
, total_nread
= 0;
4219 clear_waiting_for_input ();
4220 XSETPROCESS (proc
, wait_proc
);
4222 /* Read data from the process, until we exhaust it. */
4223 while (XINT (wait_proc
->infd
) >= 0)
4225 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
4231 total_nread
+= nread
;
4233 else if (nread
== -1 && EIO
== errno
)
4237 else if (nread
== -1 && EAGAIN
== errno
)
4241 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4245 if (total_nread
> 0 && do_display
)
4246 redisplay_preserve_echo_area (10);
4251 /* Wait till there is something to do */
4253 if (!NILP (wait_for_cell
))
4255 Available
= non_process_wait_mask
;
4256 check_connect
= check_delay
= 0;
4260 if (! XINT (read_kbd
))
4261 Available
= non_keyboard_wait_mask
;
4263 Available
= input_wait_mask
;
4264 check_connect
= (num_pending_connects
> 0);
4265 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4268 /* If frame size has changed or the window is newly mapped,
4269 redisplay now, before we start to wait. There is a race
4270 condition here; if a SIGIO arrives between now and the select
4271 and indicates that a frame is trashed, the select may block
4272 displaying a trashed screen. */
4273 if (frame_garbaged
&& do_display
)
4275 clear_waiting_for_input ();
4276 redisplay_preserve_echo_area (11);
4277 if (XINT (read_kbd
) < 0)
4278 set_waiting_for_input (&timeout
);
4282 if (XINT (read_kbd
) && detect_input_pending ())
4290 Connecting
= connect_wait_mask
;
4292 #ifdef ADAPTIVE_READ_BUFFERING
4293 if (process_output_skip
&& check_delay
> 0)
4295 int usecs
= EMACS_USECS (timeout
);
4296 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4297 usecs
= READ_OUTPUT_DELAY_MAX
;
4298 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4300 proc
= chan_process
[channel
];
4303 if (XINT (XPROCESS (proc
)->read_output_delay
) > 0)
4306 if (NILP (XPROCESS (proc
)->read_output_skip
))
4308 FD_CLR (channel
, &Available
);
4309 XPROCESS (proc
)->read_output_skip
= Qnil
;
4310 if (XINT (XPROCESS (proc
)->read_output_delay
) < usecs
)
4311 usecs
= XINT (XPROCESS (proc
)->read_output_delay
);
4314 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4315 process_output_skip
= 0;
4319 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4321 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4322 (SELECT_TYPE
*)0, &timeout
);
4327 /* Make C-g and alarm signals set flags again */
4328 clear_waiting_for_input ();
4330 /* If we woke up due to SIGWINCH, actually change size now. */
4331 do_pending_window_change (0);
4333 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4334 /* We wanted the full specified time, so return now. */
4338 if (xerrno
== EINTR
)
4341 /* Ultrix select seems to return ENOMEM when it is
4342 interrupted. Treat it just like EINTR. Bleah. Note
4343 that we want to test for the "ultrix" CPP symbol, not
4344 "__ultrix__"; the latter is only defined under GCC, but
4345 not by DEC's bundled CC. -JimB */
4346 else if (xerrno
== ENOMEM
)
4350 /* This happens for no known reason on ALLIANT.
4351 I am guessing that this is the right response. -- RMS. */
4352 else if (xerrno
== EFAULT
)
4355 else if (xerrno
== EBADF
)
4358 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4359 the child's closure of the pts gives the parent a SIGHUP, and
4360 the ptc file descriptor is automatically closed,
4361 yielding EBADF here or at select() call above.
4362 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4363 in m/ibmrt-aix.h), and here we just ignore the select error.
4364 Cleanup occurs c/o status_notify after SIGCLD. */
4365 no_avail
= 1; /* Cannot depend on values returned */
4371 error ("select error: %s", emacs_strerror (xerrno
));
4376 FD_ZERO (&Available
);
4380 #if defined(sun) && !defined(USG5_4)
4381 if (nfds
> 0 && keyboard_bit_set (&Available
)
4383 /* System sometimes fails to deliver SIGIO.
4385 David J. Mackenzie says that Emacs doesn't compile under
4386 Solaris if this code is enabled, thus the USG5_4 in the CPP
4387 conditional. "I haven't noticed any ill effects so far.
4388 If you find a Solaris expert somewhere, they might know
4390 kill (getpid (), SIGIO
);
4393 #if 0 /* When polling is used, interrupt_input is 0,
4394 so get_input_pending should read the input.
4395 So this should not be needed. */
4396 /* If we are using polling for input,
4397 and we see input available, make it get read now.
4398 Otherwise it might not actually get read for a second.
4399 And on hpux, since we turn off polling in wait_reading_process_input,
4400 it might never get read at all if we don't spend much time
4401 outside of wait_reading_process_input. */
4402 if (XINT (read_kbd
) && interrupt_input
4403 && keyboard_bit_set (&Available
)
4404 && input_polling_used ())
4405 kill (getpid (), SIGALRM
);
4408 /* Check for keyboard input */
4409 /* If there is any, return immediately
4410 to give it higher priority than subprocesses */
4412 if (XINT (read_kbd
) != 0)
4414 int old_timers_run
= timers_run
;
4415 struct buffer
*old_buffer
= current_buffer
;
4418 if (detect_input_pending_run_timers (do_display
))
4420 swallow_events (do_display
);
4421 if (detect_input_pending_run_timers (do_display
))
4425 /* If a timer has run, this might have changed buffers
4426 an alike. Make read_key_sequence aware of that. */
4427 if (timers_run
!= old_timers_run
4428 && waiting_for_user_input_p
== -1
4429 && old_buffer
!= current_buffer
)
4430 record_asynch_buffer_change ();
4436 /* If there is unread keyboard input, also return. */
4437 if (XINT (read_kbd
) != 0
4438 && requeued_events_pending_p ())
4441 /* If we are not checking for keyboard input now,
4442 do process events (but don't run any timers).
4443 This is so that X events will be processed.
4444 Otherwise they may have to wait until polling takes place.
4445 That would causes delays in pasting selections, for example.
4447 (We used to do this only if wait_for_cell.) */
4448 if (XINT (read_kbd
) == 0 && detect_input_pending ())
4450 swallow_events (do_display
);
4451 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4452 if (detect_input_pending ())
4457 /* Exit now if the cell we're waiting for became non-nil. */
4458 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4462 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4463 go read it. This can happen with X on BSD after logging out.
4464 In that case, there really is no input and no SIGIO,
4465 but select says there is input. */
4467 if (XINT (read_kbd
) && interrupt_input
4468 && keyboard_bit_set (&Available
) && ! noninteractive
)
4469 kill (getpid (), SIGIO
);
4473 got_some_input
|= nfds
> 0;
4475 /* If checking input just got us a size-change event from X,
4476 obey it now if we should. */
4477 if (XINT (read_kbd
) || ! NILP (wait_for_cell
))
4478 do_pending_window_change (0);
4480 /* Check for data from a process. */
4481 if (no_avail
|| nfds
== 0)
4484 /* Really FIRST_PROC_DESC should be 0 on Unix,
4485 but this is safer in the short run. */
4486 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4488 if (FD_ISSET (channel
, &Available
)
4489 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4493 /* If waiting for this channel, arrange to return as
4494 soon as no more input to be processed. No more
4496 if (wait_channel
== channel
)
4502 proc
= chan_process
[channel
];
4506 /* If this is a server stream socket, accept connection. */
4507 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4509 server_accept_connection (proc
, channel
);
4513 /* Read data from the process, starting with our
4514 buffered-ahead character if we have one. */
4516 nread
= read_process_output (proc
, channel
);
4519 /* Since read_process_output can run a filter,
4520 which can call accept-process-output,
4521 don't try to read from any other processes
4522 before doing the select again. */
4523 FD_ZERO (&Available
);
4526 redisplay_preserve_echo_area (12);
4529 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4532 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4533 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4535 else if (nread
== -1 && errno
== EAGAIN
)
4539 else if (nread
== -1 && errno
== EAGAIN
)
4541 /* Note that we cannot distinguish between no input
4542 available now and a closed pipe.
4543 With luck, a closed pipe will be accompanied by
4544 subprocess termination and SIGCHLD. */
4545 else if (nread
== 0 && !NETCONN_P (proc
))
4547 #endif /* O_NDELAY */
4548 #endif /* O_NONBLOCK */
4550 /* On some OSs with ptys, when the process on one end of
4551 a pty exits, the other end gets an error reading with
4552 errno = EIO instead of getting an EOF (0 bytes read).
4553 Therefore, if we get an error reading and errno =
4554 EIO, just continue, because the child process has
4555 exited and should clean itself up soon (e.g. when we
4558 However, it has been known to happen that the SIGCHLD
4559 got lost. So raise the signl again just in case.
4561 else if (nread
== -1 && errno
== EIO
)
4562 kill (getpid (), SIGCHLD
);
4563 #endif /* HAVE_PTYS */
4564 /* If we can detect process termination, don't consider the process
4565 gone just because its pipe is closed. */
4567 else if (nread
== 0 && !NETCONN_P (proc
))
4572 /* Preserve status of processes already terminated. */
4573 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4574 deactivate_process (proc
);
4575 if (!NILP (XPROCESS (proc
)->raw_status_low
))
4576 update_status (XPROCESS (proc
));
4577 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4578 XPROCESS (proc
)->status
4579 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4582 #ifdef NON_BLOCKING_CONNECT
4583 if (check_connect
&& FD_ISSET (channel
, &Connecting
))
4585 struct Lisp_Process
*p
;
4587 FD_CLR (channel
, &connect_wait_mask
);
4588 if (--num_pending_connects
< 0)
4591 proc
= chan_process
[channel
];
4595 p
= XPROCESS (proc
);
4598 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4599 So only use it on systems where it is known to work. */
4601 int xlen
= sizeof(xerrno
);
4602 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4607 struct sockaddr pname
;
4608 int pnamelen
= sizeof(pname
);
4610 /* If connection failed, getpeername will fail. */
4612 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4614 /* Obtain connect failure code through error slippage. */
4617 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4624 XSETINT (p
->tick
, ++process_tick
);
4625 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4626 deactivate_process (proc
);
4631 /* Execute the sentinel here. If we had relied on
4632 status_notify to do it later, it will read input
4633 from the process before calling the sentinel. */
4634 exec_sentinel (proc
, build_string ("open\n"));
4635 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4637 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4638 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4642 #endif /* NON_BLOCKING_CONNECT */
4643 } /* end for each file descriptor */
4644 } /* end while exit conditions not met */
4646 waiting_for_user_input_p
= 0;
4648 /* If calling from keyboard input, do not quit
4649 since we want to return C-g as an input character.
4650 Otherwise, do pending quit if requested. */
4651 if (XINT (read_kbd
) >= 0)
4653 /* Prevent input_pending from remaining set if we quit. */
4654 clear_input_pending ();
4657 #ifdef POLL_INTERRUPTED_SYS_CALL
4658 /* AlainF 5-Jul-1996
4659 HP-UX 10.10 seems to have problems with signals coming in
4660 Causes "poll: interrupted system call" messages when Emacs is run
4662 Turn periodic alarms back on */
4664 #endif /* POLL_INTERRUPTED_SYS_CALL */
4666 return got_some_input
;
4669 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4672 read_process_output_call (fun_and_args
)
4673 Lisp_Object fun_and_args
;
4675 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4679 read_process_output_error_handler (error
)
4682 cmd_error_internal (error
, "error in process filter: ");
4684 update_echo_area ();
4685 Fsleep_for (make_number (2), Qnil
);
4689 /* Read pending output from the process channel,
4690 starting with our buffered-ahead character if we have one.
4691 Yield number of decoded characters read.
4693 This function reads at most 1024 characters.
4694 If you want to read all available subprocess output,
4695 you must call it repeatedly until it returns zero.
4697 The characters read are decoded according to PROC's coding-system
4701 read_process_output (proc
, channel
)
4703 register int channel
;
4705 register int nbytes
;
4707 register Lisp_Object outstream
;
4708 register struct buffer
*old
= current_buffer
;
4709 register struct Lisp_Process
*p
= XPROCESS (proc
);
4710 register int opoint
;
4711 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4712 int carryover
= XINT (p
->decoding_carryover
);
4716 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4718 vs
= get_vms_process_pointer (p
->pid
);
4722 return (0); /* Really weird if it does this */
4723 if (!(vs
->iosb
[0] & 1))
4724 return -1; /* I/O error */
4727 error ("Could not get VMS process pointer");
4728 chars
= vs
->inputBuffer
;
4729 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4732 start_vms_process_read (vs
); /* Crank up the next read on the process */
4733 return 1; /* Nothing worth printing, say we got 1 */
4737 /* The data carried over in the previous decoding (which are at
4738 the tail of decoding buffer) should be prepended to the new
4739 data read to decode all together. */
4740 chars
= (char *) alloca (nbytes
+ carryover
);
4741 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4742 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4746 #ifdef DATAGRAM_SOCKETS
4747 /* A datagram is one packet; allow at least 1500+ bytes of data
4748 corresponding to the typical Ethernet frame size. */
4749 if (DATAGRAM_CHAN_P (channel
))
4751 /* carryover = 0; */ /* Does carryover make sense for datagrams? */
4756 chars
= (char *) alloca (carryover
+ readmax
);
4758 /* See the comment above. */
4759 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
4761 #ifdef DATAGRAM_SOCKETS
4762 /* We have a working select, so proc_buffered_char is always -1. */
4763 if (DATAGRAM_CHAN_P (channel
))
4765 int len
= datagram_address
[channel
].len
;
4766 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
- carryover
,
4767 0, datagram_address
[channel
].sa
, &len
);
4771 if (proc_buffered_char
[channel
] < 0)
4773 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
- carryover
);
4774 #ifdef ADAPTIVE_READ_BUFFERING
4775 if (!NILP (p
->adaptive_read_buffering
))
4777 int delay
= XINT (p
->read_output_delay
);
4780 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
4783 process_output_delay_count
++;
4784 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
4787 else if (delay
> 0 && (nbytes
== readmax
- carryover
))
4789 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
4791 process_output_delay_count
--;
4793 XSETINT (p
->read_output_delay
, delay
);
4796 p
->read_output_skip
= Qt
;
4797 process_output_skip
= 1;
4804 chars
[carryover
] = proc_buffered_char
[channel
];
4805 proc_buffered_char
[channel
] = -1;
4806 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1 - carryover
);
4810 nbytes
= nbytes
+ 1;
4812 #endif /* not VMS */
4814 XSETINT (p
->decoding_carryover
, 0);
4816 /* At this point, NBYTES holds number of bytes just received
4817 (including the one in proc_buffered_char[channel]). */
4820 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
4822 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4825 /* Now set NBYTES how many bytes we must decode. */
4826 nbytes
+= carryover
;
4828 /* Read and dispose of the process output. */
4829 outstream
= p
->filter
;
4830 if (!NILP (outstream
))
4832 /* We inhibit quit here instead of just catching it so that
4833 hitting ^G when a filter happens to be running won't screw
4835 int count
= SPECPDL_INDEX ();
4836 Lisp_Object odeactivate
;
4837 Lisp_Object obuffer
, okeymap
;
4839 int outer_running_asynch_code
= running_asynch_code
;
4840 int waiting
= waiting_for_user_input_p
;
4842 /* No need to gcpro these, because all we do with them later
4843 is test them for EQness, and none of them should be a string. */
4844 odeactivate
= Vdeactivate_mark
;
4845 XSETBUFFER (obuffer
, current_buffer
);
4846 okeymap
= current_buffer
->keymap
;
4848 specbind (Qinhibit_quit
, Qt
);
4849 specbind (Qlast_nonmenu_event
, Qt
);
4851 /* In case we get recursively called,
4852 and we already saved the match data nonrecursively,
4853 save the same match data in safely recursive fashion. */
4854 if (outer_running_asynch_code
)
4857 /* Don't clobber the CURRENT match data, either! */
4858 tem
= Fmatch_data (Qnil
, Qnil
);
4859 restore_match_data ();
4860 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
4861 Fset_match_data (tem
);
4864 /* For speed, if a search happens within this code,
4865 save the match data in a special nonrecursive fashion. */
4866 running_asynch_code
= 1;
4868 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
4870 Vlast_coding_system_used
= coding
->symbol
;
4871 /* A new coding system might be found. */
4872 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
4874 p
->decode_coding_system
= coding
->symbol
;
4876 /* Don't call setup_coding_system for
4877 proc_decode_coding_system[channel] here. It is done in
4878 detect_coding called via decode_coding above. */
4880 /* If a coding system for encoding is not yet decided, we set
4881 it as the same as coding-system for decoding.
4883 But, before doing that we must check if
4884 proc_encode_coding_system[p->outfd] surely points to a
4885 valid memory because p->outfd will be changed once EOF is
4886 sent to the process. */
4887 if (NILP (p
->encode_coding_system
)
4888 && proc_encode_coding_system
[XINT (p
->outfd
)])
4890 p
->encode_coding_system
= coding
->symbol
;
4891 setup_coding_system (coding
->symbol
,
4892 proc_encode_coding_system
[XINT (p
->outfd
)]);
4896 carryover
= nbytes
- coding
->consumed
;
4897 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
4899 XSETINT (p
->decoding_carryover
, carryover
);
4900 /* Adjust the multibyteness of TEXT to that of the filter. */
4901 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
4902 text
= (STRING_MULTIBYTE (text
)
4903 ? Fstring_as_unibyte (text
)
4904 : Fstring_to_multibyte (text
));
4905 if (SBYTES (text
) > 0)
4906 internal_condition_case_1 (read_process_output_call
,
4908 Fcons (proc
, Fcons (text
, Qnil
))),
4909 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
4910 read_process_output_error_handler
);
4912 /* If we saved the match data nonrecursively, restore it now. */
4913 restore_match_data ();
4914 running_asynch_code
= outer_running_asynch_code
;
4916 /* Handling the process output should not deactivate the mark. */
4917 Vdeactivate_mark
= odeactivate
;
4919 /* Restore waiting_for_user_input_p as it was
4920 when we were called, in case the filter clobbered it. */
4921 waiting_for_user_input_p
= waiting
;
4923 #if 0 /* Call record_asynch_buffer_change unconditionally,
4924 because we might have changed minor modes or other things
4925 that affect key bindings. */
4926 if (! EQ (Fcurrent_buffer (), obuffer
)
4927 || ! EQ (current_buffer
->keymap
, okeymap
))
4929 /* But do it only if the caller is actually going to read events.
4930 Otherwise there's no need to make him wake up, and it could
4931 cause trouble (for example it would make Fsit_for return). */
4932 if (waiting_for_user_input_p
== -1)
4933 record_asynch_buffer_change ();
4936 start_vms_process_read (vs
);
4938 unbind_to (count
, Qnil
);
4942 /* If no filter, write into buffer if it isn't dead. */
4943 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
4945 Lisp_Object old_read_only
;
4946 int old_begv
, old_zv
;
4947 int old_begv_byte
, old_zv_byte
;
4948 Lisp_Object odeactivate
;
4949 int before
, before_byte
;
4954 odeactivate
= Vdeactivate_mark
;
4956 Fset_buffer (p
->buffer
);
4958 opoint_byte
= PT_BYTE
;
4959 old_read_only
= current_buffer
->read_only
;
4962 old_begv_byte
= BEGV_BYTE
;
4963 old_zv_byte
= ZV_BYTE
;
4965 current_buffer
->read_only
= Qnil
;
4967 /* Insert new output into buffer
4968 at the current end-of-output marker,
4969 thus preserving logical ordering of input and output. */
4970 if (XMARKER (p
->mark
)->buffer
)
4971 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
4972 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
4975 SET_PT_BOTH (ZV
, ZV_BYTE
);
4977 before_byte
= PT_BYTE
;
4979 /* If the output marker is outside of the visible region, save
4980 the restriction and widen. */
4981 if (! (BEGV
<= PT
&& PT
<= ZV
))
4984 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
4986 Vlast_coding_system_used
= coding
->symbol
;
4987 /* A new coding system might be found. See the comment in the
4988 similar code in the previous `if' block. */
4989 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
4991 p
->decode_coding_system
= coding
->symbol
;
4992 if (NILP (p
->encode_coding_system
)
4993 && proc_encode_coding_system
[XINT (p
->outfd
)])
4995 p
->encode_coding_system
= coding
->symbol
;
4996 setup_coding_system (coding
->symbol
,
4997 proc_encode_coding_system
[XINT (p
->outfd
)]);
5000 carryover
= nbytes
- coding
->consumed
;
5001 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5003 XSETINT (p
->decoding_carryover
, carryover
);
5004 /* Adjust the multibyteness of TEXT to that of the buffer. */
5005 if (NILP (current_buffer
->enable_multibyte_characters
)
5006 != ! STRING_MULTIBYTE (text
))
5007 text
= (STRING_MULTIBYTE (text
)
5008 ? Fstring_as_unibyte (text
)
5009 : Fstring_to_multibyte (text
));
5010 /* Insert before markers in case we are inserting where
5011 the buffer's mark is, and the user's next command is Meta-y. */
5012 insert_from_string_before_markers (text
, 0, 0,
5013 SCHARS (text
), SBYTES (text
), 0);
5015 /* Make sure the process marker's position is valid when the
5016 process buffer is changed in the signal_after_change above.
5017 W3 is known to do that. */
5018 if (BUFFERP (p
->buffer
)
5019 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5020 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5022 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5024 update_mode_lines
++;
5026 /* Make sure opoint and the old restrictions
5027 float ahead of any new text just as point would. */
5028 if (opoint
>= before
)
5030 opoint
+= PT
- before
;
5031 opoint_byte
+= PT_BYTE
- before_byte
;
5033 if (old_begv
> before
)
5035 old_begv
+= PT
- before
;
5036 old_begv_byte
+= PT_BYTE
- before_byte
;
5038 if (old_zv
>= before
)
5040 old_zv
+= PT
- before
;
5041 old_zv_byte
+= PT_BYTE
- before_byte
;
5044 /* If the restriction isn't what it should be, set it. */
5045 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5046 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5048 /* Handling the process output should not deactivate the mark. */
5049 Vdeactivate_mark
= odeactivate
;
5051 current_buffer
->read_only
= old_read_only
;
5052 SET_PT_BOTH (opoint
, opoint_byte
);
5053 set_buffer_internal (old
);
5056 start_vms_process_read (vs
);
5061 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5063 doc
: /* Returns non-nil if emacs is waiting for input from the user.
5064 This is intended for use by asynchronous process output filters and sentinels. */)
5067 return (waiting_for_user_input_p
? Qt
: Qnil
);
5070 /* Sending data to subprocess */
5072 jmp_buf send_process_frame
;
5073 Lisp_Object process_sent_to
;
5076 send_process_trap ()
5082 longjmp (send_process_frame
, 1);
5085 /* Send some data to process PROC.
5086 BUF is the beginning of the data; LEN is the number of characters.
5087 OBJECT is the Lisp object that the data comes from. If OBJECT is
5088 nil or t, it means that the data comes from C string.
5090 If OBJECT is not nil, the data is encoded by PROC's coding-system
5091 for encoding before it is sent.
5093 This function can evaluate Lisp code and can garbage collect. */
5096 send_process (proc
, buf
, len
, object
)
5097 volatile Lisp_Object proc
;
5098 unsigned char *volatile buf
;
5100 volatile Lisp_Object object
;
5102 /* Use volatile to protect variables from being clobbered by longjmp. */
5103 struct Lisp_Process
*p
= XPROCESS (proc
);
5105 struct coding_system
*coding
;
5106 struct gcpro gcpro1
;
5111 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5114 if (! NILP (p
->raw_status_low
))
5116 if (! EQ (p
->status
, Qrun
))
5117 error ("Process %s not running", SDATA (p
->name
));
5118 if (XINT (p
->outfd
) < 0)
5119 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5121 coding
= proc_encode_coding_system
[XINT (p
->outfd
)];
5122 Vlast_coding_system_used
= coding
->symbol
;
5124 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5125 || (BUFFERP (object
)
5126 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5129 if (!EQ (coding
->symbol
, p
->encode_coding_system
))
5130 /* The coding system for encoding was changed to raw-text
5131 because we sent a unibyte text previously. Now we are
5132 sending a multibyte text, thus we must encode it by the
5133 original coding system specified for the current process. */
5134 setup_coding_system (p
->encode_coding_system
, coding
);
5135 /* src_multibyte should be set to 1 _after_ a call to
5136 setup_coding_system, since it resets src_multibyte to
5138 coding
->src_multibyte
= 1;
5142 /* For sending a unibyte text, character code conversion should
5143 not take place but EOL conversion should. So, setup raw-text
5144 or one of the subsidiary if we have not yet done it. */
5145 if (coding
->type
!= coding_type_raw_text
)
5147 if (CODING_REQUIRE_FLUSHING (coding
))
5149 /* But, before changing the coding, we must flush out data. */
5150 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5151 send_process (proc
, "", 0, Qt
);
5153 coding
->src_multibyte
= 0;
5154 setup_raw_text_coding_system (coding
);
5157 coding
->dst_multibyte
= 0;
5159 if (CODING_REQUIRE_ENCODING (coding
))
5161 int require
= encoding_buffer_size (coding
, len
);
5162 int from_byte
= -1, from
= -1, to
= -1;
5164 if (BUFFERP (object
))
5166 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5167 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
5168 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
5170 else if (STRINGP (object
))
5172 from_byte
= buf
- SDATA (object
);
5173 from
= string_byte_to_char (object
, from_byte
);
5174 to
= string_byte_to_char (object
, from_byte
+ len
);
5177 if (coding
->composing
!= COMPOSITION_DISABLED
)
5180 coding_save_composition (coding
, from
, to
, object
);
5182 coding
->composing
= COMPOSITION_DISABLED
;
5185 if (SBYTES (p
->encoding_buf
) < require
)
5186 p
->encoding_buf
= make_uninit_string (require
);
5189 buf
= (BUFFERP (object
)
5190 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
5191 : SDATA (object
) + from_byte
);
5193 object
= p
->encoding_buf
;
5194 encode_coding (coding
, (char *) buf
, SDATA (object
),
5195 len
, SBYTES (object
));
5196 len
= coding
->produced
;
5197 buf
= SDATA (object
);
5201 vs
= get_vms_process_pointer (p
->pid
);
5203 error ("Could not find this process: %x", p
->pid
);
5204 else if (write_to_vms_process (vs
, buf
, len
))
5208 if (pty_max_bytes
== 0)
5210 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5211 pty_max_bytes
= fpathconf (XFASTINT (p
->outfd
), _PC_MAX_CANON
);
5212 if (pty_max_bytes
< 0)
5213 pty_max_bytes
= 250;
5215 pty_max_bytes
= 250;
5217 /* Deduct one, to leave space for the eof. */
5221 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5222 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5223 when returning with longjmp despite being declared volatile. */
5224 if (!setjmp (send_process_frame
))
5226 process_sent_to
= proc
;
5230 SIGTYPE (*old_sigpipe
)();
5232 /* Decide how much data we can send in one batch.
5233 Long lines need to be split into multiple batches. */
5234 if (!NILP (p
->pty_flag
))
5236 /* Starting this at zero is always correct when not the first
5237 iteration because the previous iteration ended by sending C-d.
5238 It may not be correct for the first iteration
5239 if a partial line was sent in a separate send_process call.
5240 If that proves worth handling, we need to save linepos
5241 in the process object. */
5243 unsigned char *ptr
= (unsigned char *) buf
;
5244 unsigned char *end
= (unsigned char *) buf
+ len
;
5246 /* Scan through this text for a line that is too long. */
5247 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5255 /* If we found one, break the line there
5256 and put in a C-d to force the buffer through. */
5260 /* Send this batch, using one or more write calls. */
5263 int outfd
= XINT (p
->outfd
);
5264 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5265 #ifdef DATAGRAM_SOCKETS
5266 if (DATAGRAM_CHAN_P (outfd
))
5268 rv
= sendto (outfd
, (char *) buf
, this,
5269 0, datagram_address
[outfd
].sa
,
5270 datagram_address
[outfd
].len
);
5271 if (rv
< 0 && errno
== EMSGSIZE
)
5272 report_file_error ("sending datagram", Fcons (proc
, Qnil
));
5277 rv
= emacs_write (outfd
, (char *) buf
, this);
5278 #ifdef ADAPTIVE_READ_BUFFERING
5279 if (XINT (p
->read_output_delay
) > 0
5280 && EQ (p
->adaptive_read_buffering
, Qt
))
5282 XSETFASTINT (p
->read_output_delay
, 0);
5283 process_output_delay_count
--;
5284 p
->read_output_skip
= Qnil
;
5288 signal (SIGPIPE
, old_sigpipe
);
5294 || errno
== EWOULDBLOCK
5300 /* Buffer is full. Wait, accepting input;
5301 that may allow the program
5302 to finish doing output and read more. */
5307 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5308 /* A gross hack to work around a bug in FreeBSD.
5309 In the following sequence, read(2) returns
5313 write(2) 954 bytes, get EAGAIN
5314 read(2) 1024 bytes in process_read_output
5315 read(2) 11 bytes in process_read_output
5317 That is, read(2) returns more bytes than have
5318 ever been written successfully. The 1033 bytes
5319 read are the 1022 bytes written successfully
5320 after processing (for example with CRs added if
5321 the terminal is set up that way which it is
5322 here). The same bytes will be seen again in a
5323 later read(2), without the CRs. */
5325 if (errno
== EAGAIN
)
5328 ioctl (XINT (p
->outfd
), TIOCFLUSH
, &flags
);
5330 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5332 /* Running filters might relocate buffers or strings.
5333 Arrange to relocate BUF. */
5334 if (BUFFERP (object
))
5335 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5336 else if (STRINGP (object
))
5337 offset
= buf
- SDATA (object
);
5339 XSETFASTINT (zero
, 0);
5340 #ifdef EMACS_HAS_USECS
5341 wait_reading_process_input (0, 20000, zero
, 0);
5343 wait_reading_process_input (1, 0, zero
, 0);
5346 if (BUFFERP (object
))
5347 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5348 else if (STRINGP (object
))
5349 buf
= offset
+ SDATA (object
);
5354 /* This is a real error. */
5355 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5362 /* If we sent just part of the string, put in an EOF
5363 to force it through, before we send the rest. */
5365 Fprocess_send_eof (proc
);
5368 #endif /* not VMS */
5372 proc
= process_sent_to
;
5373 p
= XPROCESS (proc
);
5375 p
->raw_status_low
= Qnil
;
5376 p
->raw_status_high
= Qnil
;
5377 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5378 XSETINT (p
->tick
, ++process_tick
);
5379 deactivate_process (proc
);
5381 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5383 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5390 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5392 doc
: /* Send current contents of region as input to PROCESS.
5393 PROCESS may be a process, a buffer, the name of a process or buffer, or
5394 nil, indicating the current buffer's process.
5395 Called from program, takes three arguments, PROCESS, START and END.
5396 If the region is more than 500 characters long,
5397 it is sent in several bunches. This may happen even for shorter regions.
5398 Output from processes can arrive in between bunches. */)
5399 (process
, start
, end
)
5400 Lisp_Object process
, start
, end
;
5405 proc
= get_process (process
);
5406 validate_region (&start
, &end
);
5408 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5409 move_gap (XINT (start
));
5411 start1
= CHAR_TO_BYTE (XINT (start
));
5412 end1
= CHAR_TO_BYTE (XINT (end
));
5413 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5414 Fcurrent_buffer ());
5419 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5421 doc
: /* Send PROCESS the contents of STRING as input.
5422 PROCESS may be a process, a buffer, the name of a process or buffer, or
5423 nil, indicating the current buffer's process.
5424 If STRING is more than 500 characters long,
5425 it is sent in several bunches. This may happen even for shorter strings.
5426 Output from processes can arrive in between bunches. */)
5428 Lisp_Object process
, string
;
5431 CHECK_STRING (string
);
5432 proc
= get_process (process
);
5433 send_process (proc
, SDATA (string
),
5434 SBYTES (string
), string
);
5438 /* Return the foreground process group for the tty/pty that
5439 the process P uses. */
5441 emacs_get_tty_pgrp (p
)
5442 struct Lisp_Process
*p
;
5447 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5450 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5451 master side. Try the slave side. */
5452 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5456 ioctl (fd
, TIOCGPGRP
, &gid
);
5460 #endif /* defined (TIOCGPGRP ) */
5465 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5466 Sprocess_running_child_p
, 0, 1, 0,
5467 doc
: /* Return t if PROCESS has given the terminal to a child.
5468 If the operating system does not make it possible to find out,
5469 return t unconditionally. */)
5471 Lisp_Object process
;
5473 /* Initialize in case ioctl doesn't exist or gives an error,
5474 in a way that will cause returning t. */
5477 struct Lisp_Process
*p
;
5479 proc
= get_process (process
);
5480 p
= XPROCESS (proc
);
5482 if (!EQ (p
->childp
, Qt
))
5483 error ("Process %s is not a subprocess",
5485 if (XINT (p
->infd
) < 0)
5486 error ("Process %s is not active",
5489 gid
= emacs_get_tty_pgrp (p
);
5491 if (gid
== XFASTINT (p
->pid
))
5496 /* send a signal number SIGNO to PROCESS.
5497 If CURRENT_GROUP is t, that means send to the process group
5498 that currently owns the terminal being used to communicate with PROCESS.
5499 This is used for various commands in shell mode.
5500 If CURRENT_GROUP is lambda, that means send to the process group
5501 that currently owns the terminal, but only if it is NOT the shell itself.
5503 If NOMSG is zero, insert signal-announcements into process's buffers
5506 If we can, we try to signal PROCESS by sending control characters
5507 down the pty. This allows us to signal inferiors who have changed
5508 their uid, for which killpg would return an EPERM error. */
5511 process_send_signal (process
, signo
, current_group
, nomsg
)
5512 Lisp_Object process
;
5514 Lisp_Object current_group
;
5518 register struct Lisp_Process
*p
;
5522 proc
= get_process (process
);
5523 p
= XPROCESS (proc
);
5525 if (!EQ (p
->childp
, Qt
))
5526 error ("Process %s is not a subprocess",
5528 if (XINT (p
->infd
) < 0)
5529 error ("Process %s is not active",
5532 if (NILP (p
->pty_flag
))
5533 current_group
= Qnil
;
5535 /* If we are using pgrps, get a pgrp number and make it negative. */
5536 if (NILP (current_group
))
5537 /* Send the signal to the shell's process group. */
5538 gid
= XFASTINT (p
->pid
);
5541 #ifdef SIGNALS_VIA_CHARACTERS
5542 /* If possible, send signals to the entire pgrp
5543 by sending an input character to it. */
5545 /* TERMIOS is the latest and bestest, and seems most likely to
5546 work. If the system has it, use it. */
5553 tcgetattr (XINT (p
->infd
), &t
);
5554 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5558 tcgetattr (XINT (p
->infd
), &t
);
5559 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5563 tcgetattr (XINT (p
->infd
), &t
);
5564 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5565 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5567 send_process (proc
, &t
.c_cc
[VSUSP
], 1, Qnil
);
5572 #else /* ! HAVE_TERMIOS */
5574 /* On Berkeley descendants, the following IOCTL's retrieve the
5575 current control characters. */
5576 #if defined (TIOCGLTC) && defined (TIOCGETC)
5584 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5585 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5588 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5589 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5593 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5594 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5596 #endif /* ! defined (SIGTSTP) */
5599 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5601 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5608 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5609 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5612 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5613 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5617 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5618 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5620 #endif /* ! defined (SIGTSTP) */
5622 #else /* ! defined (TCGETA) */
5623 Your configuration files are messed up
.
5624 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5625 you'd better be using one of the alternatives above! */
5626 #endif /* ! defined (TCGETA) */
5627 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5628 #endif /* ! defined HAVE_TERMIOS */
5630 /* The code above always returns from the function. */
5631 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5634 /* Get the current pgrp using the tty itself, if we have that.
5635 Otherwise, use the pty to get the pgrp.
5636 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5637 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5638 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5639 His patch indicates that if TIOCGPGRP returns an error, then
5640 we should just assume that p->pid is also the process group id. */
5642 gid
= emacs_get_tty_pgrp (p
);
5645 /* If we can't get the information, assume
5646 the shell owns the tty. */
5647 gid
= XFASTINT (p
->pid
);
5649 /* It is not clear whether anything really can set GID to -1.
5650 Perhaps on some system one of those ioctls can or could do so.
5651 Or perhaps this is vestigial. */
5654 #else /* ! defined (TIOCGPGRP ) */
5655 /* Can't select pgrps on this system, so we know that
5656 the child itself heads the pgrp. */
5657 gid
= XFASTINT (p
->pid
);
5658 #endif /* ! defined (TIOCGPGRP ) */
5660 /* If current_group is lambda, and the shell owns the terminal,
5661 don't send any signal. */
5662 if (EQ (current_group
, Qlambda
) && gid
== XFASTINT (p
->pid
))
5670 p
->raw_status_low
= Qnil
;
5671 p
->raw_status_high
= Qnil
;
5673 XSETINT (p
->tick
, ++process_tick
);
5677 #endif /* ! defined (SIGCONT) */
5680 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5685 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5690 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
5693 flush_pending_output (XINT (p
->infd
));
5697 /* If we don't have process groups, send the signal to the immediate
5698 subprocess. That isn't really right, but it's better than any
5699 obvious alternative. */
5702 kill (XFASTINT (p
->pid
), signo
);
5706 /* gid may be a pid, or minus a pgrp's number */
5708 if (!NILP (current_group
))
5710 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
5711 EMACS_KILLPG (gid
, signo
);
5715 gid
= - XFASTINT (p
->pid
);
5718 #else /* ! defined (TIOCSIGSEND) */
5719 EMACS_KILLPG (gid
, signo
);
5720 #endif /* ! defined (TIOCSIGSEND) */
5723 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5724 doc
: /* Interrupt process PROCESS.
5725 PROCESS may be a process, a buffer, or the name of a process or buffer.
5726 nil or no arg means current buffer's process.
5727 Second arg CURRENT-GROUP non-nil means send signal to
5728 the current process-group of the process's controlling terminal
5729 rather than to the process's own process group.
5730 If the process is a shell, this means interrupt current subjob
5731 rather than the shell.
5733 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5734 don't send the signal. */)
5735 (process
, current_group
)
5736 Lisp_Object process
, current_group
;
5738 process_send_signal (process
, SIGINT
, current_group
, 0);
5742 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5743 doc
: /* Kill process PROCESS. May be process or name of one.
5744 See function `interrupt-process' for more details on usage. */)
5745 (process
, current_group
)
5746 Lisp_Object process
, current_group
;
5748 process_send_signal (process
, SIGKILL
, current_group
, 0);
5752 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5753 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5754 See function `interrupt-process' for more details on usage. */)
5755 (process
, current_group
)
5756 Lisp_Object process
, current_group
;
5758 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5762 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5763 doc
: /* Stop process PROCESS. May be process or name of one.
5764 See function `interrupt-process' for more details on usage.
5765 If PROCESS is a network process, inhibit handling of incoming traffic. */)
5766 (process
, current_group
)
5767 Lisp_Object process
, current_group
;
5770 if (PROCESSP (process
) && NETCONN_P (process
))
5772 struct Lisp_Process
*p
;
5774 p
= XPROCESS (process
);
5775 if (NILP (p
->command
)
5776 && XINT (p
->infd
) >= 0)
5778 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5779 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5786 error ("no SIGTSTP support");
5788 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5793 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5794 doc
: /* Continue process PROCESS. May be process or name of one.
5795 See function `interrupt-process' for more details on usage.
5796 If PROCESS is a network process, resume handling of incoming traffic. */)
5797 (process
, current_group
)
5798 Lisp_Object process
, current_group
;
5801 if (PROCESSP (process
) && NETCONN_P (process
))
5803 struct Lisp_Process
*p
;
5805 p
= XPROCESS (process
);
5806 if (EQ (p
->command
, Qt
)
5807 && XINT (p
->infd
) >= 0
5808 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
5810 FD_SET (XINT (p
->infd
), &input_wait_mask
);
5811 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
5818 process_send_signal (process
, SIGCONT
, current_group
, 0);
5820 error ("no SIGCONT support");
5825 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
5826 2, 2, "sProcess (name or number): \nnSignal code: ",
5827 doc
: /* Send PROCESS the signal with code SIGCODE.
5828 PROCESS may also be an integer specifying the process id of the
5829 process to signal; in this case, the process need not be a child of
5831 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
5833 Lisp_Object process
, sigcode
;
5837 if (INTEGERP (process
))
5843 if (STRINGP (process
))
5846 if (tem
= Fget_process (process
), NILP (tem
))
5848 pid
= Fstring_to_number (process
, make_number (10));
5849 if (XINT (pid
) != 0)
5855 process
= get_process (process
);
5860 CHECK_PROCESS (process
);
5861 pid
= XPROCESS (process
)->pid
;
5862 if (!INTEGERP (pid
) || XINT (pid
) <= 0)
5863 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
5867 #define handle_signal(NAME, VALUE) \
5868 else if (!strcmp (name, NAME)) \
5869 XSETINT (sigcode, VALUE)
5871 if (INTEGERP (sigcode
))
5875 unsigned char *name
;
5877 CHECK_SYMBOL (sigcode
);
5878 name
= SDATA (SYMBOL_NAME (sigcode
));
5883 handle_signal ("SIGHUP", SIGHUP
);
5886 handle_signal ("SIGINT", SIGINT
);
5889 handle_signal ("SIGQUIT", SIGQUIT
);
5892 handle_signal ("SIGILL", SIGILL
);
5895 handle_signal ("SIGABRT", SIGABRT
);
5898 handle_signal ("SIGEMT", SIGEMT
);
5901 handle_signal ("SIGKILL", SIGKILL
);
5904 handle_signal ("SIGFPE", SIGFPE
);
5907 handle_signal ("SIGBUS", SIGBUS
);
5910 handle_signal ("SIGSEGV", SIGSEGV
);
5913 handle_signal ("SIGSYS", SIGSYS
);
5916 handle_signal ("SIGPIPE", SIGPIPE
);
5919 handle_signal ("SIGALRM", SIGALRM
);
5922 handle_signal ("SIGTERM", SIGTERM
);
5925 handle_signal ("SIGURG", SIGURG
);
5928 handle_signal ("SIGSTOP", SIGSTOP
);
5931 handle_signal ("SIGTSTP", SIGTSTP
);
5934 handle_signal ("SIGCONT", SIGCONT
);
5937 handle_signal ("SIGCHLD", SIGCHLD
);
5940 handle_signal ("SIGTTIN", SIGTTIN
);
5943 handle_signal ("SIGTTOU", SIGTTOU
);
5946 handle_signal ("SIGIO", SIGIO
);
5949 handle_signal ("SIGXCPU", SIGXCPU
);
5952 handle_signal ("SIGXFSZ", SIGXFSZ
);
5955 handle_signal ("SIGVTALRM", SIGVTALRM
);
5958 handle_signal ("SIGPROF", SIGPROF
);
5961 handle_signal ("SIGWINCH", SIGWINCH
);
5964 handle_signal ("SIGINFO", SIGINFO
);
5967 handle_signal ("SIGUSR1", SIGUSR1
);
5970 handle_signal ("SIGUSR2", SIGUSR2
);
5973 error ("Undefined signal name %s", name
);
5976 #undef handle_signal
5978 return make_number (kill (XINT (pid
), XINT (sigcode
)));
5981 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
5982 doc
: /* Make PROCESS see end-of-file in its input.
5983 EOF comes after any text already sent to it.
5984 PROCESS may be a process, a buffer, the name of a process or buffer, or
5985 nil, indicating the current buffer's process.
5986 If PROCESS is a network connection, or is a process communicating
5987 through a pipe (as opposed to a pty), then you cannot send any more
5988 text to PROCESS after you call this function. */)
5990 Lisp_Object process
;
5993 struct coding_system
*coding
;
5995 if (DATAGRAM_CONN_P (process
))
5998 proc
= get_process (process
);
5999 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
6001 /* Make sure the process is really alive. */
6002 if (! NILP (XPROCESS (proc
)->raw_status_low
))
6003 update_status (XPROCESS (proc
));
6004 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6005 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6007 if (CODING_REQUIRE_FLUSHING (coding
))
6009 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6010 send_process (proc
, "", 0, Qnil
);
6014 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6016 if (!NILP (XPROCESS (proc
)->pty_flag
))
6017 send_process (proc
, "\004", 1, Qnil
);
6020 int old_outfd
, new_outfd
;
6022 #ifdef HAVE_SHUTDOWN
6023 /* If this is a network connection, or socketpair is used
6024 for communication with the subprocess, call shutdown to cause EOF.
6025 (In some old system, shutdown to socketpair doesn't work.
6026 Then we just can't win.) */
6027 if (NILP (XPROCESS (proc
)->pid
)
6028 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
6029 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
6030 /* In case of socketpair, outfd == infd, so don't close it. */
6031 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
6032 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6033 #else /* not HAVE_SHUTDOWN */
6034 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6035 #endif /* not HAVE_SHUTDOWN */
6036 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6037 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
6039 if (!proc_encode_coding_system
[new_outfd
])
6040 proc_encode_coding_system
[new_outfd
]
6041 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6042 bcopy (proc_encode_coding_system
[old_outfd
],
6043 proc_encode_coding_system
[new_outfd
],
6044 sizeof (struct coding_system
));
6045 bzero (proc_encode_coding_system
[old_outfd
],
6046 sizeof (struct coding_system
));
6048 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
6054 /* Kill all processes associated with `buffer'.
6055 If `buffer' is nil, kill all processes */
6058 kill_buffer_processes (buffer
)
6061 Lisp_Object tail
, proc
;
6063 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6065 proc
= XCDR (XCAR (tail
));
6066 if (GC_PROCESSP (proc
)
6067 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6069 if (NETCONN_P (proc
))
6070 Fdelete_process (proc
);
6071 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
6072 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6077 /* On receipt of a signal that a child status has changed, loop asking
6078 about children with changed statuses until the system says there
6081 All we do is change the status; we do not run sentinels or print
6082 notifications. That is saved for the next time keyboard input is
6083 done, in order to avoid timing errors.
6085 ** WARNING: this can be called during garbage collection.
6086 Therefore, it must not be fooled by the presence of mark bits in
6089 ** USG WARNING: Although it is not obvious from the documentation
6090 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6091 signal() before executing at least one wait(), otherwise the
6092 handler will be called again, resulting in an infinite loop. The
6093 relevant portion of the documentation reads "SIGCLD signals will be
6094 queued and the signal-catching function will be continually
6095 reentered until the queue is empty". Invoking signal() causes the
6096 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6099 ** Malloc WARNING: This should never call malloc either directly or
6100 indirectly; if it does, that is a bug */
6103 sigchld_handler (signo
)
6106 int old_errno
= errno
;
6108 register struct Lisp_Process
*p
;
6109 extern EMACS_TIME
*input_available_clear_time
;
6113 sigheld
|= sigbit (SIGCHLD
);
6125 #endif /* no WUNTRACED */
6126 /* Keep trying to get a status until we get a definitive result. */
6130 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6132 while (pid
< 0 && errno
== EINTR
);
6136 /* PID == 0 means no processes found, PID == -1 means a real
6137 failure. We have done all our job, so return. */
6139 /* USG systems forget handlers when they are used;
6140 must reestablish each time */
6141 #if defined (USG) && !defined (POSIX_SIGNALS)
6142 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6145 sigheld
&= ~sigbit (SIGCHLD
);
6153 #endif /* no WNOHANG */
6155 /* Find the process that signaled us, and record its status. */
6158 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6160 proc
= XCDR (XCAR (tail
));
6161 p
= XPROCESS (proc
);
6162 if (GC_EQ (p
->childp
, Qt
) && XINT (p
->pid
) == pid
)
6167 /* Look for an asynchronous process whose pid hasn't been filled
6170 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6172 proc
= XCDR (XCAR (tail
));
6173 p
= XPROCESS (proc
);
6174 if (GC_INTEGERP (p
->pid
) && XINT (p
->pid
) == -1)
6179 /* Change the status of the process that was found. */
6182 union { int i
; WAITTYPE wt
; } u
;
6183 int clear_desc_flag
= 0;
6185 XSETINT (p
->tick
, ++process_tick
);
6187 XSETINT (p
->raw_status_low
, u
.i
& 0xffff);
6188 XSETINT (p
->raw_status_high
, u
.i
>> 16);
6190 /* If process has terminated, stop waiting for its output. */
6191 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6192 && XINT (p
->infd
) >= 0)
6193 clear_desc_flag
= 1;
6195 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6196 if (clear_desc_flag
)
6198 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6199 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6202 /* Tell wait_reading_process_input that it needs to wake up and
6204 if (input_available_clear_time
)
6205 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6208 /* There was no asynchronous process found for that id. Check
6209 if we have a synchronous process. */
6212 synch_process_alive
= 0;
6214 /* Report the status of the synchronous process. */
6216 synch_process_retcode
= WRETCODE (w
);
6217 else if (WIFSIGNALED (w
))
6218 synch_process_termsig
= WTERMSIG (w
);
6220 /* Tell wait_reading_process_input that it needs to wake up and
6222 if (input_available_clear_time
)
6223 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6226 /* On some systems, we must return right away.
6227 If any more processes want to signal us, we will
6229 Otherwise (on systems that have WNOHANG), loop around
6230 to use up all the processes that have something to tell us. */
6231 #if (defined WINDOWSNT \
6232 || (defined USG && !defined GNU_LINUX \
6233 && !(defined HPUX && defined WNOHANG)))
6234 #if defined (USG) && ! defined (POSIX_SIGNALS)
6235 signal (signo
, sigchld_handler
);
6239 #endif /* USG, but not HPUX with WNOHANG */
6245 exec_sentinel_unwind (data
)
6248 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6253 exec_sentinel_error_handler (error
)
6256 cmd_error_internal (error
, "error in process sentinel: ");
6258 update_echo_area ();
6259 Fsleep_for (make_number (2), Qnil
);
6264 exec_sentinel (proc
, reason
)
6265 Lisp_Object proc
, reason
;
6267 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6268 register struct Lisp_Process
*p
= XPROCESS (proc
);
6269 int count
= SPECPDL_INDEX ();
6270 int outer_running_asynch_code
= running_asynch_code
;
6271 int waiting
= waiting_for_user_input_p
;
6273 /* No need to gcpro these, because all we do with them later
6274 is test them for EQness, and none of them should be a string. */
6275 odeactivate
= Vdeactivate_mark
;
6276 XSETBUFFER (obuffer
, current_buffer
);
6277 okeymap
= current_buffer
->keymap
;
6279 sentinel
= p
->sentinel
;
6280 if (NILP (sentinel
))
6283 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6284 assure that it gets restored no matter how the sentinel exits. */
6286 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6287 /* Inhibit quit so that random quits don't screw up a running filter. */
6288 specbind (Qinhibit_quit
, Qt
);
6289 specbind (Qlast_nonmenu_event
, Qt
);
6291 /* In case we get recursively called,
6292 and we already saved the match data nonrecursively,
6293 save the same match data in safely recursive fashion. */
6294 if (outer_running_asynch_code
)
6297 tem
= Fmatch_data (Qnil
, Qnil
);
6298 restore_match_data ();
6299 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
6300 Fset_match_data (tem
);
6303 /* For speed, if a search happens within this code,
6304 save the match data in a special nonrecursive fashion. */
6305 running_asynch_code
= 1;
6307 internal_condition_case_1 (read_process_output_call
,
6309 Fcons (proc
, Fcons (reason
, Qnil
))),
6310 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6311 exec_sentinel_error_handler
);
6313 /* If we saved the match data nonrecursively, restore it now. */
6314 restore_match_data ();
6315 running_asynch_code
= outer_running_asynch_code
;
6317 Vdeactivate_mark
= odeactivate
;
6319 /* Restore waiting_for_user_input_p as it was
6320 when we were called, in case the filter clobbered it. */
6321 waiting_for_user_input_p
= waiting
;
6324 if (! EQ (Fcurrent_buffer (), obuffer
)
6325 || ! EQ (current_buffer
->keymap
, okeymap
))
6327 /* But do it only if the caller is actually going to read events.
6328 Otherwise there's no need to make him wake up, and it could
6329 cause trouble (for example it would make Fsit_for return). */
6330 if (waiting_for_user_input_p
== -1)
6331 record_asynch_buffer_change ();
6333 unbind_to (count
, Qnil
);
6336 /* Report all recent events of a change in process status
6337 (either run the sentinel or output a message).
6338 This is usually done while Emacs is waiting for keyboard input
6339 but can be done at other times. */
6344 register Lisp_Object proc
, buffer
;
6345 Lisp_Object tail
, msg
;
6346 struct gcpro gcpro1
, gcpro2
;
6350 /* We need to gcpro tail; if read_process_output calls a filter
6351 which deletes a process and removes the cons to which tail points
6352 from Vprocess_alist, and then causes a GC, tail is an unprotected
6356 /* Set this now, so that if new processes are created by sentinels
6357 that we run, we get called again to handle their status changes. */
6358 update_tick
= process_tick
;
6360 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6363 register struct Lisp_Process
*p
;
6365 proc
= Fcdr (Fcar (tail
));
6366 p
= XPROCESS (proc
);
6368 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6370 XSETINT (p
->update_tick
, XINT (p
->tick
));
6372 /* If process is still active, read any output that remains. */
6373 while (! EQ (p
->filter
, Qt
)
6374 && ! EQ (p
->status
, Qconnect
)
6375 && ! EQ (p
->status
, Qlisten
)
6376 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6377 && XINT (p
->infd
) >= 0
6378 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6382 /* Get the text to use for the message. */
6383 if (!NILP (p
->raw_status_low
))
6385 msg
= status_message (p
->status
);
6387 /* If process is terminated, deactivate it or delete it. */
6389 if (CONSP (p
->status
))
6390 symbol
= XCAR (p
->status
);
6392 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6393 || EQ (symbol
, Qclosed
))
6395 if (delete_exited_processes
)
6396 remove_process (proc
);
6398 deactivate_process (proc
);
6401 /* The actions above may have further incremented p->tick.
6402 So set p->update_tick again
6403 so that an error in the sentinel will not cause
6404 this code to be run again. */
6405 XSETINT (p
->update_tick
, XINT (p
->tick
));
6406 /* Now output the message suitably. */
6407 if (!NILP (p
->sentinel
))
6408 exec_sentinel (proc
, msg
);
6409 /* Don't bother with a message in the buffer
6410 when a process becomes runnable. */
6411 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6413 Lisp_Object ro
, tem
;
6414 struct buffer
*old
= current_buffer
;
6415 int opoint
, opoint_byte
;
6416 int before
, before_byte
;
6418 ro
= XBUFFER (buffer
)->read_only
;
6420 /* Avoid error if buffer is deleted
6421 (probably that's why the process is dead, too) */
6422 if (NILP (XBUFFER (buffer
)->name
))
6424 Fset_buffer (buffer
);
6427 opoint_byte
= PT_BYTE
;
6428 /* Insert new output into buffer
6429 at the current end-of-output marker,
6430 thus preserving logical ordering of input and output. */
6431 if (XMARKER (p
->mark
)->buffer
)
6432 Fgoto_char (p
->mark
);
6434 SET_PT_BOTH (ZV
, ZV_BYTE
);
6437 before_byte
= PT_BYTE
;
6439 tem
= current_buffer
->read_only
;
6440 current_buffer
->read_only
= Qnil
;
6441 insert_string ("\nProcess ");
6442 Finsert (1, &p
->name
);
6443 insert_string (" ");
6445 current_buffer
->read_only
= tem
;
6446 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6448 if (opoint
>= before
)
6449 SET_PT_BOTH (opoint
+ (PT
- before
),
6450 opoint_byte
+ (PT_BYTE
- before_byte
));
6452 SET_PT_BOTH (opoint
, opoint_byte
);
6454 set_buffer_internal (old
);
6459 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6460 redisplay_preserve_echo_area (13);
6466 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6467 Sset_process_coding_system
, 1, 3, 0,
6468 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6469 DECODING will be used to decode subprocess output and ENCODING to
6470 encode subprocess input. */)
6471 (proc
, decoding
, encoding
)
6472 register Lisp_Object proc
, decoding
, encoding
;
6474 register struct Lisp_Process
*p
;
6476 CHECK_PROCESS (proc
);
6477 p
= XPROCESS (proc
);
6478 if (XINT (p
->infd
) < 0)
6479 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6480 if (XINT (p
->outfd
) < 0)
6481 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6482 Fcheck_coding_system (decoding
);
6483 Fcheck_coding_system (encoding
);
6485 p
->decode_coding_system
= decoding
;
6486 p
->encode_coding_system
= encoding
;
6487 setup_process_coding_systems (proc
);
6492 DEFUN ("process-coding-system",
6493 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6494 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6496 register Lisp_Object proc
;
6498 CHECK_PROCESS (proc
);
6499 return Fcons (XPROCESS (proc
)->decode_coding_system
,
6500 XPROCESS (proc
)->encode_coding_system
);
6503 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6504 Sset_process_filter_multibyte
, 2, 2, 0,
6505 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6506 If FLAG is non-nil, the filter is given multibyte strings.
6507 If FLAG is nil, the filter is given unibyte strings. In this case,
6508 all character code conversion except for end-of-line conversion is
6511 Lisp_Object proc
, flag
;
6513 register struct Lisp_Process
*p
;
6515 CHECK_PROCESS (proc
);
6516 p
= XPROCESS (proc
);
6517 p
->filter_multibyte
= flag
;
6518 setup_process_coding_systems (proc
);
6523 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6524 Sprocess_filter_multibyte_p
, 1, 1, 0,
6525 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6529 register struct Lisp_Process
*p
;
6531 CHECK_PROCESS (proc
);
6532 p
= XPROCESS (proc
);
6534 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6539 /* The first time this is called, assume keyboard input comes from DESC
6540 instead of from where we used to expect it.
6541 Subsequent calls mean assume input keyboard can come from DESC
6542 in addition to other places. */
6544 static int add_keyboard_wait_descriptor_called_flag
;
6547 add_keyboard_wait_descriptor (desc
)
6550 if (! add_keyboard_wait_descriptor_called_flag
)
6551 FD_CLR (0, &input_wait_mask
);
6552 add_keyboard_wait_descriptor_called_flag
= 1;
6553 FD_SET (desc
, &input_wait_mask
);
6554 FD_SET (desc
, &non_process_wait_mask
);
6555 if (desc
> max_keyboard_desc
)
6556 max_keyboard_desc
= desc
;
6559 /* From now on, do not expect DESC to give keyboard input. */
6562 delete_keyboard_wait_descriptor (desc
)
6566 int lim
= max_keyboard_desc
;
6568 FD_CLR (desc
, &input_wait_mask
);
6569 FD_CLR (desc
, &non_process_wait_mask
);
6571 if (desc
== max_keyboard_desc
)
6572 for (fd
= 0; fd
< lim
; fd
++)
6573 if (FD_ISSET (fd
, &input_wait_mask
)
6574 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6575 max_keyboard_desc
= fd
;
6578 /* Return nonzero if *MASK has a bit set
6579 that corresponds to one of the keyboard input descriptors. */
6582 keyboard_bit_set (mask
)
6587 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6588 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6589 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6602 if (! noninteractive
|| initialized
)
6604 signal (SIGCHLD
, sigchld_handler
);
6607 FD_ZERO (&input_wait_mask
);
6608 FD_ZERO (&non_keyboard_wait_mask
);
6609 FD_ZERO (&non_process_wait_mask
);
6610 max_process_desc
= 0;
6612 #ifdef ADAPTIVE_READ_BUFFERING
6613 process_output_delay_count
= 0;
6614 process_output_skip
= 0;
6617 FD_SET (0, &input_wait_mask
);
6619 Vprocess_alist
= Qnil
;
6620 for (i
= 0; i
< MAXDESC
; i
++)
6622 chan_process
[i
] = Qnil
;
6623 proc_buffered_char
[i
] = -1;
6625 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6626 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6627 #ifdef DATAGRAM_SOCKETS
6628 bzero (datagram_address
, sizeof datagram_address
);
6633 Lisp_Object subfeatures
= Qnil
;
6634 struct socket_options
*sopt
;
6636 #define ADD_SUBFEATURE(key, val) \
6637 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6639 #ifdef NON_BLOCKING_CONNECT
6640 ADD_SUBFEATURE (QCnowait
, Qt
);
6642 #ifdef DATAGRAM_SOCKETS
6643 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6645 #ifdef HAVE_LOCAL_SOCKETS
6646 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6648 #ifdef HAVE_GETSOCKNAME
6649 ADD_SUBFEATURE (QCservice
, Qt
);
6651 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6652 ADD_SUBFEATURE (QCserver
, Qt
);
6655 for (sopt
= socket_options
; sopt
->name
; sopt
++)
6656 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
6658 Fprovide (intern ("make-network-process"), subfeatures
);
6660 #endif /* HAVE_SOCKETS */
6666 Qprocessp
= intern ("processp");
6667 staticpro (&Qprocessp
);
6668 Qrun
= intern ("run");
6670 Qstop
= intern ("stop");
6672 Qsignal
= intern ("signal");
6673 staticpro (&Qsignal
);
6675 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6678 Qexit = intern ("exit");
6679 staticpro (&Qexit); */
6681 Qopen
= intern ("open");
6683 Qclosed
= intern ("closed");
6684 staticpro (&Qclosed
);
6685 Qconnect
= intern ("connect");
6686 staticpro (&Qconnect
);
6687 Qfailed
= intern ("failed");
6688 staticpro (&Qfailed
);
6689 Qlisten
= intern ("listen");
6690 staticpro (&Qlisten
);
6691 Qlocal
= intern ("local");
6692 staticpro (&Qlocal
);
6693 Qdatagram
= intern ("datagram");
6694 staticpro (&Qdatagram
);
6696 QCname
= intern (":name");
6697 staticpro (&QCname
);
6698 QCbuffer
= intern (":buffer");
6699 staticpro (&QCbuffer
);
6700 QChost
= intern (":host");
6701 staticpro (&QChost
);
6702 QCservice
= intern (":service");
6703 staticpro (&QCservice
);
6704 QCtype
= intern (":type");
6705 staticpro (&QCtype
);
6706 QClocal
= intern (":local");
6707 staticpro (&QClocal
);
6708 QCremote
= intern (":remote");
6709 staticpro (&QCremote
);
6710 QCcoding
= intern (":coding");
6711 staticpro (&QCcoding
);
6712 QCserver
= intern (":server");
6713 staticpro (&QCserver
);
6714 QCnowait
= intern (":nowait");
6715 staticpro (&QCnowait
);
6716 QCsentinel
= intern (":sentinel");
6717 staticpro (&QCsentinel
);
6718 QClog
= intern (":log");
6720 QCnoquery
= intern (":noquery");
6721 staticpro (&QCnoquery
);
6722 QCstop
= intern (":stop");
6723 staticpro (&QCstop
);
6724 QCoptions
= intern (":options");
6725 staticpro (&QCoptions
);
6726 QCplist
= intern (":plist");
6727 staticpro (&QCplist
);
6728 QCfilter_multibyte
= intern (":filter-multibyte");
6729 staticpro (&QCfilter_multibyte
);
6731 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
6732 staticpro (&Qlast_nonmenu_event
);
6734 staticpro (&Vprocess_alist
);
6736 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
6737 doc
: /* *Non-nil means delete processes immediately when they exit.
6738 nil means don't delete them until `list-processes' is run. */);
6740 delete_exited_processes
= 1;
6742 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
6743 doc
: /* Control type of device used to communicate with subprocesses.
6744 Values are nil to use a pipe, or t or `pty' to use a pty.
6745 The value has no effect if the system has no ptys or if all ptys are busy:
6746 then a pipe is used in any case.
6747 The value takes effect when `start-process' is called. */);
6748 Vprocess_connection_type
= Qt
;
6750 #ifdef ADAPTIVE_READ_BUFFERING
6751 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
6752 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
6753 On some systems, when emacs reads the output from a subprocess, the output data
6754 is read in very small blocks, potentially resulting in very poor performance.
6755 This behaviour can be remedied to some extent by setting this variable to a
6756 non-nil value, as it will automatically delay reading from such processes, to
6757 allowing them to produce more output before emacs tries to read it.
6758 If the value is t, the delay is reset after each write to the process; any other
6759 non-nil value means that the delay is not reset on write.
6760 The variable takes effect when `start-process' is called. */);
6761 Vprocess_adaptive_read_buffering
= Qt
;
6764 defsubr (&Sprocessp
);
6765 defsubr (&Sget_process
);
6766 defsubr (&Sget_buffer_process
);
6767 defsubr (&Sdelete_process
);
6768 defsubr (&Sprocess_status
);
6769 defsubr (&Sprocess_exit_status
);
6770 defsubr (&Sprocess_id
);
6771 defsubr (&Sprocess_name
);
6772 defsubr (&Sprocess_tty_name
);
6773 defsubr (&Sprocess_command
);
6774 defsubr (&Sset_process_buffer
);
6775 defsubr (&Sprocess_buffer
);
6776 defsubr (&Sprocess_mark
);
6777 defsubr (&Sset_process_filter
);
6778 defsubr (&Sprocess_filter
);
6779 defsubr (&Sset_process_sentinel
);
6780 defsubr (&Sprocess_sentinel
);
6781 defsubr (&Sset_process_window_size
);
6782 defsubr (&Sset_process_inherit_coding_system_flag
);
6783 defsubr (&Sprocess_inherit_coding_system_flag
);
6784 defsubr (&Sset_process_query_on_exit_flag
);
6785 defsubr (&Sprocess_query_on_exit_flag
);
6786 defsubr (&Sprocess_contact
);
6787 defsubr (&Sprocess_plist
);
6788 defsubr (&Sset_process_plist
);
6789 defsubr (&Slist_processes
);
6790 defsubr (&Sprocess_list
);
6791 defsubr (&Sstart_process
);
6793 defsubr (&Sset_network_process_option
);
6794 defsubr (&Smake_network_process
);
6795 defsubr (&Sformat_network_address
);
6796 #endif /* HAVE_SOCKETS */
6797 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
6799 defsubr (&Snetwork_interface_list
);
6801 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
6802 defsubr (&Snetwork_interface_info
);
6804 #endif /* HAVE_SOCKETS ... */
6805 #ifdef DATAGRAM_SOCKETS
6806 defsubr (&Sprocess_datagram_address
);
6807 defsubr (&Sset_process_datagram_address
);
6809 defsubr (&Saccept_process_output
);
6810 defsubr (&Sprocess_send_region
);
6811 defsubr (&Sprocess_send_string
);
6812 defsubr (&Sinterrupt_process
);
6813 defsubr (&Skill_process
);
6814 defsubr (&Squit_process
);
6815 defsubr (&Sstop_process
);
6816 defsubr (&Scontinue_process
);
6817 defsubr (&Sprocess_running_child_p
);
6818 defsubr (&Sprocess_send_eof
);
6819 defsubr (&Ssignal_process
);
6820 defsubr (&Swaiting_for_user_input_p
);
6821 /* defsubr (&Sprocess_connection); */
6822 defsubr (&Sset_process_coding_system
);
6823 defsubr (&Sprocess_coding_system
);
6824 defsubr (&Sset_process_filter_multibyte
);
6825 defsubr (&Sprocess_filter_multibyte_p
);
6829 #else /* not subprocesses */
6831 #include <sys/types.h>
6835 #include "systime.h"
6836 #include "charset.h"
6838 #include "termopts.h"
6839 #include "sysselect.h"
6841 extern int frame_garbaged
;
6843 extern EMACS_TIME
timer_check ();
6844 extern int timers_run
;
6848 /* As described above, except assuming that there are no subprocesses:
6850 Wait for timeout to elapse and/or keyboard input to be available.
6853 timeout in seconds, or
6854 zero for no limit, or
6855 -1 means gobble data immediately available but don't wait for any.
6857 read_kbd is a Lisp_Object:
6858 0 to ignore keyboard input, or
6859 1 to return when input is available, or
6860 -1 means caller will actually read the input, so don't throw to
6862 a cons cell, meaning wait until its car is non-nil
6863 (and gobble terminal input into the buffer if any arrives), or
6864 We know that read_kbd will never be a Lisp_Process, since
6865 `subprocesses' isn't defined.
6867 do_display != 0 means redisplay should be done to show subprocess
6868 output that arrives.
6870 Return true iff we received input from any process. */
6873 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
6874 int time_limit
, microsecs
;
6875 Lisp_Object read_kbd
;
6879 EMACS_TIME end_time
, timeout
;
6880 SELECT_TYPE waitchannels
;
6882 /* Either nil or a cons cell, the car of which is of interest and
6883 may be changed outside of this routine. */
6884 Lisp_Object wait_for_cell
;
6886 wait_for_cell
= Qnil
;
6888 /* If waiting for non-nil in a cell, record where. */
6889 if (CONSP (read_kbd
))
6891 wait_for_cell
= read_kbd
;
6892 XSETFASTINT (read_kbd
, 0);
6895 /* What does time_limit really mean? */
6896 if (time_limit
|| microsecs
)
6898 EMACS_GET_TIME (end_time
);
6899 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
6900 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
6903 /* Turn off periodic alarms (in case they are in use)
6904 and then turn off any other atimers,
6905 because the select emulator uses alarms. */
6907 turn_on_atimers (0);
6911 int timeout_reduced_for_timers
= 0;
6913 /* If calling from keyboard input, do not quit
6914 since we want to return C-g as an input character.
6915 Otherwise, do pending quit if requested. */
6916 if (XINT (read_kbd
) >= 0)
6919 /* Exit now if the cell we're waiting for became non-nil. */
6920 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6923 /* Compute time from now till when time limit is up */
6924 /* Exit if already run out */
6925 if (time_limit
== -1)
6927 /* -1 specified for timeout means
6928 gobble output available now
6929 but don't wait at all. */
6931 EMACS_SET_SECS_USECS (timeout
, 0, 0);
6933 else if (time_limit
|| microsecs
)
6935 EMACS_GET_TIME (timeout
);
6936 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
6937 if (EMACS_TIME_NEG_P (timeout
))
6942 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
6945 /* If our caller will not immediately handle keyboard events,
6946 run timer events directly.
6947 (Callers that will immediately read keyboard events
6948 call timer_delay on their own.) */
6949 if (NILP (wait_for_cell
))
6951 EMACS_TIME timer_delay
;
6955 int old_timers_run
= timers_run
;
6956 timer_delay
= timer_check (1);
6957 if (timers_run
!= old_timers_run
&& do_display
)
6958 /* We must retry, since a timer may have requeued itself
6959 and that could alter the time delay. */
6960 redisplay_preserve_echo_area (14);
6964 while (!detect_input_pending ());
6966 /* If there is unread keyboard input, also return. */
6967 if (XINT (read_kbd
) != 0
6968 && requeued_events_pending_p ())
6971 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
6973 EMACS_TIME difference
;
6974 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
6975 if (EMACS_TIME_NEG_P (difference
))
6977 timeout
= timer_delay
;
6978 timeout_reduced_for_timers
= 1;
6983 /* Cause C-g and alarm signals to take immediate action,
6984 and cause input available signals to zero out timeout. */
6985 if (XINT (read_kbd
) < 0)
6986 set_waiting_for_input (&timeout
);
6988 /* Wait till there is something to do. */
6990 if (! XINT (read_kbd
) && NILP (wait_for_cell
))
6991 FD_ZERO (&waitchannels
);
6993 FD_SET (0, &waitchannels
);
6995 /* If a frame has been newly mapped and needs updating,
6996 reprocess its display stuff. */
6997 if (frame_garbaged
&& do_display
)
6999 clear_waiting_for_input ();
7000 redisplay_preserve_echo_area (15);
7001 if (XINT (read_kbd
) < 0)
7002 set_waiting_for_input (&timeout
);
7005 if (XINT (read_kbd
) && detect_input_pending ())
7008 FD_ZERO (&waitchannels
);
7011 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7016 /* Make C-g and alarm signals set flags again */
7017 clear_waiting_for_input ();
7019 /* If we woke up due to SIGWINCH, actually change size now. */
7020 do_pending_window_change (0);
7022 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7023 /* We waited the full specified time, so return now. */
7028 /* If the system call was interrupted, then go around the
7030 if (xerrno
== EINTR
)
7031 FD_ZERO (&waitchannels
);
7033 error ("select error: %s", emacs_strerror (xerrno
));
7036 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7037 /* System sometimes fails to deliver SIGIO. */
7038 kill (getpid (), SIGIO
);
7041 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
7042 kill (getpid (), SIGIO
);
7045 /* Check for keyboard input */
7047 if ((XINT (read_kbd
) != 0)
7048 && detect_input_pending_run_timers (do_display
))
7050 swallow_events (do_display
);
7051 if (detect_input_pending_run_timers (do_display
))
7055 /* If there is unread keyboard input, also return. */
7056 if (XINT (read_kbd
) != 0
7057 && requeued_events_pending_p ())
7060 /* If wait_for_cell. check for keyboard input
7061 but don't run any timers.
7062 ??? (It seems wrong to me to check for keyboard
7063 input at all when wait_for_cell, but the code
7064 has been this way since July 1994.
7065 Try changing this after version 19.31.) */
7066 if (! NILP (wait_for_cell
)
7067 && detect_input_pending ())
7069 swallow_events (do_display
);
7070 if (detect_input_pending ())
7074 /* Exit now if the cell we're waiting for became non-nil. */
7075 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7085 /* Don't confuse make-docfile by having two doc strings for this function.
7086 make-docfile does not pay attention to #if, for good reason! */
7087 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7090 register Lisp_Object name
;
7095 /* Don't confuse make-docfile by having two doc strings for this function.
7096 make-docfile does not pay attention to #if, for good reason! */
7097 DEFUN ("process-inherit-coding-system-flag",
7098 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7102 register Lisp_Object process
;
7104 /* Ignore the argument and return the value of
7105 inherit-process-coding-system. */
7106 return inherit_process_coding_system
? Qt
: Qnil
;
7109 /* Kill all processes associated with `buffer'.
7110 If `buffer' is nil, kill all processes.
7111 Since we have no subprocesses, this does nothing. */
7114 kill_buffer_processes (buffer
)
7127 QCtype
= intern (":type");
7128 staticpro (&QCtype
);
7130 defsubr (&Sget_buffer_process
);
7131 defsubr (&Sprocess_inherit_coding_system_flag
);
7135 #endif /* not subprocesses */
7137 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7138 (do not change this comment) */