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>
126 #include "character.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
);
647 Lisp_Object coding_system
;
649 if (inch
< 0 || outch
< 0)
652 if (!proc_decode_coding_system
[inch
])
653 proc_decode_coding_system
[inch
]
654 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
655 coding_system
= p
->decode_coding_system
;
656 if (! NILP (p
->filter
))
658 if (NILP (p
->filter_multibyte
))
659 coding_system
= raw_text_coding_system (coding_system
);
661 else if (BUFFERP (p
->buffer
))
663 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
664 coding_system
= raw_text_coding_system (coding_system
);
666 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
668 if (!proc_encode_coding_system
[outch
])
669 proc_encode_coding_system
[outch
]
670 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
671 setup_coding_system (p
->encode_coding_system
,
672 proc_encode_coding_system
[outch
]);
675 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
676 doc
: /* Return t if OBJECT is a process. */)
680 return PROCESSP (object
) ? Qt
: Qnil
;
683 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
684 doc
: /* Return the process named NAME, or nil if there is none. */)
686 register Lisp_Object name
;
691 return Fcdr (Fassoc (name
, Vprocess_alist
));
694 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
695 doc
: /* Return the (or a) process associated with BUFFER.
696 BUFFER may be a buffer or the name of one. */)
698 register Lisp_Object buffer
;
700 register Lisp_Object buf
, tail
, proc
;
702 if (NILP (buffer
)) return Qnil
;
703 buf
= Fget_buffer (buffer
);
704 if (NILP (buf
)) return Qnil
;
706 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
708 proc
= Fcdr (Fcar (tail
));
709 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
715 /* This is how commands for the user decode process arguments. It
716 accepts a process, a process name, a buffer, a buffer name, or nil.
717 Buffers denote the first process in the buffer, and nil denotes the
722 register Lisp_Object name
;
724 register Lisp_Object proc
, obj
;
727 obj
= Fget_process (name
);
729 obj
= Fget_buffer (name
);
731 error ("Process %s does not exist", SDATA (name
));
733 else if (NILP (name
))
734 obj
= Fcurrent_buffer ();
738 /* Now obj should be either a buffer object or a process object.
742 proc
= Fget_buffer_process (obj
);
744 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
754 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
755 doc
: /* Delete PROCESS: kill it and forget about it immediately.
756 PROCESS may be a process, a buffer, the name of a process or buffer, or
757 nil, indicating the current buffer's process. */)
759 register Lisp_Object process
;
761 process
= get_process (process
);
762 XPROCESS (process
)->raw_status_low
= Qnil
;
763 XPROCESS (process
)->raw_status_high
= Qnil
;
764 if (NETCONN_P (process
))
766 XPROCESS (process
)->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
767 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
769 else if (XINT (XPROCESS (process
)->infd
) >= 0)
771 Fkill_process (process
, Qnil
);
772 /* Do this now, since remove_process will make sigchld_handler do nothing. */
773 XPROCESS (process
)->status
774 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
775 XSETINT (XPROCESS (process
)->tick
, ++process_tick
);
778 remove_process (process
);
782 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
783 doc
: /* Return the status of PROCESS.
784 The returned value is one of the following symbols:
785 run -- for a process that is running.
786 stop -- for a process stopped but continuable.
787 exit -- for a process that has exited.
788 signal -- for a process that has got a fatal signal.
789 open -- for a network stream connection that is open.
790 listen -- for a network stream server that is listening.
791 closed -- for a network stream connection that is closed.
792 connect -- when waiting for a non-blocking connection to complete.
793 failed -- when a non-blocking connection has failed.
794 nil -- if arg is a process name and no such process exists.
795 PROCESS may be a process, a buffer, the name of a process, or
796 nil, indicating the current buffer's process. */)
798 register Lisp_Object process
;
800 register struct Lisp_Process
*p
;
801 register Lisp_Object status
;
803 if (STRINGP (process
))
804 process
= Fget_process (process
);
806 process
= get_process (process
);
811 p
= XPROCESS (process
);
812 if (!NILP (p
->raw_status_low
))
816 status
= XCAR (status
);
819 if (EQ (status
, Qexit
))
821 else if (EQ (p
->command
, Qt
))
823 else if (EQ (status
, Qrun
))
829 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
831 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
832 If PROCESS has not yet exited or died, return 0. */)
834 register Lisp_Object process
;
836 CHECK_PROCESS (process
);
837 if (!NILP (XPROCESS (process
)->raw_status_low
))
838 update_status (XPROCESS (process
));
839 if (CONSP (XPROCESS (process
)->status
))
840 return XCAR (XCDR (XPROCESS (process
)->status
));
841 return make_number (0);
844 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
845 doc
: /* Return the process id of PROCESS.
846 This is the pid of the Unix process which PROCESS uses or talks to.
847 For a network connection, this value is nil. */)
849 register Lisp_Object process
;
851 CHECK_PROCESS (process
);
852 return XPROCESS (process
)->pid
;
855 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
856 doc
: /* Return the name of PROCESS, as a string.
857 This is the name of the program invoked in PROCESS,
858 possibly modified to make it unique among process names. */)
860 register Lisp_Object process
;
862 CHECK_PROCESS (process
);
863 return XPROCESS (process
)->name
;
866 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
867 doc
: /* Return the command that was executed to start PROCESS.
868 This is a list of strings, the first string being the program executed
869 and the rest of the strings being the arguments given to it.
870 For a non-child channel, this is nil. */)
872 register Lisp_Object process
;
874 CHECK_PROCESS (process
);
875 return XPROCESS (process
)->command
;
878 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
879 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
880 This is the terminal that the process itself reads and writes on,
881 not the name of the pty that Emacs uses to talk with that terminal. */)
883 register Lisp_Object process
;
885 CHECK_PROCESS (process
);
886 return XPROCESS (process
)->tty_name
;
889 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
891 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
893 register Lisp_Object process
, buffer
;
895 struct Lisp_Process
*p
;
897 CHECK_PROCESS (process
);
899 CHECK_BUFFER (buffer
);
900 p
= XPROCESS (process
);
903 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
904 setup_process_coding_systems (process
);
908 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
910 doc
: /* Return the buffer PROCESS is associated with.
911 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
913 register Lisp_Object process
;
915 CHECK_PROCESS (process
);
916 return XPROCESS (process
)->buffer
;
919 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
921 doc
: /* Return the marker for the end of the last output from PROCESS. */)
923 register Lisp_Object process
;
925 CHECK_PROCESS (process
);
926 return XPROCESS (process
)->mark
;
929 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
931 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
932 t means stop accepting output from the process.
934 When a process has a filter, its buffer is not used for output.
935 Instead, each time it does output, the entire string of output is
936 passed to the filter.
938 The filter gets two arguments: the process and the string of output.
939 The string argument is normally a multibyte string, except:
940 - if the process' input coding system is no-conversion or raw-text,
941 it is a unibyte string (the non-converted input), or else
942 - if `default-enable-multibyte-characters' is nil, it is a unibyte
943 string (the result of converting the decoded input multibyte
944 string to unibyte with `string-make-unibyte'). */)
946 register Lisp_Object process
, filter
;
948 struct Lisp_Process
*p
;
950 CHECK_PROCESS (process
);
951 p
= XPROCESS (process
);
953 /* Don't signal an error if the process' input file descriptor
954 is closed. This could make debugging Lisp more difficult,
955 for example when doing something like
957 (setq process (start-process ...))
959 (set-process-filter process ...) */
961 if (XINT (p
->infd
) >= 0)
963 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
965 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
966 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
968 else if (EQ (p
->filter
, Qt
)
969 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
971 FD_SET (XINT (p
->infd
), &input_wait_mask
);
972 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
978 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
979 setup_process_coding_systems (process
);
983 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
985 doc
: /* Returns the filter function of PROCESS; nil if none.
986 See `set-process-filter' for more info on filter functions. */)
988 register Lisp_Object process
;
990 CHECK_PROCESS (process
);
991 return XPROCESS (process
)->filter
;
994 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
996 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
997 The sentinel is called as a function when the process changes state.
998 It gets two arguments: the process, and a string describing the change. */)
1000 register Lisp_Object process
, sentinel
;
1002 struct Lisp_Process
*p
;
1004 CHECK_PROCESS (process
);
1005 p
= XPROCESS (process
);
1007 p
->sentinel
= sentinel
;
1009 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1013 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1015 doc
: /* Return the sentinel of PROCESS; nil if none.
1016 See `set-process-sentinel' for more info on sentinels. */)
1018 register Lisp_Object process
;
1020 CHECK_PROCESS (process
);
1021 return XPROCESS (process
)->sentinel
;
1024 DEFUN ("set-process-window-size", Fset_process_window_size
,
1025 Sset_process_window_size
, 3, 3, 0,
1026 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1027 (process
, height
, width
)
1028 register Lisp_Object process
, height
, width
;
1030 CHECK_PROCESS (process
);
1031 CHECK_NATNUM (height
);
1032 CHECK_NATNUM (width
);
1034 if (XINT (XPROCESS (process
)->infd
) < 0
1035 || set_window_size (XINT (XPROCESS (process
)->infd
),
1036 XINT (height
), XINT (width
)) <= 0)
1042 DEFUN ("set-process-inherit-coding-system-flag",
1043 Fset_process_inherit_coding_system_flag
,
1044 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1045 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1046 If the second argument FLAG is non-nil, then the variable
1047 `buffer-file-coding-system' of the buffer associated with PROCESS
1048 will be bound to the value of the coding system used to decode
1051 This is useful when the coding system specified for the process buffer
1052 leaves either the character code conversion or the end-of-line conversion
1053 unspecified, or if the coding system used to decode the process output
1054 is more appropriate for saving the process buffer.
1056 Binding the variable `inherit-process-coding-system' to non-nil before
1057 starting the process is an alternative way of setting the inherit flag
1058 for the process which will run. */)
1060 register Lisp_Object process
, flag
;
1062 CHECK_PROCESS (process
);
1063 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
1067 DEFUN ("process-inherit-coding-system-flag",
1068 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1070 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1071 If this flag is t, `buffer-file-coding-system' of the buffer
1072 associated with PROCESS will inherit the coding system used to decode
1073 the process output. */)
1075 register Lisp_Object process
;
1077 CHECK_PROCESS (process
);
1078 return XPROCESS (process
)->inherit_coding_system_flag
;
1081 DEFUN ("set-process-query-on-exit-flag",
1082 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1084 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1085 If the second argument FLAG is non-nil, emacs will query the user before
1086 exiting if PROCESS is running. */)
1088 register Lisp_Object process
, flag
;
1090 CHECK_PROCESS (process
);
1091 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
1095 DEFUN ("process-query-on-exit-flag",
1096 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1098 doc
: /* Return the current value of query on exit flag for PROCESS. */)
1100 register Lisp_Object process
;
1102 CHECK_PROCESS (process
);
1103 return Fnull (XPROCESS (process
)->kill_without_query
);
1106 #ifdef DATAGRAM_SOCKETS
1107 Lisp_Object
Fprocess_datagram_address ();
1110 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1112 doc
: /* Return the contact info of PROCESS; t for a real child.
1113 For a net connection, the value depends on the optional KEY arg.
1114 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1115 if KEY is t, the complete contact information for the connection is
1116 returned, else the specific value for the keyword KEY is returned.
1117 See `make-network-process' for a list of keywords. */)
1119 register Lisp_Object process
, key
;
1121 Lisp_Object contact
;
1123 CHECK_PROCESS (process
);
1124 contact
= XPROCESS (process
)->childp
;
1126 #ifdef DATAGRAM_SOCKETS
1127 if (DATAGRAM_CONN_P (process
)
1128 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1129 contact
= Fplist_put (contact
, QCremote
,
1130 Fprocess_datagram_address (process
));
1133 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1136 return Fcons (Fplist_get (contact
, QChost
),
1137 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1138 return Fplist_get (contact
, key
);
1141 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1143 doc
: /* Return the plist of PROCESS. */)
1145 register Lisp_Object process
;
1147 CHECK_PROCESS (process
);
1148 return XPROCESS (process
)->plist
;
1151 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1153 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1155 register Lisp_Object process
, plist
;
1157 CHECK_PROCESS (process
);
1160 XPROCESS (process
)->plist
= plist
;
1164 #if 0 /* Turned off because we don't currently record this info
1165 in the process. Perhaps add it. */
1166 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1167 doc
: /* Return the connection type of PROCESS.
1168 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1169 a socket connection. */)
1171 Lisp_Object process
;
1173 return XPROCESS (process
)->type
;
1178 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1180 doc
: /* Convert network ADDRESS from internal format to a string.
1181 If optional second argument OMIT-PORT is non-nil, don't include a port
1182 number in the string; in this case, interpret a 4 element vector as an
1183 IP address. Returns nil if format of ADDRESS is invalid. */)
1184 (address
, omit_port
)
1185 Lisp_Object address
, omit_port
;
1190 if (STRINGP (address
)) /* AF_LOCAL */
1193 if (VECTORP (address
)) /* AF_INET */
1195 register struct Lisp_Vector
*p
= XVECTOR (address
);
1196 Lisp_Object args
[6];
1199 if (!NILP (omit_port
) && (p
->size
== 4 || p
->size
== 5))
1201 args
[0] = build_string ("%d.%d.%d.%d");
1204 else if (p
->size
== 5)
1206 args
[0] = build_string ("%d.%d.%d.%d:%d");
1212 for (i
= 0; i
< nargs
; i
++)
1213 args
[i
+1] = p
->contents
[i
];
1214 return Fformat (nargs
+1, args
);
1217 if (CONSP (address
))
1219 Lisp_Object args
[2];
1220 args
[0] = build_string ("<Family %d>");
1221 args
[1] = Fcar (address
);
1222 return Fformat (2, args
);
1231 list_processes_1 (query_only
)
1232 Lisp_Object query_only
;
1234 register Lisp_Object tail
, tem
;
1235 Lisp_Object proc
, minspace
, tem1
;
1236 register struct Lisp_Process
*p
;
1238 int w_proc
, w_buffer
, w_tty
;
1239 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1241 w_proc
= 4; /* Proc */
1242 w_buffer
= 6; /* Buffer */
1243 w_tty
= 0; /* Omit if no ttys */
1245 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1249 proc
= Fcdr (Fcar (tail
));
1250 p
= XPROCESS (proc
);
1251 if (NILP (p
->childp
))
1253 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1255 if (STRINGP (p
->name
)
1256 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1258 if (!NILP (p
->buffer
))
1260 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1261 w_buffer
= 8; /* (Killed) */
1262 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1265 if (STRINGP (p
->tty_name
)
1266 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1270 XSETFASTINT (i_status
, w_proc
+ 1);
1271 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1274 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1275 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1278 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1281 XSETFASTINT (minspace
, 1);
1283 set_buffer_internal (XBUFFER (Vstandard_output
));
1284 Fbuffer_disable_undo (Vstandard_output
);
1286 current_buffer
->truncate_lines
= Qt
;
1288 write_string ("Proc", -1);
1289 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1290 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1293 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1295 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1296 write_string ("\n", -1);
1298 write_string ("----", -1);
1299 Findent_to (i_status
, minspace
); write_string ("------", -1);
1300 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1303 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1305 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1306 write_string ("\n", -1);
1308 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1312 proc
= Fcdr (Fcar (tail
));
1313 p
= XPROCESS (proc
);
1314 if (NILP (p
->childp
))
1316 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1319 Finsert (1, &p
->name
);
1320 Findent_to (i_status
, minspace
);
1322 if (!NILP (p
->raw_status_low
))
1325 if (CONSP (p
->status
))
1326 symbol
= XCAR (p
->status
);
1329 if (EQ (symbol
, Qsignal
))
1332 tem
= Fcar (Fcdr (p
->status
));
1334 if (XINT (tem
) < NSIG
)
1335 write_string (sys_errlist
[XINT (tem
)], -1);
1338 Fprinc (symbol
, Qnil
);
1340 else if (NETCONN1_P (p
))
1342 if (EQ (symbol
, Qexit
))
1343 write_string ("closed", -1);
1344 else if (EQ (p
->command
, Qt
))
1345 write_string ("stopped", -1);
1346 else if (EQ (symbol
, Qrun
))
1347 write_string ("open", -1);
1349 Fprinc (symbol
, Qnil
);
1352 Fprinc (symbol
, Qnil
);
1354 if (EQ (symbol
, Qexit
))
1357 tem
= Fcar (Fcdr (p
->status
));
1360 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1361 write_string (tembuf
, -1);
1365 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
1366 remove_process (proc
);
1368 Findent_to (i_buffer
, minspace
);
1369 if (NILP (p
->buffer
))
1370 insert_string ("(none)");
1371 else if (NILP (XBUFFER (p
->buffer
)->name
))
1372 insert_string ("(Killed)");
1374 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1378 Findent_to (i_tty
, minspace
);
1379 if (STRINGP (p
->tty_name
))
1380 Finsert (1, &p
->tty_name
);
1383 Findent_to (i_command
, minspace
);
1385 if (EQ (p
->status
, Qlisten
))
1387 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1388 if (INTEGERP (port
))
1389 port
= Fnumber_to_string (port
);
1391 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1392 sprintf (tembuf
, "(network %s server on %s)\n",
1393 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1394 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1395 insert_string (tembuf
);
1397 else if (NETCONN1_P (p
))
1399 /* For a local socket, there is no host name,
1400 so display service instead. */
1401 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1402 if (!STRINGP (host
))
1404 host
= Fplist_get (p
->childp
, QCservice
);
1405 if (INTEGERP (host
))
1406 host
= Fnumber_to_string (host
);
1409 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1410 sprintf (tembuf
, "(network %s connection to %s)\n",
1411 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1412 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1413 insert_string (tembuf
);
1425 insert_string (" ");
1427 insert_string ("\n");
1433 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1434 doc
: /* Display a list of all processes.
1435 If optional argument QUERY-ONLY is non-nil, only processes with
1436 the query-on-exit flag set will be listed.
1437 Any process listed as exited or signaled is actually eliminated
1438 after the listing is made. */)
1440 Lisp_Object query_only
;
1442 internal_with_output_to_temp_buffer ("*Process List*",
1443 list_processes_1
, query_only
);
1447 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1448 doc
: /* Return a list of all processes. */)
1451 return Fmapcar (Qcdr
, Vprocess_alist
);
1454 /* Starting asynchronous inferior processes. */
1456 static Lisp_Object
start_process_unwind ();
1458 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1459 doc
: /* Start a program in a subprocess. Return the process object for it.
1460 NAME is name for process. It is modified if necessary to make it unique.
1461 BUFFER is the buffer or (buffer-name) to associate with the process.
1462 Process output goes at end of that buffer, unless you specify
1463 an output stream or filter function to handle the output.
1464 BUFFER may be also nil, meaning that this process is not associated
1466 Third arg is program file name. It is searched for in PATH.
1467 Remaining arguments are strings to give program as arguments.
1469 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1472 register Lisp_Object
*args
;
1474 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1476 register unsigned char *new_argv
;
1479 register unsigned char **new_argv
;
1482 int count
= SPECPDL_INDEX ();
1486 buffer
= Fget_buffer_create (buffer
);
1488 /* Make sure that the child will be able to chdir to the current
1489 buffer's current directory, or its unhandled equivalent. We
1490 can't just have the child check for an error when it does the
1491 chdir, since it's in a vfork.
1493 We have to GCPRO around this because Fexpand_file_name and
1494 Funhandled_file_name_directory might call a file name handling
1495 function. The argument list is protected by the caller, so all
1496 we really have to worry about is buffer. */
1498 struct gcpro gcpro1
, gcpro2
;
1500 current_dir
= current_buffer
->directory
;
1502 GCPRO2 (buffer
, current_dir
);
1505 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1507 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1508 report_file_error ("Setting current directory",
1509 Fcons (current_buffer
->directory
, Qnil
));
1515 CHECK_STRING (name
);
1519 CHECK_STRING (program
);
1521 proc
= make_process (name
);
1522 /* If an error occurs and we can't start the process, we want to
1523 remove it from the process list. This means that each error
1524 check in create_process doesn't need to call remove_process
1525 itself; it's all taken care of here. */
1526 record_unwind_protect (start_process_unwind
, proc
);
1528 XPROCESS (proc
)->childp
= Qt
;
1529 XPROCESS (proc
)->plist
= Qnil
;
1530 XPROCESS (proc
)->command_channel_p
= Qnil
;
1531 XPROCESS (proc
)->buffer
= buffer
;
1532 XPROCESS (proc
)->sentinel
= Qnil
;
1533 XPROCESS (proc
)->filter
= Qnil
;
1534 XPROCESS (proc
)->filter_multibyte
1535 = buffer_defaults
.enable_multibyte_characters
;
1536 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1538 #ifdef ADAPTIVE_READ_BUFFERING
1539 XPROCESS (proc
)->adaptive_read_buffering
= Vprocess_adaptive_read_buffering
;
1542 /* Make the process marker point into the process buffer (if any). */
1544 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1545 BUF_ZV (XBUFFER (buffer
)),
1546 BUF_ZV_BYTE (XBUFFER (buffer
)));
1549 /* Decide coding systems for communicating with the process. Here
1550 we don't setup the structure coding_system nor pay attention to
1551 unibyte mode. They are done in create_process. */
1553 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1554 Lisp_Object coding_systems
= Qt
;
1555 Lisp_Object val
, *args2
;
1556 struct gcpro gcpro1
, gcpro2
;
1558 val
= Vcoding_system_for_read
;
1561 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1562 args2
[0] = Qstart_process
;
1563 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1564 GCPRO2 (proc
, current_dir
);
1565 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1567 if (CONSP (coding_systems
))
1568 val
= XCAR (coding_systems
);
1569 else if (CONSP (Vdefault_process_coding_system
))
1570 val
= XCAR (Vdefault_process_coding_system
);
1572 XPROCESS (proc
)->decode_coding_system
= val
;
1574 val
= Vcoding_system_for_write
;
1577 if (EQ (coding_systems
, Qt
))
1579 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1580 args2
[0] = Qstart_process
;
1581 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1582 GCPRO2 (proc
, current_dir
);
1583 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1586 if (CONSP (coding_systems
))
1587 val
= XCDR (coding_systems
);
1588 else if (CONSP (Vdefault_process_coding_system
))
1589 val
= XCDR (Vdefault_process_coding_system
);
1591 XPROCESS (proc
)->encode_coding_system
= val
;
1595 /* Make a one member argv with all args concatenated
1596 together separated by a blank. */
1597 len
= SBYTES (program
) + 2;
1598 for (i
= 3; i
< nargs
; i
++)
1602 len
+= SBYTES (tem
) + 1; /* count the blank */
1604 new_argv
= (unsigned char *) alloca (len
);
1605 strcpy (new_argv
, SDATA (program
));
1606 for (i
= 3; i
< nargs
; i
++)
1610 strcat (new_argv
, " ");
1611 strcat (new_argv
, SDATA (tem
));
1613 /* Need to add code here to check for program existence on VMS */
1616 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1618 /* If program file name is not absolute, search our path for it.
1619 Put the name we will really use in TEM. */
1620 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1621 && !(SCHARS (program
) > 1
1622 && IS_DEVICE_SEP (SREF (program
, 1))))
1624 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1627 GCPRO4 (name
, program
, buffer
, current_dir
);
1628 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1631 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1632 tem
= Fexpand_file_name (tem
, Qnil
);
1636 if (!NILP (Ffile_directory_p (program
)))
1637 error ("Specified program for new process is a directory");
1641 /* If program file name starts with /: for quoting a magic name,
1643 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1644 && SREF (tem
, 1) == ':')
1645 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1647 /* Encode the file name and put it in NEW_ARGV.
1648 That's where the child will use it to execute the program. */
1649 tem
= ENCODE_FILE (tem
);
1650 new_argv
[0] = SDATA (tem
);
1652 /* Here we encode arguments by the coding system used for sending
1653 data to the process. We don't support using different coding
1654 systems for encoding arguments and for encoding data sent to the
1657 for (i
= 3; i
< nargs
; i
++)
1661 if (STRING_MULTIBYTE (tem
))
1662 tem
= (code_convert_string_norecord
1663 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1664 new_argv
[i
- 2] = SDATA (tem
);
1666 new_argv
[i
- 2] = 0;
1667 #endif /* not VMS */
1669 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1670 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1671 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1672 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1674 XPROCESS (proc
)->inherit_coding_system_flag
1675 = (NILP (buffer
) || !inherit_process_coding_system
1678 create_process (proc
, (char **) new_argv
, current_dir
);
1680 return unbind_to (count
, proc
);
1683 /* This function is the unwind_protect form for Fstart_process. If
1684 PROC doesn't have its pid set, then we know someone has signaled
1685 an error and the process wasn't started successfully, so we should
1686 remove it from the process list. */
1688 start_process_unwind (proc
)
1691 if (!PROCESSP (proc
))
1694 /* Was PROC started successfully? */
1695 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1696 remove_process (proc
);
1702 create_process_1 (timer
)
1703 struct atimer
*timer
;
1705 /* Nothing to do. */
1709 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1712 /* Mimic blocking of signals on system V, which doesn't really have it. */
1714 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1715 int sigchld_deferred
;
1718 create_process_sigchld ()
1720 signal (SIGCHLD
, create_process_sigchld
);
1722 sigchld_deferred
= 1;
1728 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1730 create_process (process
, new_argv
, current_dir
)
1731 Lisp_Object process
;
1733 Lisp_Object current_dir
;
1735 int pid
, inchannel
, outchannel
;
1737 #ifdef POSIX_SIGNALS
1740 struct sigaction sigint_action
;
1741 struct sigaction sigquit_action
;
1743 struct sigaction sighup_action
;
1745 #else /* !POSIX_SIGNALS */
1748 SIGTYPE (*sigchld
)();
1751 #endif /* !POSIX_SIGNALS */
1752 /* Use volatile to protect variables from being clobbered by longjmp. */
1753 volatile int forkin
, forkout
;
1754 volatile int pty_flag
= 0;
1756 extern char **environ
;
1759 inchannel
= outchannel
= -1;
1762 if (!NILP (Vprocess_connection_type
))
1763 outchannel
= inchannel
= allocate_pty ();
1767 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1768 /* On most USG systems it does not work to open the pty's tty here,
1769 then close it and reopen it in the child. */
1771 /* Don't let this terminal become our controlling terminal
1772 (in case we don't have one). */
1773 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1775 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1778 report_file_error ("Opening pty", Qnil
);
1780 forkin
= forkout
= -1;
1781 #endif /* not USG, or USG_SUBTTY_WORKS */
1785 #endif /* HAVE_PTYS */
1788 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1789 report_file_error ("Opening socketpair", Qnil
);
1790 outchannel
= inchannel
= sv
[0];
1791 forkout
= forkin
= sv
[1];
1793 #else /* not SKTPAIR */
1798 report_file_error ("Creating pipe", Qnil
);
1804 emacs_close (inchannel
);
1805 emacs_close (forkout
);
1806 report_file_error ("Creating pipe", Qnil
);
1811 #endif /* not SKTPAIR */
1814 /* Replaced by close_process_descs */
1815 set_exclusive_use (inchannel
);
1816 set_exclusive_use (outchannel
);
1819 /* Stride people say it's a mystery why this is needed
1820 as well as the O_NDELAY, but that it fails without this. */
1821 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1824 ioctl (inchannel
, FIONBIO
, &one
);
1829 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1830 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1833 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1834 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1838 /* Record this as an active process, with its channels.
1839 As a result, child_setup will close Emacs's side of the pipes. */
1840 chan_process
[inchannel
] = process
;
1841 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1842 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1844 /* Previously we recorded the tty descriptor used in the subprocess.
1845 It was only used for getting the foreground tty process, so now
1846 we just reopen the device (see emacs_get_tty_pgrp) as this is
1847 more portable (see USG_SUBTTY_WORKS above). */
1849 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1850 XPROCESS (process
)->status
= Qrun
;
1851 setup_process_coding_systems (process
);
1853 /* Delay interrupts until we have a chance to store
1854 the new fork's pid in its process structure */
1855 #ifdef POSIX_SIGNALS
1856 sigemptyset (&blocked
);
1858 sigaddset (&blocked
, SIGCHLD
);
1860 #ifdef HAVE_WORKING_VFORK
1861 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1862 this sets the parent's signal handlers as well as the child's.
1863 So delay all interrupts whose handlers the child might munge,
1864 and record the current handlers so they can be restored later. */
1865 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1866 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1868 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1870 #endif /* HAVE_WORKING_VFORK */
1871 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1872 #else /* !POSIX_SIGNALS */
1876 #else /* not BSD4_1 */
1877 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1878 sigsetmask (sigmask (SIGCHLD
));
1879 #else /* ordinary USG */
1881 sigchld_deferred
= 0;
1882 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1884 #endif /* ordinary USG */
1885 #endif /* not BSD4_1 */
1886 #endif /* SIGCHLD */
1887 #endif /* !POSIX_SIGNALS */
1889 FD_SET (inchannel
, &input_wait_mask
);
1890 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1891 if (inchannel
> max_process_desc
)
1892 max_process_desc
= inchannel
;
1894 /* Until we store the proper pid, enable sigchld_handler
1895 to recognize an unknown pid as standing for this process.
1896 It is very important not to let this `marker' value stay
1897 in the table after this function has returned; if it does
1898 it might cause call-process to hang and subsequent asynchronous
1899 processes to get their return values scrambled. */
1900 XSETINT (XPROCESS (process
)->pid
, -1);
1905 /* child_setup must clobber environ on systems with true vfork.
1906 Protect it from permanent change. */
1907 char **save_environ
= environ
;
1909 current_dir
= ENCODE_FILE (current_dir
);
1914 #endif /* not WINDOWSNT */
1916 int xforkin
= forkin
;
1917 int xforkout
= forkout
;
1919 #if 0 /* This was probably a mistake--it duplicates code later on,
1920 but fails to handle all the cases. */
1921 /* Make sure SIGCHLD is not blocked in the child. */
1922 sigsetmask (SIGEMPTYMASK
);
1925 /* Make the pty be the controlling terminal of the process. */
1927 /* First, disconnect its current controlling terminal. */
1929 /* We tried doing setsid only if pty_flag, but it caused
1930 process_set_signal to fail on SGI when using a pipe. */
1932 /* Make the pty's terminal the controlling terminal. */
1936 /* We ignore the return value
1937 because faith@cs.unc.edu says that is necessary on Linux. */
1938 ioctl (xforkin
, TIOCSCTTY
, 0);
1941 #else /* not HAVE_SETSID */
1943 /* It's very important to call setpgrp here and no time
1944 afterwards. Otherwise, we lose our controlling tty which
1945 is set when we open the pty. */
1948 #endif /* not HAVE_SETSID */
1949 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1950 if (pty_flag
&& xforkin
>= 0)
1953 tcgetattr (xforkin
, &t
);
1955 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1956 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1959 #if defined (NTTYDISC) && defined (TIOCSETD)
1960 if (pty_flag
&& xforkin
>= 0)
1962 /* Use new line discipline. */
1963 int ldisc
= NTTYDISC
;
1964 ioctl (xforkin
, TIOCSETD
, &ldisc
);
1969 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1970 can do TIOCSPGRP only to the process's controlling tty. */
1973 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1974 I can't test it since I don't have 4.3. */
1975 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1976 ioctl (j
, TIOCNOTTY
, 0);
1979 /* In order to get a controlling terminal on some versions
1980 of BSD, it is necessary to put the process in pgrp 0
1981 before it opens the terminal. */
1989 #endif /* TIOCNOTTY */
1991 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
1992 /*** There is a suggestion that this ought to be a
1993 conditional on TIOCSPGRP,
1994 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1995 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1996 that system does seem to need this code, even though
1997 both HAVE_SETSID and TIOCSCTTY are defined. */
1998 /* Now close the pty (if we had it open) and reopen it.
1999 This makes the pty the controlling terminal of the subprocess. */
2002 #ifdef SET_CHILD_PTY_PGRP
2003 int pgrp
= getpid ();
2006 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2009 emacs_close (xforkin
);
2010 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2014 emacs_write (1, "Couldn't open the pty terminal ", 31);
2015 emacs_write (1, pty_name
, strlen (pty_name
));
2016 emacs_write (1, "\n", 1);
2020 #ifdef SET_CHILD_PTY_PGRP
2021 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
2022 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
2025 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
2027 #ifdef SETUP_SLAVE_PTY
2032 #endif /* SETUP_SLAVE_PTY */
2034 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2035 Now reenable it in the child, so it will die when we want it to. */
2037 signal (SIGHUP
, SIG_DFL
);
2039 #endif /* HAVE_PTYS */
2041 signal (SIGINT
, SIG_DFL
);
2042 signal (SIGQUIT
, SIG_DFL
);
2044 /* Stop blocking signals in the child. */
2045 #ifdef POSIX_SIGNALS
2046 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2047 #else /* !POSIX_SIGNALS */
2051 #else /* not BSD4_1 */
2052 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2053 sigsetmask (SIGEMPTYMASK
);
2054 #else /* ordinary USG */
2056 signal (SIGCHLD
, sigchld
);
2058 #endif /* ordinary USG */
2059 #endif /* not BSD4_1 */
2060 #endif /* SIGCHLD */
2061 #endif /* !POSIX_SIGNALS */
2064 child_setup_tty (xforkout
);
2066 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2067 new_argv
, 1, current_dir
);
2068 #else /* not WINDOWSNT */
2069 child_setup (xforkin
, xforkout
, xforkout
,
2070 new_argv
, 1, current_dir
);
2071 #endif /* not WINDOWSNT */
2073 environ
= save_environ
;
2078 /* This runs in the Emacs process. */
2082 emacs_close (forkin
);
2083 if (forkin
!= forkout
&& forkout
>= 0)
2084 emacs_close (forkout
);
2088 /* vfork succeeded. */
2089 XSETFASTINT (XPROCESS (process
)->pid
, pid
);
2092 register_child (pid
, inchannel
);
2093 #endif /* WINDOWSNT */
2095 /* If the subfork execv fails, and it exits,
2096 this close hangs. I don't know why.
2097 So have an interrupt jar it loose. */
2099 struct atimer
*timer
;
2103 EMACS_SET_SECS_USECS (offset
, 1, 0);
2104 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2107 emacs_close (forkin
);
2109 cancel_atimer (timer
);
2113 if (forkin
!= forkout
&& forkout
>= 0)
2114 emacs_close (forkout
);
2118 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2121 XPROCESS (process
)->tty_name
= Qnil
;
2124 /* Restore the signal state whether vfork succeeded or not.
2125 (We will signal an error, below, if it failed.) */
2126 #ifdef POSIX_SIGNALS
2127 #ifdef HAVE_WORKING_VFORK
2128 /* Restore the parent's signal handlers. */
2129 sigaction (SIGINT
, &sigint_action
, 0);
2130 sigaction (SIGQUIT
, &sigquit_action
, 0);
2132 sigaction (SIGHUP
, &sighup_action
, 0);
2134 #endif /* HAVE_WORKING_VFORK */
2135 /* Stop blocking signals in the parent. */
2136 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2137 #else /* !POSIX_SIGNALS */
2141 #else /* not BSD4_1 */
2142 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2143 sigsetmask (SIGEMPTYMASK
);
2144 #else /* ordinary USG */
2146 signal (SIGCHLD
, sigchld
);
2147 /* Now really handle any of these signals
2148 that came in during this function. */
2149 if (sigchld_deferred
)
2150 kill (getpid (), SIGCHLD
);
2152 #endif /* ordinary USG */
2153 #endif /* not BSD4_1 */
2154 #endif /* SIGCHLD */
2155 #endif /* !POSIX_SIGNALS */
2157 /* Now generate the error if vfork failed. */
2159 report_file_error ("Doing vfork", Qnil
);
2161 #endif /* not VMS */
2166 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2167 The address family of sa is not included in the result. */
2170 conv_sockaddr_to_lisp (sa
, len
)
2171 struct sockaddr
*sa
;
2174 Lisp_Object address
;
2177 register struct Lisp_Vector
*p
;
2179 switch (sa
->sa_family
)
2183 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2184 len
= sizeof (sin
->sin_addr
) + 1;
2185 address
= Fmake_vector (make_number (len
), Qnil
);
2186 p
= XVECTOR (address
);
2187 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2188 cp
= (unsigned char *)&sin
->sin_addr
;
2191 #ifdef HAVE_LOCAL_SOCKETS
2194 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2195 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2196 if (sockun
->sun_path
[i
] == 0)
2198 return make_unibyte_string (sockun
->sun_path
, i
);
2202 len
-= sizeof (sa
->sa_family
);
2203 address
= Fcons (make_number (sa
->sa_family
),
2204 Fmake_vector (make_number (len
), Qnil
));
2205 p
= XVECTOR (XCDR (address
));
2206 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2212 p
->contents
[i
++] = make_number (*cp
++);
2218 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2221 get_lisp_to_sockaddr_size (address
, familyp
)
2222 Lisp_Object address
;
2225 register struct Lisp_Vector
*p
;
2227 if (VECTORP (address
))
2229 p
= XVECTOR (address
);
2233 return sizeof (struct sockaddr_in
);
2236 #ifdef HAVE_LOCAL_SOCKETS
2237 else if (STRINGP (address
))
2239 *familyp
= AF_LOCAL
;
2240 return sizeof (struct sockaddr_un
);
2243 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2245 struct sockaddr
*sa
;
2246 *familyp
= XINT (XCAR (address
));
2247 p
= XVECTOR (XCDR (address
));
2248 return p
->size
+ sizeof (sa
->sa_family
);
2253 /* Convert an address object (vector or string) to an internal sockaddr.
2254 Format of address has already been validated by size_lisp_to_sockaddr. */
2257 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2259 Lisp_Object address
;
2260 struct sockaddr
*sa
;
2263 register struct Lisp_Vector
*p
;
2264 register unsigned char *cp
= NULL
;
2268 sa
->sa_family
= family
;
2270 if (VECTORP (address
))
2272 p
= XVECTOR (address
);
2273 if (family
== AF_INET
)
2275 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2276 len
= sizeof (sin
->sin_addr
) + 1;
2277 i
= XINT (p
->contents
[--len
]);
2278 sin
->sin_port
= htons (i
);
2279 cp
= (unsigned char *)&sin
->sin_addr
;
2282 else if (STRINGP (address
))
2284 #ifdef HAVE_LOCAL_SOCKETS
2285 if (family
== AF_LOCAL
)
2287 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2288 cp
= SDATA (address
);
2289 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2290 sockun
->sun_path
[i
] = *cp
++;
2297 p
= XVECTOR (XCDR (address
));
2298 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2301 for (i
= 0; i
< len
; i
++)
2302 if (INTEGERP (p
->contents
[i
]))
2303 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2306 #ifdef DATAGRAM_SOCKETS
2307 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2309 doc
: /* Get the current datagram address associated with PROCESS. */)
2311 Lisp_Object process
;
2315 CHECK_PROCESS (process
);
2317 if (!DATAGRAM_CONN_P (process
))
2320 channel
= XINT (XPROCESS (process
)->infd
);
2321 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2322 datagram_address
[channel
].len
);
2325 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2327 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2328 Returns nil upon error setting address, ADDRESS otherwise. */)
2330 Lisp_Object process
, address
;
2335 CHECK_PROCESS (process
);
2337 if (!DATAGRAM_CONN_P (process
))
2340 channel
= XINT (XPROCESS (process
)->infd
);
2342 len
= get_lisp_to_sockaddr_size (address
, &family
);
2343 if (datagram_address
[channel
].len
!= len
)
2345 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2351 static struct socket_options
{
2352 /* The name of this option. Should be lowercase version of option
2353 name without SO_ prefix. */
2355 /* Option level SOL_... */
2357 /* Option number SO_... */
2359 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2360 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2361 } socket_options
[] =
2363 #ifdef SO_BINDTODEVICE
2364 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2367 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2370 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2373 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2376 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2379 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2382 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2385 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2387 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2390 /* Set option OPT to value VAL on socket S.
2392 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2393 Signals an error if setting a known option fails.
2397 set_socket_option (s
, opt
, val
)
2399 Lisp_Object opt
, val
;
2402 struct socket_options
*sopt
;
2407 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2408 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2409 if (strcmp (name
, sopt
->name
) == 0)
2412 switch (sopt
->opttype
)
2417 optval
= NILP (val
) ? 0 : 1;
2418 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2419 &optval
, sizeof (optval
));
2427 optval
= XINT (val
);
2429 error ("Bad option value for %s", name
);
2430 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2431 &optval
, sizeof (optval
));
2435 #ifdef SO_BINDTODEVICE
2438 char devname
[IFNAMSIZ
+1];
2440 /* This is broken, at least in the Linux 2.4 kernel.
2441 To unbind, the arg must be a zero integer, not the empty string.
2442 This should work on all systems. KFS. 2003-09-23. */
2443 bzero (devname
, sizeof devname
);
2446 char *arg
= (char *) SDATA (val
);
2447 int len
= min (strlen (arg
), IFNAMSIZ
);
2448 bcopy (arg
, devname
, len
);
2450 else if (!NILP (val
))
2451 error ("Bad option value for %s", name
);
2452 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2461 struct linger linger
;
2464 linger
.l_linger
= 0;
2466 linger
.l_linger
= XINT (val
);
2468 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2469 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2470 &linger
, sizeof (linger
));
2480 report_file_error ("Cannot set network option",
2481 Fcons (opt
, Fcons (val
, Qnil
)));
2482 return (1 << sopt
->optbit
);
2486 DEFUN ("set-network-process-option",
2487 Fset_network_process_option
, Sset_network_process_option
,
2489 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2490 See `make-network-process' for a list of options and values.
2491 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2492 OPTION is not a supported option, return nil instead; otherwise return t. */)
2493 (process
, option
, value
, no_error
)
2494 Lisp_Object process
, option
, value
;
2495 Lisp_Object no_error
;
2498 struct Lisp_Process
*p
;
2500 CHECK_PROCESS (process
);
2501 p
= XPROCESS (process
);
2502 if (!NETCONN1_P (p
))
2503 error ("Process is not a network process");
2507 error ("Process is not running");
2509 if (set_socket_option (s
, option
, value
))
2511 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2515 if (NILP (no_error
))
2516 error ("Unknown or unsupported option");
2522 /* A version of request_sigio suitable for a record_unwind_protect. */
2525 unwind_request_sigio (dummy
)
2528 if (interrupt_input
)
2533 /* Create a network stream/datagram client/server process. Treated
2534 exactly like a normal process when reading and writing. Primary
2535 differences are in status display and process deletion. A network
2536 connection has no PID; you cannot signal it. All you can do is
2537 stop/continue it and deactivate/close it via delete-process */
2539 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2541 doc
: /* Create and return a network server or client process.
2543 In Emacs, network connections are represented by process objects, so
2544 input and output work as for subprocesses and `delete-process' closes
2545 a network connection. However, a network process has no process id,
2546 it cannot be signalled, and the status codes are different from normal
2549 Arguments are specified as keyword/argument pairs. The following
2550 arguments are defined:
2552 :name NAME -- NAME is name for process. It is modified if necessary
2555 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2556 with the process. Process output goes at end of that buffer, unless
2557 you specify an output stream or filter function to handle the output.
2558 BUFFER may be also nil, meaning that this process is not associated
2561 :host HOST -- HOST is name of the host to connect to, or its IP
2562 address. The symbol `local' specifies the local host. If specified
2563 for a server process, it must be a valid name or address for the local
2564 host, and only clients connecting to that address will be accepted.
2566 :service SERVICE -- SERVICE is name of the service desired, or an
2567 integer specifying a port number to connect to. If SERVICE is t,
2568 a random port number is selected for the server.
2570 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2571 stream type connection, `datagram' creates a datagram type connection.
2573 :family FAMILY -- FAMILY is the address (and protocol) family for the
2574 service specified by HOST and SERVICE. The default address family is
2575 Inet (or IPv4) for the host and port number specified by HOST and
2576 SERVICE. Other address families supported are:
2577 local -- for a local (i.e. UNIX) address specified by SERVICE.
2579 :local ADDRESS -- ADDRESS is the local address used for the connection.
2580 This parameter is ignored when opening a client process. When specified
2581 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2583 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2584 connection. This parameter is ignored when opening a stream server
2585 process. For a datagram server process, it specifies the initial
2586 setting of the remote datagram address. When specified for a client
2587 process, the FAMILY, HOST, and SERVICE args are ignored.
2589 The format of ADDRESS depends on the address family:
2590 - An IPv4 address is represented as an vector of integers [A B C D P]
2591 corresponding to numeric IP address A.B.C.D and port number P.
2592 - A local address is represented as a string with the address in the
2593 local address space.
2594 - An "unsupported family" address is represented by a cons (F . AV)
2595 where F is the family number and AV is a vector containing the socket
2596 address data with one element per address data byte. Do not rely on
2597 this format in portable code, as it may depend on implementation
2598 defined constants, data sizes, and data structure alignment.
2600 :coding CODING -- If CODING is a symbol, it specifies the coding
2601 system used for both reading and writing for this process. If CODING
2602 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2603 ENCODING is used for writing.
2605 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2606 return without waiting for the connection to complete; instead, the
2607 sentinel function will be called with second arg matching "open" (if
2608 successful) or "failed" when the connect completes. Default is to use
2609 a blocking connect (i.e. wait) for stream type connections.
2611 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2612 running when emacs is exited.
2614 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2615 In the stopped state, a server process does not accept new
2616 connections, and a client process does not handle incoming traffic.
2617 The stopped state is cleared by `continue-process' and set by
2620 :filter FILTER -- Install FILTER as the process filter.
2622 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2623 process filter are multibyte, otherwise they are unibyte.
2624 If this keyword is not specified, the strings are multibyte iff
2625 `default-enable-multibyte-characters' is non-nil.
2627 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2629 :log LOG -- Install LOG as the server process log function. This
2630 function is called when the server accepts a network connection from a
2631 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2632 is the server process, CLIENT is the new process for the connection,
2633 and MESSAGE is a string.
2635 :plist PLIST -- Install PLIST as the new process' initial plist.
2637 :server QLEN -- if QLEN is non-nil, create a server process for the
2638 specified FAMILY, SERVICE, and connection type (stream or datagram).
2639 If QLEN is an integer, it is used as the max. length of the server's
2640 pending connection queue (also known as the backlog); the default
2641 queue length is 5. Default is to create a client process.
2643 The following network options can be specified for this connection:
2645 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2646 :dontroute BOOL -- Only send to directly connected hosts.
2647 :keepalive BOOL -- Send keep-alive messages on network stream.
2648 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2649 :oobinline BOOL -- Place out-of-band data in receive data stream.
2650 :priority INT -- Set protocol defined priority for sent packets.
2651 :reuseaddr BOOL -- Allow reusing a recently used local address
2652 (this is allowed by default for a server process).
2653 :bindtodevice NAME -- bind to interface NAME. Using this may require
2654 special privileges on some systems.
2656 Consult the relevant system programmer's manual pages for more
2657 information on using these options.
2660 A server process will listen for and accept connections from clients.
2661 When a client connection is accepted, a new network process is created
2662 for the connection with the following parameters:
2664 - The client's process name is constructed by concatenating the server
2665 process' NAME and a client identification string.
2666 - If the FILTER argument is non-nil, the client process will not get a
2667 separate process buffer; otherwise, the client's process buffer is a newly
2668 created buffer named after the server process' BUFFER name or process
2669 NAME concatenated with the client identification string.
2670 - The connection type and the process filter and sentinel parameters are
2671 inherited from the server process' TYPE, FILTER and SENTINEL.
2672 - The client process' contact info is set according to the client's
2673 addressing information (typically an IP address and a port number).
2674 - The client process' plist is initialized from the server's plist.
2676 Notice that the FILTER and SENTINEL args are never used directly by
2677 the server process. Also, the BUFFER argument is not used directly by
2678 the server process, but via the optional :log function, accepted (and
2679 failed) connections may be logged in the server process' buffer.
2681 The original argument list, modified with the actual connection
2682 information, is available via the `process-contact' function.
2684 usage: (make-network-process &rest ARGS) */)
2690 Lisp_Object contact
;
2691 struct Lisp_Process
*p
;
2692 #ifdef HAVE_GETADDRINFO
2693 struct addrinfo ai
, *res
, *lres
;
2694 struct addrinfo hints
;
2695 char *portstring
, portbuf
[128];
2696 #else /* HAVE_GETADDRINFO */
2697 struct _emacs_addrinfo
2703 struct sockaddr
*ai_addr
;
2704 struct _emacs_addrinfo
*ai_next
;
2706 #endif /* HAVE_GETADDRINFO */
2707 struct sockaddr_in address_in
;
2708 #ifdef HAVE_LOCAL_SOCKETS
2709 struct sockaddr_un address_un
;
2714 int s
= -1, outch
, inch
;
2715 struct gcpro gcpro1
;
2717 int count
= SPECPDL_INDEX ();
2719 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2721 Lisp_Object name
, buffer
, host
, service
, address
;
2722 Lisp_Object filter
, sentinel
;
2723 int is_non_blocking_client
= 0;
2724 int is_server
= 0, backlog
= 5;
2731 /* Save arguments for process-contact and clone-process. */
2732 contact
= Flist (nargs
, args
);
2736 /* Ensure socket support is loaded if available. */
2737 init_winsock (TRUE
);
2740 /* :type TYPE (nil: stream, datagram */
2741 tem
= Fplist_get (contact
, QCtype
);
2743 socktype
= SOCK_STREAM
;
2744 #ifdef DATAGRAM_SOCKETS
2745 else if (EQ (tem
, Qdatagram
))
2746 socktype
= SOCK_DGRAM
;
2749 error ("Unsupported connection type");
2752 tem
= Fplist_get (contact
, QCserver
);
2755 /* Don't support network sockets when non-blocking mode is
2756 not available, since a blocked Emacs is not useful. */
2757 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2758 error ("Network servers not supported");
2762 backlog
= XINT (tem
);
2766 /* Make QCaddress an alias for :local (server) or :remote (client). */
2767 QCaddress
= is_server
? QClocal
: QCremote
;
2770 if (!is_server
&& socktype
== SOCK_STREAM
2771 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2773 #ifndef NON_BLOCKING_CONNECT
2774 error ("Non-blocking connect not supported");
2776 is_non_blocking_client
= 1;
2780 name
= Fplist_get (contact
, QCname
);
2781 buffer
= Fplist_get (contact
, QCbuffer
);
2782 filter
= Fplist_get (contact
, QCfilter
);
2783 sentinel
= Fplist_get (contact
, QCsentinel
);
2785 CHECK_STRING (name
);
2788 /* Let's handle TERM before things get complicated ... */
2789 host
= Fplist_get (contact
, QChost
);
2790 CHECK_STRING (host
);
2792 service
= Fplist_get (contact
, QCservice
);
2793 if (INTEGERP (service
))
2794 port
= htons ((unsigned short) XINT (service
));
2797 struct servent
*svc_info
;
2798 CHECK_STRING (service
);
2799 svc_info
= getservbyname (SDATA (service
), "tcp");
2801 error ("Unknown service: %s", SDATA (service
));
2802 port
= svc_info
->s_port
;
2805 s
= connect_server (0);
2807 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2808 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2809 send_command (s
, C_DUMB
, 1, 0);
2811 #else /* not TERM */
2813 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2814 ai
.ai_socktype
= socktype
;
2819 /* :local ADDRESS or :remote ADDRESS */
2820 address
= Fplist_get (contact
, QCaddress
);
2821 if (!NILP (address
))
2823 host
= service
= Qnil
;
2825 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2826 error ("Malformed :address");
2827 ai
.ai_family
= family
;
2828 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2829 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2833 /* :family FAMILY -- nil (for Inet), local, or integer. */
2834 tem
= Fplist_get (contact
, QCfamily
);
2836 family
= XINT (tem
);
2841 #ifdef HAVE_LOCAL_SOCKETS
2842 else if (EQ (tem
, Qlocal
))
2847 error ("Unknown address family");
2848 ai
.ai_family
= family
;
2850 /* :service SERVICE -- string, integer (port number), or t (random port). */
2851 service
= Fplist_get (contact
, QCservice
);
2853 #ifdef HAVE_LOCAL_SOCKETS
2854 if (family
== AF_LOCAL
)
2856 /* Host is not used. */
2858 CHECK_STRING (service
);
2859 bzero (&address_un
, sizeof address_un
);
2860 address_un
.sun_family
= AF_LOCAL
;
2861 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
2862 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
2863 ai
.ai_addrlen
= sizeof address_un
;
2868 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2869 host
= Fplist_get (contact
, QChost
);
2872 if (EQ (host
, Qlocal
))
2873 host
= build_string ("localhost");
2874 CHECK_STRING (host
);
2877 /* Slow down polling to every ten seconds.
2878 Some kernels have a bug which causes retrying connect to fail
2879 after a connect. Polling can interfere with gethostbyname too. */
2880 #ifdef POLL_FOR_INPUT
2881 if (socktype
== SOCK_STREAM
)
2883 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
2884 bind_polling_period (10);
2888 #ifdef HAVE_GETADDRINFO
2889 /* If we have a host, use getaddrinfo to resolve both host and service.
2890 Otherwise, use getservbyname to lookup the service. */
2894 /* SERVICE can either be a string or int.
2895 Convert to a C string for later use by getaddrinfo. */
2896 if (EQ (service
, Qt
))
2898 else if (INTEGERP (service
))
2900 sprintf (portbuf
, "%ld", (long) XINT (service
));
2901 portstring
= portbuf
;
2905 CHECK_STRING (service
);
2906 portstring
= SDATA (service
);
2911 memset (&hints
, 0, sizeof (hints
));
2913 hints
.ai_family
= NILP (Fplist_member (contact
, QCfamily
)) ? AF_UNSPEC
: family
;
2914 hints
.ai_socktype
= socktype
;
2915 hints
.ai_protocol
= 0;
2916 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
2918 #ifdef HAVE_GAI_STRERROR
2919 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
2921 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
2927 #endif /* HAVE_GETADDRINFO */
2929 /* We end up here if getaddrinfo is not defined, or in case no hostname
2930 has been specified (e.g. for a local server process). */
2932 if (EQ (service
, Qt
))
2934 else if (INTEGERP (service
))
2935 port
= htons ((unsigned short) XINT (service
));
2938 struct servent
*svc_info
;
2939 CHECK_STRING (service
);
2940 svc_info
= getservbyname (SDATA (service
),
2941 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
2943 error ("Unknown service: %s", SDATA (service
));
2944 port
= svc_info
->s_port
;
2947 bzero (&address_in
, sizeof address_in
);
2948 address_in
.sin_family
= family
;
2949 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
2950 address_in
.sin_port
= port
;
2952 #ifndef HAVE_GETADDRINFO
2955 struct hostent
*host_info_ptr
;
2957 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
2958 as it may `hang' emacs for a very long time. */
2961 host_info_ptr
= gethostbyname (SDATA (host
));
2966 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
2967 host_info_ptr
->h_length
);
2968 family
= host_info_ptr
->h_addrtype
;
2969 address_in
.sin_family
= family
;
2972 /* Attempt to interpret host as numeric inet address */
2974 IN_ADDR numeric_addr
;
2975 numeric_addr
= inet_addr ((char *) SDATA (host
));
2976 if (NUMERIC_ADDR_ERROR
)
2977 error ("Unknown host \"%s\"", SDATA (host
));
2979 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
2980 sizeof (address_in
.sin_addr
));
2984 #endif /* not HAVE_GETADDRINFO */
2986 ai
.ai_family
= family
;
2987 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
2988 ai
.ai_addrlen
= sizeof address_in
;
2992 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
2993 when connect is interrupted. So let's not let it get interrupted.
2994 Note we do not turn off polling, because polling is only used
2995 when not interrupt_input, and thus not normally used on the systems
2996 which have this bug. On systems which use polling, there's no way
2997 to quit if polling is turned off. */
2999 && !is_server
&& socktype
== SOCK_STREAM
)
3001 /* Comment from KFS: The original open-network-stream code
3002 didn't unwind protect this, but it seems like the proper
3003 thing to do. In any case, I don't see how it could harm to
3004 do this -- and it makes cleanup (using unbind_to) easier. */
3005 record_unwind_protect (unwind_request_sigio
, Qnil
);
3009 /* Do this in case we never enter the for-loop below. */
3010 count1
= SPECPDL_INDEX ();
3013 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3017 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3024 #ifdef DATAGRAM_SOCKETS
3025 if (!is_server
&& socktype
== SOCK_DGRAM
)
3027 #endif /* DATAGRAM_SOCKETS */
3029 #ifdef NON_BLOCKING_CONNECT
3030 if (is_non_blocking_client
)
3033 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3035 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3047 /* Make us close S if quit. */
3048 record_unwind_protect (close_file_unwind
, make_number (s
));
3050 /* Parse network options in the arg list.
3051 We simply ignore anything which isn't a known option (including other keywords).
3052 An error is signalled if setting a known option fails. */
3053 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3054 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3058 /* Configure as a server socket. */
3060 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3061 explicit :reuseaddr key to override this. */
3062 #ifdef HAVE_LOCAL_SOCKETS
3063 if (family
!= AF_LOCAL
)
3065 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3068 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3069 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3072 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3073 report_file_error ("Cannot bind server socket", Qnil
);
3075 #ifdef HAVE_GETSOCKNAME
3076 if (EQ (service
, Qt
))
3078 struct sockaddr_in sa1
;
3079 int len1
= sizeof (sa1
);
3080 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3082 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3083 service
= make_number (ntohs (sa1
.sin_port
));
3084 contact
= Fplist_put (contact
, QCservice
, service
);
3089 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3090 report_file_error ("Cannot listen on server socket", Qnil
);
3100 /* This turns off all alarm-based interrupts; the
3101 bind_polling_period call above doesn't always turn all the
3102 short-interval ones off, especially if interrupt_input is
3105 It'd be nice to be able to control the connect timeout
3106 though. Would non-blocking connect calls be portable?
3108 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3110 turn_on_atimers (0);
3112 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3115 turn_on_atimers (1);
3117 if (ret
== 0 || xerrno
== EISCONN
)
3119 /* The unwind-protect will be discarded afterwards.
3120 Likewise for immediate_quit. */
3124 #ifdef NON_BLOCKING_CONNECT
3126 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3130 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3138 if (xerrno
== EINTR
)
3140 if (xerrno
== EADDRINUSE
&& retry
< 20)
3142 /* A delay here is needed on some FreeBSD systems,
3143 and it is harmless, since this retrying takes time anyway
3144 and should be infrequent. */
3145 Fsleep_for (make_number (1), Qnil
);
3150 /* Discard the unwind protect closing S. */
3151 specpdl_ptr
= specpdl
+ count1
;
3158 #ifdef DATAGRAM_SOCKETS
3159 if (socktype
== SOCK_DGRAM
)
3161 if (datagram_address
[s
].sa
)
3163 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3164 datagram_address
[s
].len
= lres
->ai_addrlen
;
3168 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3169 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3172 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3173 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3174 conv_lisp_to_sockaddr (rfamily
, remote
,
3175 datagram_address
[s
].sa
, rlen
);
3179 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3182 contact
= Fplist_put (contact
, QCaddress
,
3183 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3184 #ifdef HAVE_GETSOCKNAME
3187 struct sockaddr_in sa1
;
3188 int len1
= sizeof (sa1
);
3189 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3190 contact
= Fplist_put (contact
, QClocal
,
3191 conv_sockaddr_to_lisp (&sa1
, len1
));
3196 #ifdef HAVE_GETADDRINFO
3203 /* Discard the unwind protect for closing S, if any. */
3204 specpdl_ptr
= specpdl
+ count1
;
3206 /* Unwind bind_polling_period and request_sigio. */
3207 unbind_to (count
, Qnil
);
3211 /* If non-blocking got this far - and failed - assume non-blocking is
3212 not supported after all. This is probably a wrong assumption, but
3213 the normal blocking calls to open-network-stream handles this error
3215 if (is_non_blocking_client
)
3220 report_file_error ("make server process failed", contact
);
3222 report_file_error ("make client process failed", contact
);
3225 #endif /* not TERM */
3231 buffer
= Fget_buffer_create (buffer
);
3232 proc
= make_process (name
);
3234 chan_process
[inch
] = proc
;
3237 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3240 fcntl (inch
, F_SETFL
, O_NDELAY
);
3244 p
= XPROCESS (proc
);
3246 p
->childp
= contact
;
3247 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3250 p
->sentinel
= sentinel
;
3252 p
->filter_multibyte
= buffer_defaults
.enable_multibyte_characters
;
3253 /* Override the above only if :filter-multibyte is specified. */
3254 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3255 p
->filter_multibyte
= Fplist_get (contact
, QCfilter_multibyte
);
3256 p
->log
= Fplist_get (contact
, QClog
);
3257 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3258 p
->kill_without_query
= Qt
;
3259 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3262 XSETINT (p
->infd
, inch
);
3263 XSETINT (p
->outfd
, outch
);
3264 if (is_server
&& socktype
== SOCK_STREAM
)
3265 p
->status
= Qlisten
;
3267 #ifdef NON_BLOCKING_CONNECT
3268 if (is_non_blocking_client
)
3270 /* We may get here if connect did succeed immediately. However,
3271 in that case, we still need to signal this like a non-blocking
3273 p
->status
= Qconnect
;
3274 if (!FD_ISSET (inch
, &connect_wait_mask
))
3276 FD_SET (inch
, &connect_wait_mask
);
3277 num_pending_connects
++;
3282 /* A server may have a client filter setting of Qt, but it must
3283 still listen for incoming connects unless it is stopped. */
3284 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3285 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3287 FD_SET (inch
, &input_wait_mask
);
3288 FD_SET (inch
, &non_keyboard_wait_mask
);
3291 if (inch
> max_process_desc
)
3292 max_process_desc
= inch
;
3294 tem
= Fplist_member (contact
, QCcoding
);
3295 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3296 tem
= Qnil
; /* No error message (too late!). */
3299 /* Setup coding systems for communicating with the network stream. */
3300 struct gcpro gcpro1
;
3301 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3302 Lisp_Object coding_systems
= Qt
;
3303 Lisp_Object args
[5], val
;
3307 val
= XCAR (XCDR (tem
));
3311 else if (!NILP (Vcoding_system_for_read
))
3312 val
= Vcoding_system_for_read
;
3313 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3314 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3315 /* We dare not decode end-of-line format by setting VAL to
3316 Qraw_text, because the existing Emacs Lisp libraries
3317 assume that they receive bare code including a sequene of
3322 if (NILP (host
) || NILP (service
))
3323 coding_systems
= Qnil
;
3326 args
[0] = Qopen_network_stream
, args
[1] = name
,
3327 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3329 coding_systems
= Ffind_operation_coding_system (5, args
);
3332 if (CONSP (coding_systems
))
3333 val
= XCAR (coding_systems
);
3334 else if (CONSP (Vdefault_process_coding_system
))
3335 val
= XCAR (Vdefault_process_coding_system
);
3339 p
->decode_coding_system
= val
;
3343 val
= XCAR (XCDR (tem
));
3347 else if (!NILP (Vcoding_system_for_write
))
3348 val
= Vcoding_system_for_write
;
3349 else if (NILP (current_buffer
->enable_multibyte_characters
))
3353 if (EQ (coding_systems
, Qt
))
3355 if (NILP (host
) || NILP (service
))
3356 coding_systems
= Qnil
;
3359 args
[0] = Qopen_network_stream
, args
[1] = name
,
3360 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3362 coding_systems
= Ffind_operation_coding_system (5, args
);
3366 if (CONSP (coding_systems
))
3367 val
= XCDR (coding_systems
);
3368 else if (CONSP (Vdefault_process_coding_system
))
3369 val
= XCDR (Vdefault_process_coding_system
);
3373 p
->encode_coding_system
= val
;
3375 setup_process_coding_systems (proc
);
3377 p
->decoding_buf
= make_uninit_string (0);
3378 p
->decoding_carryover
= make_number (0);
3379 p
->encoding_buf
= make_uninit_string (0);
3380 p
->encoding_carryover
= make_number (0);
3382 p
->inherit_coding_system_flag
3383 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3389 #endif /* HAVE_SOCKETS */
3392 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3395 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3396 doc
: /* Return an alist of all network interfaces and their network address.
3397 Each element is a cons, the car of which is a string containing the
3398 interface name, and the cdr is the network address in internal
3399 format; see the description of ADDRESS in `make-network-process'. */)
3402 struct ifconf ifconf
;
3403 struct ifreq
*ifreqs
= NULL
;
3408 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3414 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3415 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3422 ifconf
.ifc_len
= buf_size
;
3423 ifconf
.ifc_req
= ifreqs
;
3424 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3430 if (ifconf
.ifc_len
== buf_size
)
3434 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3437 while (--ifaces
>= 0)
3439 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3440 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3441 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3443 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3444 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3445 res
= Fcons (Fcons (build_string (namebuf
),
3446 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3447 sizeof (struct sockaddr
))),
3453 #endif /* SIOCGIFCONF */
3455 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3462 static struct ifflag_def ifflag_table
[] = {
3466 #ifdef IFF_BROADCAST
3467 { IFF_BROADCAST
, "broadcast" },
3470 { IFF_DEBUG
, "debug" },
3473 { IFF_LOOPBACK
, "loopback" },
3475 #ifdef IFF_POINTOPOINT
3476 { IFF_POINTOPOINT
, "pointopoint" },
3479 { IFF_RUNNING
, "running" },
3482 { IFF_NOARP
, "noarp" },
3485 { IFF_PROMISC
, "promisc" },
3487 #ifdef IFF_NOTRAILERS
3488 { IFF_NOTRAILERS
, "notrailers" },
3491 { IFF_ALLMULTI
, "allmulti" },
3494 { IFF_MASTER
, "master" },
3497 { IFF_SLAVE
, "slave" },
3499 #ifdef IFF_MULTICAST
3500 { IFF_MULTICAST
, "multicast" },
3503 { IFF_PORTSEL
, "portsel" },
3505 #ifdef IFF_AUTOMEDIA
3506 { IFF_AUTOMEDIA
, "automedia" },
3509 { IFF_DYNAMIC
, "dynamic" },
3514 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3515 doc
: /* Return information about network interface named IFNAME.
3516 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3517 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3518 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3519 FLAGS is the current flags of the interface. */)
3524 Lisp_Object res
= Qnil
;
3529 CHECK_STRING (ifname
);
3531 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3532 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3534 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3539 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3540 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3542 int flags
= rq
.ifr_flags
;
3543 struct ifflag_def
*fp
;
3547 for (fp
= ifflag_table
; flags
!= 0 && fp
; fp
++)
3549 if (flags
& fp
->flag_bit
)
3551 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3552 flags
-= fp
->flag_bit
;
3555 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3557 if (flags
& (1 << fnum
))
3559 elt
= Fcons (make_number (fnum
), elt
);
3564 res
= Fcons (elt
, res
);
3567 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3568 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3570 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3571 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3575 for (n
= 0; n
< 6; n
++)
3576 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3577 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3580 res
= Fcons (elt
, res
);
3583 #if defined(SIOCGIFNETMASK) && defined(ifr_netmask)
3584 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3587 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3590 res
= Fcons (elt
, res
);
3593 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3594 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3597 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3600 res
= Fcons (elt
, res
);
3603 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3604 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3607 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3610 res
= Fcons (elt
, res
);
3614 return any
? res
: Qnil
;
3617 #endif /* HAVE_SOCKETS */
3620 deactivate_process (proc
)
3623 register int inchannel
, outchannel
;
3624 register struct Lisp_Process
*p
= XPROCESS (proc
);
3626 inchannel
= XINT (p
->infd
);
3627 outchannel
= XINT (p
->outfd
);
3629 #ifdef ADAPTIVE_READ_BUFFERING
3630 if (XINT (p
->read_output_delay
) > 0)
3632 if (--process_output_delay_count
< 0)
3633 process_output_delay_count
= 0;
3634 XSETINT (p
->read_output_delay
, 0);
3635 p
->read_output_skip
= Qnil
;
3641 /* Beware SIGCHLD hereabouts. */
3642 flush_pending_output (inchannel
);
3645 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3646 sys$
dassgn (outchannel
);
3647 vs
= get_vms_process_pointer (p
->pid
);
3649 give_back_vms_process_stuff (vs
);
3652 emacs_close (inchannel
);
3653 if (outchannel
>= 0 && outchannel
!= inchannel
)
3654 emacs_close (outchannel
);
3657 XSETINT (p
->infd
, -1);
3658 XSETINT (p
->outfd
, -1);
3659 #ifdef DATAGRAM_SOCKETS
3660 if (DATAGRAM_CHAN_P (inchannel
))
3662 xfree (datagram_address
[inchannel
].sa
);
3663 datagram_address
[inchannel
].sa
= 0;
3664 datagram_address
[inchannel
].len
= 0;
3667 chan_process
[inchannel
] = Qnil
;
3668 FD_CLR (inchannel
, &input_wait_mask
);
3669 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3670 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3672 FD_CLR (inchannel
, &connect_wait_mask
);
3673 if (--num_pending_connects
< 0)
3676 if (inchannel
== max_process_desc
)
3679 /* We just closed the highest-numbered process input descriptor,
3680 so recompute the highest-numbered one now. */
3681 max_process_desc
= 0;
3682 for (i
= 0; i
< MAXDESC
; i
++)
3683 if (!NILP (chan_process
[i
]))
3684 max_process_desc
= i
;
3689 /* Close all descriptors currently in use for communication
3690 with subprocess. This is used in a newly-forked subprocess
3691 to get rid of irrelevant descriptors. */
3694 close_process_descs ()
3698 for (i
= 0; i
< MAXDESC
; i
++)
3700 Lisp_Object process
;
3701 process
= chan_process
[i
];
3702 if (!NILP (process
))
3704 int in
= XINT (XPROCESS (process
)->infd
);
3705 int out
= XINT (XPROCESS (process
)->outfd
);
3708 if (out
>= 0 && in
!= out
)
3715 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3717 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3718 It is read into the process' buffers or given to their filter functions.
3719 Non-nil arg PROCESS means do not return until some output has been received
3721 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of
3722 seconds and microseconds to wait; return after that much time whether
3723 or not there is input.
3724 Return non-nil iff we received any output before the timeout expired. */)
3725 (process
, timeout
, timeout_msecs
)
3726 register Lisp_Object process
, timeout
, timeout_msecs
;
3731 if (! NILP (process
))
3732 CHECK_PROCESS (process
);
3734 if (! NILP (timeout_msecs
))
3736 CHECK_NUMBER (timeout_msecs
);
3737 useconds
= XINT (timeout_msecs
);
3738 if (!INTEGERP (timeout
))
3739 XSETINT (timeout
, 0);
3742 int carry
= useconds
/ 1000000;
3744 XSETINT (timeout
, XINT (timeout
) + carry
);
3745 useconds
-= carry
* 1000000;
3747 /* I think this clause is necessary because C doesn't
3748 guarantee a particular rounding direction for negative
3752 XSETINT (timeout
, XINT (timeout
) - 1);
3753 useconds
+= 1000000;
3760 if (! NILP (timeout
))
3762 CHECK_NUMBER (timeout
);
3763 seconds
= XINT (timeout
);
3764 if (seconds
< 0 || (seconds
== 0 && useconds
== 0))
3768 seconds
= NILP (process
) ? -1 : 0;
3771 XSETFASTINT (process
, 0);
3774 (wait_reading_process_input (seconds
, useconds
, process
, 0)
3778 /* Accept a connection for server process SERVER on CHANNEL. */
3780 static int connect_counter
= 0;
3783 server_accept_connection (server
, channel
)
3787 Lisp_Object proc
, caller
, name
, buffer
;
3788 Lisp_Object contact
, host
, service
;
3789 struct Lisp_Process
*ps
= XPROCESS (server
);
3790 struct Lisp_Process
*p
;
3794 struct sockaddr_in in
;
3795 #ifdef HAVE_LOCAL_SOCKETS
3796 struct sockaddr_un un
;
3799 int len
= sizeof saddr
;
3801 s
= accept (channel
, &saddr
.sa
, &len
);
3810 if (code
== EWOULDBLOCK
)
3814 if (!NILP (ps
->log
))
3815 call3 (ps
->log
, server
, Qnil
,
3816 concat3 (build_string ("accept failed with code"),
3817 Fnumber_to_string (make_number (code
)),
3818 build_string ("\n")));
3824 /* Setup a new process to handle the connection. */
3826 /* Generate a unique identification of the caller, and build contact
3827 information for this process. */
3830 switch (saddr
.sa
.sa_family
)
3834 Lisp_Object args
[5];
3835 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
3836 args
[0] = build_string ("%d.%d.%d.%d");
3837 args
[1] = make_number (*ip
++);
3838 args
[2] = make_number (*ip
++);
3839 args
[3] = make_number (*ip
++);
3840 args
[4] = make_number (*ip
++);
3841 host
= Fformat (5, args
);
3842 service
= make_number (ntohs (saddr
.in
.sin_port
));
3844 args
[0] = build_string (" <%s:%d>");
3847 caller
= Fformat (3, args
);
3851 #ifdef HAVE_LOCAL_SOCKETS
3855 caller
= Fnumber_to_string (make_number (connect_counter
));
3856 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
3860 /* Create a new buffer name for this process if it doesn't have a
3861 filter. The new buffer name is based on the buffer name or
3862 process name of the server process concatenated with the caller
3865 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
3869 buffer
= ps
->buffer
;
3871 buffer
= Fbuffer_name (buffer
);
3876 buffer
= concat2 (buffer
, caller
);
3877 buffer
= Fget_buffer_create (buffer
);
3881 /* Generate a unique name for the new server process. Combine the
3882 server process name with the caller identification. */
3884 name
= concat2 (ps
->name
, caller
);
3885 proc
= make_process (name
);
3887 chan_process
[s
] = proc
;
3890 fcntl (s
, F_SETFL
, O_NONBLOCK
);
3893 fcntl (s
, F_SETFL
, O_NDELAY
);
3897 p
= XPROCESS (proc
);
3899 /* Build new contact information for this setup. */
3900 contact
= Fcopy_sequence (ps
->childp
);
3901 contact
= Fplist_put (contact
, QCserver
, Qnil
);
3902 contact
= Fplist_put (contact
, QChost
, host
);
3903 if (!NILP (service
))
3904 contact
= Fplist_put (contact
, QCservice
, service
);
3905 contact
= Fplist_put (contact
, QCremote
,
3906 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
3907 #ifdef HAVE_GETSOCKNAME
3909 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
3910 contact
= Fplist_put (contact
, QClocal
,
3911 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
3914 p
->childp
= contact
;
3915 p
->plist
= Fcopy_sequence (ps
->plist
);
3918 p
->sentinel
= ps
->sentinel
;
3919 p
->filter
= ps
->filter
;
3922 XSETINT (p
->infd
, s
);
3923 XSETINT (p
->outfd
, s
);
3926 /* Client processes for accepted connections are not stopped initially. */
3927 if (!EQ (p
->filter
, Qt
))
3929 FD_SET (s
, &input_wait_mask
);
3930 FD_SET (s
, &non_keyboard_wait_mask
);
3933 if (s
> max_process_desc
)
3934 max_process_desc
= s
;
3936 /* Setup coding system for new process based on server process.
3937 This seems to be the proper thing to do, as the coding system
3938 of the new process should reflect the settings at the time the
3939 server socket was opened; not the current settings. */
3941 p
->decode_coding_system
= ps
->decode_coding_system
;
3942 p
->encode_coding_system
= ps
->encode_coding_system
;
3943 setup_process_coding_systems (proc
);
3945 p
->decoding_buf
= make_uninit_string (0);
3946 p
->decoding_carryover
= make_number (0);
3947 p
->encoding_buf
= make_uninit_string (0);
3948 p
->encoding_carryover
= make_number (0);
3950 p
->inherit_coding_system_flag
3951 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
3953 if (!NILP (ps
->log
))
3954 call3 (ps
->log
, server
, proc
,
3955 concat3 (build_string ("accept from "),
3956 (STRINGP (host
) ? host
: build_string ("-")),
3957 build_string ("\n")));
3959 if (!NILP (p
->sentinel
))
3960 exec_sentinel (proc
,
3961 concat3 (build_string ("open from "),
3962 (STRINGP (host
) ? host
: build_string ("-")),
3963 build_string ("\n")));
3966 /* This variable is different from waiting_for_input in keyboard.c.
3967 It is used to communicate to a lisp process-filter/sentinel (via the
3968 function Fwaiting_for_user_input_p below) whether emacs was waiting
3969 for user-input when that process-filter was called.
3970 waiting_for_input cannot be used as that is by definition 0 when
3971 lisp code is being evalled.
3972 This is also used in record_asynch_buffer_change.
3973 For that purpose, this must be 0
3974 when not inside wait_reading_process_input. */
3975 static int waiting_for_user_input_p
;
3977 /* This is here so breakpoints can be put on it. */
3979 wait_reading_process_input_1 ()
3983 /* Read and dispose of subprocess output while waiting for timeout to
3984 elapse and/or keyboard input to be available.
3987 timeout in seconds, or
3988 zero for no limit, or
3989 -1 means gobble data immediately available but don't wait for any.
3992 an additional duration to wait, measured in microseconds.
3993 If this is nonzero and time_limit is 0, then the timeout
3994 consists of MICROSECS only.
3996 READ_KBD is a lisp value:
3997 0 to ignore keyboard input, or
3998 1 to return when input is available, or
3999 -1 meaning caller will actually read the input, so don't throw to
4000 the quit handler, or
4001 a cons cell, meaning wait until its car is non-nil
4002 (and gobble terminal input into the buffer if any arrives), or
4003 a process object, meaning wait until something arrives from that
4004 process. The return value is true iff we read some input from
4007 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4008 output that arrives.
4010 If READ_KBD is a pointer to a struct Lisp_Process, then the
4011 function returns true iff we received input from that process
4012 before the timeout elapsed.
4013 Otherwise, return true iff we received input from any process. */
4016 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
4017 int time_limit
, microsecs
;
4018 Lisp_Object read_kbd
;
4021 register int channel
, nfds
;
4022 static SELECT_TYPE Available
;
4023 static SELECT_TYPE Connecting
;
4024 int check_connect
, check_delay
, no_avail
;
4027 EMACS_TIME timeout
, end_time
;
4028 int wait_channel
= -1;
4029 struct Lisp_Process
*wait_proc
= 0;
4030 int got_some_input
= 0;
4031 /* Either nil or a cons cell, the car of which is of interest and
4032 may be changed outside of this routine. */
4033 Lisp_Object wait_for_cell
= Qnil
;
4035 FD_ZERO (&Available
);
4036 FD_ZERO (&Connecting
);
4038 /* If read_kbd is a process to watch, set wait_proc and wait_channel
4040 if (PROCESSP (read_kbd
))
4042 wait_proc
= XPROCESS (read_kbd
);
4043 wait_channel
= XINT (wait_proc
->infd
);
4044 XSETFASTINT (read_kbd
, 0);
4047 /* If waiting for non-nil in a cell, record where. */
4048 if (CONSP (read_kbd
))
4050 wait_for_cell
= read_kbd
;
4051 XSETFASTINT (read_kbd
, 0);
4054 waiting_for_user_input_p
= XINT (read_kbd
);
4056 /* Since we may need to wait several times,
4057 compute the absolute time to return at. */
4058 if (time_limit
|| microsecs
)
4060 EMACS_GET_TIME (end_time
);
4061 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4062 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4064 #ifdef POLL_INTERRUPTED_SYS_CALL
4065 /* AlainF 5-Jul-1996
4066 HP-UX 10.10 seem to have problems with signals coming in
4067 Causes "poll: interrupted system call" messages when Emacs is run
4069 Turn off periodic alarms (in case they are in use),
4070 and then turn off any other atimers. */
4072 turn_on_atimers (0);
4073 #endif /* POLL_INTERRUPTED_SYS_CALL */
4077 int timeout_reduced_for_timers
= 0;
4079 /* If calling from keyboard input, do not quit
4080 since we want to return C-g as an input character.
4081 Otherwise, do pending quit if requested. */
4082 if (XINT (read_kbd
) >= 0)
4085 else if (interrupt_input_pending
)
4086 handle_async_input ();
4089 /* Exit now if the cell we're waiting for became non-nil. */
4090 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4093 /* Compute time from now till when time limit is up */
4094 /* Exit if already run out */
4095 if (time_limit
== -1)
4097 /* -1 specified for timeout means
4098 gobble output available now
4099 but don't wait at all. */
4101 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4103 else if (time_limit
|| microsecs
)
4105 EMACS_GET_TIME (timeout
);
4106 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4107 if (EMACS_TIME_NEG_P (timeout
))
4112 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4115 /* Normally we run timers here.
4116 But not if wait_for_cell; in those cases,
4117 the wait is supposed to be short,
4118 and those callers cannot handle running arbitrary Lisp code here. */
4119 if (NILP (wait_for_cell
))
4121 EMACS_TIME timer_delay
;
4125 int old_timers_run
= timers_run
;
4126 struct buffer
*old_buffer
= current_buffer
;
4128 timer_delay
= timer_check (1);
4130 /* If a timer has run, this might have changed buffers
4131 an alike. Make read_key_sequence aware of that. */
4132 if (timers_run
!= old_timers_run
4133 && old_buffer
!= current_buffer
4134 && waiting_for_user_input_p
== -1)
4135 record_asynch_buffer_change ();
4137 if (timers_run
!= old_timers_run
&& do_display
)
4138 /* We must retry, since a timer may have requeued itself
4139 and that could alter the time_delay. */
4140 redisplay_preserve_echo_area (9);
4144 while (!detect_input_pending ());
4146 /* If there is unread keyboard input, also return. */
4147 if (XINT (read_kbd
) != 0
4148 && requeued_events_pending_p ())
4151 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4153 EMACS_TIME difference
;
4154 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4155 if (EMACS_TIME_NEG_P (difference
))
4157 timeout
= timer_delay
;
4158 timeout_reduced_for_timers
= 1;
4161 /* If time_limit is -1, we are not going to wait at all. */
4162 else if (time_limit
!= -1)
4164 /* This is so a breakpoint can be put here. */
4165 wait_reading_process_input_1 ();
4169 /* Cause C-g and alarm signals to take immediate action,
4170 and cause input available signals to zero out timeout.
4172 It is important that we do this before checking for process
4173 activity. If we get a SIGCHLD after the explicit checks for
4174 process activity, timeout is the only way we will know. */
4175 if (XINT (read_kbd
) < 0)
4176 set_waiting_for_input (&timeout
);
4178 /* If status of something has changed, and no input is
4179 available, notify the user of the change right away. After
4180 this explicit check, we'll let the SIGCHLD handler zap
4181 timeout to get our attention. */
4182 if (update_tick
!= process_tick
&& do_display
)
4184 SELECT_TYPE Atemp
, Ctemp
;
4186 Atemp
= input_wait_mask
;
4188 /* On Mac OS X, the SELECT system call always says input is
4189 present (for reading) at stdin, even when none is. This
4190 causes the call to SELECT below to return 1 and
4191 status_notify not to be called. As a result output of
4192 subprocesses are incorrectly discarded. */
4195 Ctemp
= connect_wait_mask
;
4196 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4197 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
4199 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4200 (SELECT_TYPE
*)0, &timeout
)
4203 /* It's okay for us to do this and then continue with
4204 the loop, since timeout has already been zeroed out. */
4205 clear_waiting_for_input ();
4210 /* Don't wait for output from a non-running process. Just
4211 read whatever data has already been received. */
4212 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
4213 update_status (wait_proc
);
4215 && ! EQ (wait_proc
->status
, Qrun
)
4216 && ! EQ (wait_proc
->status
, Qconnect
))
4218 int nread
, total_nread
= 0;
4220 clear_waiting_for_input ();
4221 XSETPROCESS (proc
, wait_proc
);
4223 /* Read data from the process, until we exhaust it. */
4224 while (XINT (wait_proc
->infd
) >= 0)
4226 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
4232 total_nread
+= nread
;
4234 else if (nread
== -1 && EIO
== errno
)
4238 else if (nread
== -1 && EAGAIN
== errno
)
4242 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4246 if (total_nread
> 0 && do_display
)
4247 redisplay_preserve_echo_area (10);
4252 /* Wait till there is something to do */
4254 if (!NILP (wait_for_cell
))
4256 Available
= non_process_wait_mask
;
4257 check_connect
= check_delay
= 0;
4261 if (! XINT (read_kbd
))
4262 Available
= non_keyboard_wait_mask
;
4264 Available
= input_wait_mask
;
4265 check_connect
= (num_pending_connects
> 0);
4266 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4269 /* If frame size has changed or the window is newly mapped,
4270 redisplay now, before we start to wait. There is a race
4271 condition here; if a SIGIO arrives between now and the select
4272 and indicates that a frame is trashed, the select may block
4273 displaying a trashed screen. */
4274 if (frame_garbaged
&& do_display
)
4276 clear_waiting_for_input ();
4277 redisplay_preserve_echo_area (11);
4278 if (XINT (read_kbd
) < 0)
4279 set_waiting_for_input (&timeout
);
4283 if (XINT (read_kbd
) && detect_input_pending ())
4291 Connecting
= connect_wait_mask
;
4293 #ifdef ADAPTIVE_READ_BUFFERING
4294 if (process_output_skip
&& check_delay
> 0)
4296 int usecs
= EMACS_USECS (timeout
);
4297 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4298 usecs
= READ_OUTPUT_DELAY_MAX
;
4299 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4301 proc
= chan_process
[channel
];
4304 if (XINT (XPROCESS (proc
)->read_output_delay
) > 0)
4307 if (NILP (XPROCESS (proc
)->read_output_skip
))
4309 FD_CLR (channel
, &Available
);
4310 XPROCESS (proc
)->read_output_skip
= Qnil
;
4311 if (XINT (XPROCESS (proc
)->read_output_delay
) < usecs
)
4312 usecs
= XINT (XPROCESS (proc
)->read_output_delay
);
4315 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4316 process_output_skip
= 0;
4320 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4322 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4323 (SELECT_TYPE
*)0, &timeout
);
4328 /* Make C-g and alarm signals set flags again */
4329 clear_waiting_for_input ();
4331 /* If we woke up due to SIGWINCH, actually change size now. */
4332 do_pending_window_change (0);
4334 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4335 /* We wanted the full specified time, so return now. */
4339 if (xerrno
== EINTR
)
4342 /* Ultrix select seems to return ENOMEM when it is
4343 interrupted. Treat it just like EINTR. Bleah. Note
4344 that we want to test for the "ultrix" CPP symbol, not
4345 "__ultrix__"; the latter is only defined under GCC, but
4346 not by DEC's bundled CC. -JimB */
4347 else if (xerrno
== ENOMEM
)
4351 /* This happens for no known reason on ALLIANT.
4352 I am guessing that this is the right response. -- RMS. */
4353 else if (xerrno
== EFAULT
)
4356 else if (xerrno
== EBADF
)
4359 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4360 the child's closure of the pts gives the parent a SIGHUP, and
4361 the ptc file descriptor is automatically closed,
4362 yielding EBADF here or at select() call above.
4363 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4364 in m/ibmrt-aix.h), and here we just ignore the select error.
4365 Cleanup occurs c/o status_notify after SIGCLD. */
4366 no_avail
= 1; /* Cannot depend on values returned */
4372 error ("select error: %s", emacs_strerror (xerrno
));
4377 FD_ZERO (&Available
);
4381 #if defined(sun) && !defined(USG5_4)
4382 if (nfds
> 0 && keyboard_bit_set (&Available
)
4384 /* System sometimes fails to deliver SIGIO.
4386 David J. Mackenzie says that Emacs doesn't compile under
4387 Solaris if this code is enabled, thus the USG5_4 in the CPP
4388 conditional. "I haven't noticed any ill effects so far.
4389 If you find a Solaris expert somewhere, they might know
4391 kill (getpid (), SIGIO
);
4394 #if 0 /* When polling is used, interrupt_input is 0,
4395 so get_input_pending should read the input.
4396 So this should not be needed. */
4397 /* If we are using polling for input,
4398 and we see input available, make it get read now.
4399 Otherwise it might not actually get read for a second.
4400 And on hpux, since we turn off polling in wait_reading_process_input,
4401 it might never get read at all if we don't spend much time
4402 outside of wait_reading_process_input. */
4403 if (XINT (read_kbd
) && interrupt_input
4404 && keyboard_bit_set (&Available
)
4405 && input_polling_used ())
4406 kill (getpid (), SIGALRM
);
4409 /* Check for keyboard input */
4410 /* If there is any, return immediately
4411 to give it higher priority than subprocesses */
4413 if (XINT (read_kbd
) != 0)
4415 int old_timers_run
= timers_run
;
4416 struct buffer
*old_buffer
= current_buffer
;
4419 if (detect_input_pending_run_timers (do_display
))
4421 swallow_events (do_display
);
4422 if (detect_input_pending_run_timers (do_display
))
4426 /* If a timer has run, this might have changed buffers
4427 an alike. Make read_key_sequence aware of that. */
4428 if (timers_run
!= old_timers_run
4429 && waiting_for_user_input_p
== -1
4430 && old_buffer
!= current_buffer
)
4431 record_asynch_buffer_change ();
4437 /* If there is unread keyboard input, also return. */
4438 if (XINT (read_kbd
) != 0
4439 && requeued_events_pending_p ())
4442 /* If we are not checking for keyboard input now,
4443 do process events (but don't run any timers).
4444 This is so that X events will be processed.
4445 Otherwise they may have to wait until polling takes place.
4446 That would causes delays in pasting selections, for example.
4448 (We used to do this only if wait_for_cell.) */
4449 if (XINT (read_kbd
) == 0 && detect_input_pending ())
4451 swallow_events (do_display
);
4452 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4453 if (detect_input_pending ())
4458 /* Exit now if the cell we're waiting for became non-nil. */
4459 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4463 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4464 go read it. This can happen with X on BSD after logging out.
4465 In that case, there really is no input and no SIGIO,
4466 but select says there is input. */
4468 if (XINT (read_kbd
) && interrupt_input
4469 && keyboard_bit_set (&Available
) && ! noninteractive
)
4470 kill (getpid (), SIGIO
);
4474 got_some_input
|= nfds
> 0;
4476 /* If checking input just got us a size-change event from X,
4477 obey it now if we should. */
4478 if (XINT (read_kbd
) || ! NILP (wait_for_cell
))
4479 do_pending_window_change (0);
4481 /* Check for data from a process. */
4482 if (no_avail
|| nfds
== 0)
4485 /* Really FIRST_PROC_DESC should be 0 on Unix,
4486 but this is safer in the short run. */
4487 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4489 if (FD_ISSET (channel
, &Available
)
4490 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4494 /* If waiting for this channel, arrange to return as
4495 soon as no more input to be processed. No more
4497 if (wait_channel
== channel
)
4503 proc
= chan_process
[channel
];
4507 /* If this is a server stream socket, accept connection. */
4508 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4510 server_accept_connection (proc
, channel
);
4514 /* Read data from the process, starting with our
4515 buffered-ahead character if we have one. */
4517 nread
= read_process_output (proc
, channel
);
4520 /* Since read_process_output can run a filter,
4521 which can call accept-process-output,
4522 don't try to read from any other processes
4523 before doing the select again. */
4524 FD_ZERO (&Available
);
4527 redisplay_preserve_echo_area (12);
4530 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4533 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4534 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4536 else if (nread
== -1 && errno
== EAGAIN
)
4540 else if (nread
== -1 && errno
== EAGAIN
)
4542 /* Note that we cannot distinguish between no input
4543 available now and a closed pipe.
4544 With luck, a closed pipe will be accompanied by
4545 subprocess termination and SIGCHLD. */
4546 else if (nread
== 0 && !NETCONN_P (proc
))
4548 #endif /* O_NDELAY */
4549 #endif /* O_NONBLOCK */
4551 /* On some OSs with ptys, when the process on one end of
4552 a pty exits, the other end gets an error reading with
4553 errno = EIO instead of getting an EOF (0 bytes read).
4554 Therefore, if we get an error reading and errno =
4555 EIO, just continue, because the child process has
4556 exited and should clean itself up soon (e.g. when we
4559 However, it has been known to happen that the SIGCHLD
4560 got lost. So raise the signl again just in case.
4562 else if (nread
== -1 && errno
== EIO
)
4563 kill (getpid (), SIGCHLD
);
4564 #endif /* HAVE_PTYS */
4565 /* If we can detect process termination, don't consider the process
4566 gone just because its pipe is closed. */
4568 else if (nread
== 0 && !NETCONN_P (proc
))
4573 /* Preserve status of processes already terminated. */
4574 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4575 deactivate_process (proc
);
4576 if (!NILP (XPROCESS (proc
)->raw_status_low
))
4577 update_status (XPROCESS (proc
));
4578 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4579 XPROCESS (proc
)->status
4580 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4583 #ifdef NON_BLOCKING_CONNECT
4584 if (check_connect
&& FD_ISSET (channel
, &Connecting
))
4586 struct Lisp_Process
*p
;
4588 FD_CLR (channel
, &connect_wait_mask
);
4589 if (--num_pending_connects
< 0)
4592 proc
= chan_process
[channel
];
4596 p
= XPROCESS (proc
);
4599 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4600 So only use it on systems where it is known to work. */
4602 int xlen
= sizeof(xerrno
);
4603 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4608 struct sockaddr pname
;
4609 int pnamelen
= sizeof(pname
);
4611 /* If connection failed, getpeername will fail. */
4613 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4615 /* Obtain connect failure code through error slippage. */
4618 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4625 XSETINT (p
->tick
, ++process_tick
);
4626 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4627 deactivate_process (proc
);
4632 /* Execute the sentinel here. If we had relied on
4633 status_notify to do it later, it will read input
4634 from the process before calling the sentinel. */
4635 exec_sentinel (proc
, build_string ("open\n"));
4636 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4638 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4639 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4643 #endif /* NON_BLOCKING_CONNECT */
4644 } /* end for each file descriptor */
4645 } /* end while exit conditions not met */
4647 waiting_for_user_input_p
= 0;
4649 /* If calling from keyboard input, do not quit
4650 since we want to return C-g as an input character.
4651 Otherwise, do pending quit if requested. */
4652 if (XINT (read_kbd
) >= 0)
4654 /* Prevent input_pending from remaining set if we quit. */
4655 clear_input_pending ();
4658 #ifdef POLL_INTERRUPTED_SYS_CALL
4659 /* AlainF 5-Jul-1996
4660 HP-UX 10.10 seems to have problems with signals coming in
4661 Causes "poll: interrupted system call" messages when Emacs is run
4663 Turn periodic alarms back on */
4665 #endif /* POLL_INTERRUPTED_SYS_CALL */
4667 return got_some_input
;
4670 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4673 read_process_output_call (fun_and_args
)
4674 Lisp_Object fun_and_args
;
4676 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4680 read_process_output_error_handler (error
)
4683 cmd_error_internal (error
, "error in process filter: ");
4685 update_echo_area ();
4686 Fsleep_for (make_number (2), Qnil
);
4690 /* Read pending output from the process channel,
4691 starting with our buffered-ahead character if we have one.
4692 Yield number of decoded characters read.
4694 This function reads at most 1024 characters.
4695 If you want to read all available subprocess output,
4696 you must call it repeatedly until it returns zero.
4698 The characters read are decoded according to PROC's coding-system
4702 read_process_output (proc
, channel
)
4704 register int channel
;
4706 register int nbytes
;
4708 register Lisp_Object outstream
;
4709 register struct buffer
*old
= current_buffer
;
4710 register struct Lisp_Process
*p
= XPROCESS (proc
);
4711 register int opoint
;
4712 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4713 int carryover
= XINT (p
->decoding_carryover
);
4717 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4719 vs
= get_vms_process_pointer (p
->pid
);
4723 return (0); /* Really weird if it does this */
4724 if (!(vs
->iosb
[0] & 1))
4725 return -1; /* I/O error */
4728 error ("Could not get VMS process pointer");
4729 chars
= vs
->inputBuffer
;
4730 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4733 start_vms_process_read (vs
); /* Crank up the next read on the process */
4734 return 1; /* Nothing worth printing, say we got 1 */
4738 /* The data carried over in the previous decoding (which are at
4739 the tail of decoding buffer) should be prepended to the new
4740 data read to decode all together. */
4741 chars
= (char *) alloca (nbytes
+ carryover
);
4742 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4743 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4747 #ifdef DATAGRAM_SOCKETS
4748 /* A datagram is one packet; allow at least 1500+ bytes of data
4749 corresponding to the typical Ethernet frame size. */
4750 if (DATAGRAM_CHAN_P (channel
))
4752 /* carryover = 0; */ /* Does carryover make sense for datagrams? */
4757 chars
= (char *) alloca (carryover
+ readmax
);
4759 /* See the comment above. */
4760 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
4762 #ifdef DATAGRAM_SOCKETS
4763 /* We have a working select, so proc_buffered_char is always -1. */
4764 if (DATAGRAM_CHAN_P (channel
))
4766 int len
= datagram_address
[channel
].len
;
4767 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
- carryover
,
4768 0, datagram_address
[channel
].sa
, &len
);
4772 if (proc_buffered_char
[channel
] < 0)
4774 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
- carryover
);
4775 #ifdef ADAPTIVE_READ_BUFFERING
4776 if (!NILP (p
->adaptive_read_buffering
))
4778 int delay
= XINT (p
->read_output_delay
);
4781 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
4784 process_output_delay_count
++;
4785 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
4788 else if (delay
> 0 && (nbytes
== readmax
- carryover
))
4790 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
4792 process_output_delay_count
--;
4794 XSETINT (p
->read_output_delay
, delay
);
4797 p
->read_output_skip
= Qt
;
4798 process_output_skip
= 1;
4805 chars
[carryover
] = proc_buffered_char
[channel
];
4806 proc_buffered_char
[channel
] = -1;
4807 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1 - carryover
);
4811 nbytes
= nbytes
+ 1;
4813 #endif /* not VMS */
4815 XSETINT (p
->decoding_carryover
, 0);
4817 /* At this point, NBYTES holds number of bytes just received
4818 (including the one in proc_buffered_char[channel]). */
4821 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
4823 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4826 /* Now set NBYTES how many bytes we must decode. */
4827 nbytes
+= carryover
;
4829 /* Read and dispose of the process output. */
4830 outstream
= p
->filter
;
4831 if (!NILP (outstream
))
4833 /* We inhibit quit here instead of just catching it so that
4834 hitting ^G when a filter happens to be running won't screw
4836 int count
= SPECPDL_INDEX ();
4837 Lisp_Object odeactivate
;
4838 Lisp_Object obuffer
, okeymap
;
4840 int outer_running_asynch_code
= running_asynch_code
;
4841 int waiting
= waiting_for_user_input_p
;
4843 /* No need to gcpro these, because all we do with them later
4844 is test them for EQness, and none of them should be a string. */
4845 odeactivate
= Vdeactivate_mark
;
4846 XSETBUFFER (obuffer
, current_buffer
);
4847 okeymap
= current_buffer
->keymap
;
4849 specbind (Qinhibit_quit
, Qt
);
4850 specbind (Qlast_nonmenu_event
, Qt
);
4852 /* In case we get recursively called,
4853 and we already saved the match data nonrecursively,
4854 save the same match data in safely recursive fashion. */
4855 if (outer_running_asynch_code
)
4858 /* Don't clobber the CURRENT match data, either! */
4859 tem
= Fmatch_data (Qnil
, Qnil
);
4860 restore_match_data ();
4861 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
4862 Fset_match_data (tem
);
4865 /* For speed, if a search happens within this code,
4866 save the match data in a special nonrecursive fashion. */
4867 running_asynch_code
= 1;
4869 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
4870 text
= coding
->dst_object
;
4871 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
4872 /* A new coding system might be found. */
4873 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
4875 p
->decode_coding_system
= Vlast_coding_system_used
;
4877 /* Don't call setup_coding_system for
4878 proc_decode_coding_system[channel] here. It is done in
4879 detect_coding called via decode_coding above. */
4881 /* If a coding system for encoding is not yet decided, we set
4882 it as the same as coding-system for decoding.
4884 But, before doing that we must check if
4885 proc_encode_coding_system[p->outfd] surely points to a
4886 valid memory because p->outfd will be changed once EOF is
4887 sent to the process. */
4888 if (NILP (p
->encode_coding_system
)
4889 && proc_encode_coding_system
[XINT (p
->outfd
)])
4891 p
->encode_coding_system
= Vlast_coding_system_used
;
4892 setup_coding_system (p
->encode_coding_system
,
4893 proc_encode_coding_system
[XINT (p
->outfd
)]);
4897 if (coding
->carryover_bytes
> 0)
4899 bcopy (coding
->carryover
, SDATA (p
->decoding_buf
),
4900 coding
->carryover_bytes
);
4901 XSETINT (p
->decoding_carryover
, coding
->carryover_bytes
);
4903 /* Adjust the multibyteness of TEXT to that of the filter. */
4904 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
4905 text
= (STRING_MULTIBYTE (text
)
4906 ? Fstring_as_unibyte (text
)
4907 : Fstring_to_multibyte (text
));
4908 if (SBYTES (text
) > 0)
4909 internal_condition_case_1 (read_process_output_call
,
4911 Fcons (proc
, Fcons (text
, Qnil
))),
4912 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
4913 read_process_output_error_handler
);
4915 /* If we saved the match data nonrecursively, restore it now. */
4916 restore_match_data ();
4917 running_asynch_code
= outer_running_asynch_code
;
4919 /* Handling the process output should not deactivate the mark. */
4920 Vdeactivate_mark
= odeactivate
;
4922 /* Restore waiting_for_user_input_p as it was
4923 when we were called, in case the filter clobbered it. */
4924 waiting_for_user_input_p
= waiting
;
4926 #if 0 /* Call record_asynch_buffer_change unconditionally,
4927 because we might have changed minor modes or other things
4928 that affect key bindings. */
4929 if (! EQ (Fcurrent_buffer (), obuffer
)
4930 || ! EQ (current_buffer
->keymap
, okeymap
))
4932 /* But do it only if the caller is actually going to read events.
4933 Otherwise there's no need to make him wake up, and it could
4934 cause trouble (for example it would make Fsit_for return). */
4935 if (waiting_for_user_input_p
== -1)
4936 record_asynch_buffer_change ();
4939 start_vms_process_read (vs
);
4941 unbind_to (count
, Qnil
);
4945 /* If no filter, write into buffer if it isn't dead. */
4946 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
4948 Lisp_Object old_read_only
;
4949 int old_begv
, old_zv
;
4950 int old_begv_byte
, old_zv_byte
;
4951 Lisp_Object odeactivate
;
4952 int before
, before_byte
;
4957 odeactivate
= Vdeactivate_mark
;
4959 Fset_buffer (p
->buffer
);
4961 opoint_byte
= PT_BYTE
;
4962 old_read_only
= current_buffer
->read_only
;
4965 old_begv_byte
= BEGV_BYTE
;
4966 old_zv_byte
= ZV_BYTE
;
4968 current_buffer
->read_only
= Qnil
;
4970 /* Insert new output into buffer
4971 at the current end-of-output marker,
4972 thus preserving logical ordering of input and output. */
4973 if (XMARKER (p
->mark
)->buffer
)
4974 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
4975 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
4978 SET_PT_BOTH (ZV
, ZV_BYTE
);
4980 before_byte
= PT_BYTE
;
4982 /* If the output marker is outside of the visible region, save
4983 the restriction and widen. */
4984 if (! (BEGV
<= PT
&& PT
<= ZV
))
4987 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
4988 text
= coding
->dst_object
;
4989 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
4990 /* A new coding system might be found. See the comment in the
4991 similar code in the previous `if' block. */
4992 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
4994 p
->decode_coding_system
= Vlast_coding_system_used
;
4995 if (NILP (p
->encode_coding_system
)
4996 && proc_encode_coding_system
[XINT (p
->outfd
)])
4998 p
->encode_coding_system
= Vlast_coding_system_used
;
4999 setup_coding_system (p
->encode_coding_system
,
5000 proc_encode_coding_system
[XINT (p
->outfd
)]);
5003 if (coding
->carryover_bytes
> 0)
5005 bcopy (coding
->carryover
, SDATA (p
->decoding_buf
),
5006 coding
->carryover_bytes
);
5007 XSETINT (p
->decoding_carryover
, coding
->carryover_bytes
);
5009 /* Adjust the multibyteness of TEXT to that of the buffer. */
5010 if (NILP (current_buffer
->enable_multibyte_characters
)
5011 != ! STRING_MULTIBYTE (text
))
5012 text
= (STRING_MULTIBYTE (text
)
5013 ? Fstring_as_unibyte (text
)
5014 : Fstring_to_multibyte (text
));
5015 /* Insert before markers in case we are inserting where
5016 the buffer's mark is, and the user's next command is Meta-y. */
5017 insert_from_string_before_markers (text
, 0, 0,
5018 SCHARS (text
), SBYTES (text
), 0);
5020 /* Make sure the process marker's position is valid when the
5021 process buffer is changed in the signal_after_change above.
5022 W3 is known to do that. */
5023 if (BUFFERP (p
->buffer
)
5024 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5025 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5027 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5029 update_mode_lines
++;
5031 /* Make sure opoint and the old restrictions
5032 float ahead of any new text just as point would. */
5033 if (opoint
>= before
)
5035 opoint
+= PT
- before
;
5036 opoint_byte
+= PT_BYTE
- before_byte
;
5038 if (old_begv
> before
)
5040 old_begv
+= PT
- before
;
5041 old_begv_byte
+= PT_BYTE
- before_byte
;
5043 if (old_zv
>= before
)
5045 old_zv
+= PT
- before
;
5046 old_zv_byte
+= PT_BYTE
- before_byte
;
5049 /* If the restriction isn't what it should be, set it. */
5050 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5051 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5053 /* Handling the process output should not deactivate the mark. */
5054 Vdeactivate_mark
= odeactivate
;
5056 current_buffer
->read_only
= old_read_only
;
5057 SET_PT_BOTH (opoint
, opoint_byte
);
5058 set_buffer_internal (old
);
5061 start_vms_process_read (vs
);
5066 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5068 doc
: /* Returns non-nil if emacs is waiting for input from the user.
5069 This is intended for use by asynchronous process output filters and sentinels. */)
5072 return (waiting_for_user_input_p
? Qt
: Qnil
);
5075 /* Sending data to subprocess */
5077 jmp_buf send_process_frame
;
5078 Lisp_Object process_sent_to
;
5081 send_process_trap ()
5087 longjmp (send_process_frame
, 1);
5090 /* Send some data to process PROC.
5091 BUF is the beginning of the data; LEN is the number of characters.
5092 OBJECT is the Lisp object that the data comes from. If OBJECT is
5093 nil or t, it means that the data comes from C string.
5095 If OBJECT is not nil, the data is encoded by PROC's coding-system
5096 for encoding before it is sent.
5098 This function can evaluate Lisp code and can garbage collect. */
5101 send_process (proc
, buf
, len
, object
)
5102 volatile Lisp_Object proc
;
5103 unsigned char *volatile buf
;
5105 volatile Lisp_Object object
;
5107 /* Use volatile to protect variables from being clobbered by longjmp. */
5108 struct Lisp_Process
*p
= XPROCESS (proc
);
5110 struct coding_system
*coding
;
5111 struct gcpro gcpro1
;
5116 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5119 if (! NILP (p
->raw_status_low
))
5121 if (! EQ (p
->status
, Qrun
))
5122 error ("Process %s not running", SDATA (p
->name
));
5123 if (XINT (p
->outfd
) < 0)
5124 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5126 coding
= proc_encode_coding_system
[XINT (p
->outfd
)];
5127 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5129 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5130 || (BUFFERP (object
)
5131 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5134 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
5135 /* The coding system for encoding was changed to raw-text
5136 because we sent a unibyte text previously. Now we are
5137 sending a multibyte text, thus we must encode it by the
5138 original coding system specified for the current process. */
5139 setup_coding_system (p
->encode_coding_system
, coding
);
5140 coding
->src_multibyte
= 1;
5144 /* For sending a unibyte text, character code conversion should
5145 not take place but EOL conversion should. So, setup raw-text
5146 or one of the subsidiary if we have not yet done it. */
5147 if (CODING_REQUIRE_ENCODING (coding
))
5149 if (CODING_REQUIRE_FLUSHING (coding
))
5151 /* But, before changing the coding, we must flush out data. */
5152 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5153 send_process (proc
, "", 0, Qt
);
5154 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
5156 setup_coding_system (raw_text_coding_system
5157 (Vlast_coding_system_used
),
5159 coding
->src_multibyte
= 0;
5162 coding
->dst_multibyte
= 0;
5164 if (CODING_REQUIRE_ENCODING (coding
))
5166 coding
->dst_object
= Qt
;
5167 if (BUFFERP (object
))
5169 int from_byte
, from
, to
;
5170 int save_pt
, save_pt_byte
;
5171 struct buffer
*cur
= current_buffer
;
5173 set_buffer_internal (XBUFFER (object
));
5174 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
5176 from_byte
= PTR_BYTE_POS (buf
);
5177 from
= BYTE_TO_CHAR (from_byte
);
5178 to
= BYTE_TO_CHAR (from_byte
+ len
);
5179 TEMP_SET_PT_BOTH (from
, from_byte
);
5180 encode_coding_object (coding
, object
, from
, from_byte
,
5181 to
, from_byte
+ len
, Qt
);
5182 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
5183 set_buffer_internal (cur
);
5185 else if (STRINGP (object
))
5187 encode_coding_string (coding
, object
, 1);
5191 coding
->dst_object
= make_unibyte_string (buf
, len
);
5192 coding
->produced
= len
;
5195 len
= coding
->produced
;
5196 buf
= SDATA (coding
->dst_object
);
5200 vs
= get_vms_process_pointer (p
->pid
);
5202 error ("Could not find this process: %x", p
->pid
);
5203 else if (write_to_vms_process (vs
, buf
, len
))
5207 if (pty_max_bytes
== 0)
5209 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5210 pty_max_bytes
= fpathconf (XFASTINT (p
->outfd
), _PC_MAX_CANON
);
5211 if (pty_max_bytes
< 0)
5212 pty_max_bytes
= 250;
5214 pty_max_bytes
= 250;
5216 /* Deduct one, to leave space for the eof. */
5220 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5221 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5222 when returning with longjmp despite being declared volatile. */
5223 if (!setjmp (send_process_frame
))
5225 process_sent_to
= proc
;
5229 SIGTYPE (*old_sigpipe
)();
5231 /* Decide how much data we can send in one batch.
5232 Long lines need to be split into multiple batches. */
5233 if (!NILP (p
->pty_flag
))
5235 /* Starting this at zero is always correct when not the first
5236 iteration because the previous iteration ended by sending C-d.
5237 It may not be correct for the first iteration
5238 if a partial line was sent in a separate send_process call.
5239 If that proves worth handling, we need to save linepos
5240 in the process object. */
5242 unsigned char *ptr
= (unsigned char *) buf
;
5243 unsigned char *end
= (unsigned char *) buf
+ len
;
5245 /* Scan through this text for a line that is too long. */
5246 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5254 /* If we found one, break the line there
5255 and put in a C-d to force the buffer through. */
5259 /* Send this batch, using one or more write calls. */
5262 int outfd
= XINT (p
->outfd
);
5263 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5264 #ifdef DATAGRAM_SOCKETS
5265 if (DATAGRAM_CHAN_P (outfd
))
5267 rv
= sendto (outfd
, (char *) buf
, this,
5268 0, datagram_address
[outfd
].sa
,
5269 datagram_address
[outfd
].len
);
5270 if (rv
< 0 && errno
== EMSGSIZE
)
5271 report_file_error ("sending datagram", Fcons (proc
, Qnil
));
5276 rv
= emacs_write (outfd
, (char *) buf
, this);
5277 #ifdef ADAPTIVE_READ_BUFFERING
5278 if (XINT (p
->read_output_delay
) > 0
5279 && EQ (p
->adaptive_read_buffering
, Qt
))
5281 XSETFASTINT (p
->read_output_delay
, 0);
5282 process_output_delay_count
--;
5283 p
->read_output_skip
= Qnil
;
5287 signal (SIGPIPE
, old_sigpipe
);
5293 || errno
== EWOULDBLOCK
5299 /* Buffer is full. Wait, accepting input;
5300 that may allow the program
5301 to finish doing output and read more. */
5306 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5307 /* A gross hack to work around a bug in FreeBSD.
5308 In the following sequence, read(2) returns
5312 write(2) 954 bytes, get EAGAIN
5313 read(2) 1024 bytes in process_read_output
5314 read(2) 11 bytes in process_read_output
5316 That is, read(2) returns more bytes than have
5317 ever been written successfully. The 1033 bytes
5318 read are the 1022 bytes written successfully
5319 after processing (for example with CRs added if
5320 the terminal is set up that way which it is
5321 here). The same bytes will be seen again in a
5322 later read(2), without the CRs. */
5324 if (errno
== EAGAIN
)
5327 ioctl (XINT (p
->outfd
), TIOCFLUSH
, &flags
);
5329 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5331 /* Running filters might relocate buffers or strings.
5332 Arrange to relocate BUF. */
5333 if (BUFFERP (object
))
5334 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5335 else if (STRINGP (object
))
5336 offset
= buf
- SDATA (object
);
5338 XSETFASTINT (zero
, 0);
5339 #ifdef EMACS_HAS_USECS
5340 wait_reading_process_input (0, 20000, zero
, 0);
5342 wait_reading_process_input (1, 0, zero
, 0);
5345 if (BUFFERP (object
))
5346 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5347 else if (STRINGP (object
))
5348 buf
= offset
+ SDATA (object
);
5353 /* This is a real error. */
5354 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5361 /* If we sent just part of the string, put in an EOF
5362 to force it through, before we send the rest. */
5364 Fprocess_send_eof (proc
);
5367 #endif /* not VMS */
5371 proc
= process_sent_to
;
5372 p
= XPROCESS (proc
);
5374 p
->raw_status_low
= Qnil
;
5375 p
->raw_status_high
= Qnil
;
5376 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5377 XSETINT (p
->tick
, ++process_tick
);
5378 deactivate_process (proc
);
5380 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5382 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5389 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5391 doc
: /* Send current contents of region as input to PROCESS.
5392 PROCESS may be a process, a buffer, the name of a process or buffer, or
5393 nil, indicating the current buffer's process.
5394 Called from program, takes three arguments, PROCESS, START and END.
5395 If the region is more than 500 characters long,
5396 it is sent in several bunches. This may happen even for shorter regions.
5397 Output from processes can arrive in between bunches. */)
5398 (process
, start
, end
)
5399 Lisp_Object process
, start
, end
;
5404 proc
= get_process (process
);
5405 validate_region (&start
, &end
);
5407 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5408 move_gap (XINT (start
));
5410 start1
= CHAR_TO_BYTE (XINT (start
));
5411 end1
= CHAR_TO_BYTE (XINT (end
));
5412 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5413 Fcurrent_buffer ());
5418 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5420 doc
: /* Send PROCESS the contents of STRING as input.
5421 PROCESS may be a process, a buffer, the name of a process or buffer, or
5422 nil, indicating the current buffer's process.
5423 If STRING is more than 500 characters long,
5424 it is sent in several bunches. This may happen even for shorter strings.
5425 Output from processes can arrive in between bunches. */)
5427 Lisp_Object process
, string
;
5430 CHECK_STRING (string
);
5431 proc
= get_process (process
);
5432 send_process (proc
, SDATA (string
),
5433 SBYTES (string
), string
);
5437 /* Return the foreground process group for the tty/pty that
5438 the process P uses. */
5440 emacs_get_tty_pgrp (p
)
5441 struct Lisp_Process
*p
;
5446 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5449 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5450 master side. Try the slave side. */
5451 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5455 ioctl (fd
, TIOCGPGRP
, &gid
);
5459 #endif /* defined (TIOCGPGRP ) */
5464 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5465 Sprocess_running_child_p
, 0, 1, 0,
5466 doc
: /* Return t if PROCESS has given the terminal to a child.
5467 If the operating system does not make it possible to find out,
5468 return t unconditionally. */)
5470 Lisp_Object process
;
5472 /* Initialize in case ioctl doesn't exist or gives an error,
5473 in a way that will cause returning t. */
5476 struct Lisp_Process
*p
;
5478 proc
= get_process (process
);
5479 p
= XPROCESS (proc
);
5481 if (!EQ (p
->childp
, Qt
))
5482 error ("Process %s is not a subprocess",
5484 if (XINT (p
->infd
) < 0)
5485 error ("Process %s is not active",
5488 gid
= emacs_get_tty_pgrp (p
);
5490 if (gid
== XFASTINT (p
->pid
))
5495 /* send a signal number SIGNO to PROCESS.
5496 If CURRENT_GROUP is t, that means send to the process group
5497 that currently owns the terminal being used to communicate with PROCESS.
5498 This is used for various commands in shell mode.
5499 If CURRENT_GROUP is lambda, that means send to the process group
5500 that currently owns the terminal, but only if it is NOT the shell itself.
5502 If NOMSG is zero, insert signal-announcements into process's buffers
5505 If we can, we try to signal PROCESS by sending control characters
5506 down the pty. This allows us to signal inferiors who have changed
5507 their uid, for which killpg would return an EPERM error. */
5510 process_send_signal (process
, signo
, current_group
, nomsg
)
5511 Lisp_Object process
;
5513 Lisp_Object current_group
;
5517 register struct Lisp_Process
*p
;
5521 proc
= get_process (process
);
5522 p
= XPROCESS (proc
);
5524 if (!EQ (p
->childp
, Qt
))
5525 error ("Process %s is not a subprocess",
5527 if (XINT (p
->infd
) < 0)
5528 error ("Process %s is not active",
5531 if (NILP (p
->pty_flag
))
5532 current_group
= Qnil
;
5534 /* If we are using pgrps, get a pgrp number and make it negative. */
5535 if (NILP (current_group
))
5536 /* Send the signal to the shell's process group. */
5537 gid
= XFASTINT (p
->pid
);
5540 #ifdef SIGNALS_VIA_CHARACTERS
5541 /* If possible, send signals to the entire pgrp
5542 by sending an input character to it. */
5544 /* TERMIOS is the latest and bestest, and seems most likely to
5545 work. If the system has it, use it. */
5552 tcgetattr (XINT (p
->infd
), &t
);
5553 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5557 tcgetattr (XINT (p
->infd
), &t
);
5558 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5562 tcgetattr (XINT (p
->infd
), &t
);
5563 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5564 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5566 send_process (proc
, &t
.c_cc
[VSUSP
], 1, Qnil
);
5571 #else /* ! HAVE_TERMIOS */
5573 /* On Berkeley descendants, the following IOCTL's retrieve the
5574 current control characters. */
5575 #if defined (TIOCGLTC) && defined (TIOCGETC)
5583 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5584 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5587 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5588 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5592 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5593 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5595 #endif /* ! defined (SIGTSTP) */
5598 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5600 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5607 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5608 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5611 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5612 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5616 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5617 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5619 #endif /* ! defined (SIGTSTP) */
5621 #else /* ! defined (TCGETA) */
5622 Your configuration files are messed up
.
5623 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5624 you'd better be using one of the alternatives above! */
5625 #endif /* ! defined (TCGETA) */
5626 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5627 #endif /* ! defined HAVE_TERMIOS */
5629 /* The code above always returns from the function. */
5630 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5633 /* Get the current pgrp using the tty itself, if we have that.
5634 Otherwise, use the pty to get the pgrp.
5635 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5636 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5637 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5638 His patch indicates that if TIOCGPGRP returns an error, then
5639 we should just assume that p->pid is also the process group id. */
5641 gid
= emacs_get_tty_pgrp (p
);
5644 /* If we can't get the information, assume
5645 the shell owns the tty. */
5646 gid
= XFASTINT (p
->pid
);
5648 /* It is not clear whether anything really can set GID to -1.
5649 Perhaps on some system one of those ioctls can or could do so.
5650 Or perhaps this is vestigial. */
5653 #else /* ! defined (TIOCGPGRP ) */
5654 /* Can't select pgrps on this system, so we know that
5655 the child itself heads the pgrp. */
5656 gid
= XFASTINT (p
->pid
);
5657 #endif /* ! defined (TIOCGPGRP ) */
5659 /* If current_group is lambda, and the shell owns the terminal,
5660 don't send any signal. */
5661 if (EQ (current_group
, Qlambda
) && gid
== XFASTINT (p
->pid
))
5669 p
->raw_status_low
= Qnil
;
5670 p
->raw_status_high
= Qnil
;
5672 XSETINT (p
->tick
, ++process_tick
);
5676 #endif /* ! defined (SIGCONT) */
5679 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5684 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5689 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
5692 flush_pending_output (XINT (p
->infd
));
5696 /* If we don't have process groups, send the signal to the immediate
5697 subprocess. That isn't really right, but it's better than any
5698 obvious alternative. */
5701 kill (XFASTINT (p
->pid
), signo
);
5705 /* gid may be a pid, or minus a pgrp's number */
5707 if (!NILP (current_group
))
5709 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
5710 EMACS_KILLPG (gid
, signo
);
5714 gid
= - XFASTINT (p
->pid
);
5717 #else /* ! defined (TIOCSIGSEND) */
5718 EMACS_KILLPG (gid
, signo
);
5719 #endif /* ! defined (TIOCSIGSEND) */
5722 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5723 doc
: /* Interrupt process PROCESS.
5724 PROCESS may be a process, a buffer, or the name of a process or buffer.
5725 nil or no arg means current buffer's process.
5726 Second arg CURRENT-GROUP non-nil means send signal to
5727 the current process-group of the process's controlling terminal
5728 rather than to the process's own process group.
5729 If the process is a shell, this means interrupt current subjob
5730 rather than the shell.
5732 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5733 don't send the signal. */)
5734 (process
, current_group
)
5735 Lisp_Object process
, current_group
;
5737 process_send_signal (process
, SIGINT
, current_group
, 0);
5741 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5742 doc
: /* Kill process PROCESS. May be process or name of one.
5743 See function `interrupt-process' for more details on usage. */)
5744 (process
, current_group
)
5745 Lisp_Object process
, current_group
;
5747 process_send_signal (process
, SIGKILL
, current_group
, 0);
5751 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5752 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5753 See function `interrupt-process' for more details on usage. */)
5754 (process
, current_group
)
5755 Lisp_Object process
, current_group
;
5757 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5761 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5762 doc
: /* Stop process PROCESS. May be process or name of one.
5763 See function `interrupt-process' for more details on usage.
5764 If PROCESS is a network process, inhibit handling of incoming traffic. */)
5765 (process
, current_group
)
5766 Lisp_Object process
, current_group
;
5769 if (PROCESSP (process
) && NETCONN_P (process
))
5771 struct Lisp_Process
*p
;
5773 p
= XPROCESS (process
);
5774 if (NILP (p
->command
)
5775 && XINT (p
->infd
) >= 0)
5777 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5778 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5785 error ("no SIGTSTP support");
5787 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5792 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5793 doc
: /* Continue process PROCESS. May be process or name of one.
5794 See function `interrupt-process' for more details on usage.
5795 If PROCESS is a network process, resume handling of incoming traffic. */)
5796 (process
, current_group
)
5797 Lisp_Object process
, current_group
;
5800 if (PROCESSP (process
) && NETCONN_P (process
))
5802 struct Lisp_Process
*p
;
5804 p
= XPROCESS (process
);
5805 if (EQ (p
->command
, Qt
)
5806 && XINT (p
->infd
) >= 0
5807 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
5809 FD_SET (XINT (p
->infd
), &input_wait_mask
);
5810 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
5817 process_send_signal (process
, SIGCONT
, current_group
, 0);
5819 error ("no SIGCONT support");
5824 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
5825 2, 2, "sProcess (name or number): \nnSignal code: ",
5826 doc
: /* Send PROCESS the signal with code SIGCODE.
5827 PROCESS may also be an integer specifying the process id of the
5828 process to signal; in this case, the process need not be a child of
5830 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
5832 Lisp_Object process
, sigcode
;
5836 if (INTEGERP (process
))
5842 if (STRINGP (process
))
5845 if (tem
= Fget_process (process
), NILP (tem
))
5847 pid
= Fstring_to_number (process
, make_number (10));
5848 if (XINT (pid
) != 0)
5854 process
= get_process (process
);
5859 CHECK_PROCESS (process
);
5860 pid
= XPROCESS (process
)->pid
;
5861 if (!INTEGERP (pid
) || XINT (pid
) <= 0)
5862 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
5866 #define handle_signal(NAME, VALUE) \
5867 else if (!strcmp (name, NAME)) \
5868 XSETINT (sigcode, VALUE)
5870 if (INTEGERP (sigcode
))
5874 unsigned char *name
;
5876 CHECK_SYMBOL (sigcode
);
5877 name
= SDATA (SYMBOL_NAME (sigcode
));
5882 handle_signal ("SIGHUP", SIGHUP
);
5885 handle_signal ("SIGINT", SIGINT
);
5888 handle_signal ("SIGQUIT", SIGQUIT
);
5891 handle_signal ("SIGILL", SIGILL
);
5894 handle_signal ("SIGABRT", SIGABRT
);
5897 handle_signal ("SIGEMT", SIGEMT
);
5900 handle_signal ("SIGKILL", SIGKILL
);
5903 handle_signal ("SIGFPE", SIGFPE
);
5906 handle_signal ("SIGBUS", SIGBUS
);
5909 handle_signal ("SIGSEGV", SIGSEGV
);
5912 handle_signal ("SIGSYS", SIGSYS
);
5915 handle_signal ("SIGPIPE", SIGPIPE
);
5918 handle_signal ("SIGALRM", SIGALRM
);
5921 handle_signal ("SIGTERM", SIGTERM
);
5924 handle_signal ("SIGURG", SIGURG
);
5927 handle_signal ("SIGSTOP", SIGSTOP
);
5930 handle_signal ("SIGTSTP", SIGTSTP
);
5933 handle_signal ("SIGCONT", SIGCONT
);
5936 handle_signal ("SIGCHLD", SIGCHLD
);
5939 handle_signal ("SIGTTIN", SIGTTIN
);
5942 handle_signal ("SIGTTOU", SIGTTOU
);
5945 handle_signal ("SIGIO", SIGIO
);
5948 handle_signal ("SIGXCPU", SIGXCPU
);
5951 handle_signal ("SIGXFSZ", SIGXFSZ
);
5954 handle_signal ("SIGVTALRM", SIGVTALRM
);
5957 handle_signal ("SIGPROF", SIGPROF
);
5960 handle_signal ("SIGWINCH", SIGWINCH
);
5963 handle_signal ("SIGINFO", SIGINFO
);
5966 handle_signal ("SIGUSR1", SIGUSR1
);
5969 handle_signal ("SIGUSR2", SIGUSR2
);
5972 error ("Undefined signal name %s", name
);
5975 #undef handle_signal
5977 return make_number (kill (XINT (pid
), XINT (sigcode
)));
5980 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
5981 doc
: /* Make PROCESS see end-of-file in its input.
5982 EOF comes after any text already sent to it.
5983 PROCESS may be a process, a buffer, the name of a process or buffer, or
5984 nil, indicating the current buffer's process.
5985 If PROCESS is a network connection, or is a process communicating
5986 through a pipe (as opposed to a pty), then you cannot send any more
5987 text to PROCESS after you call this function. */)
5989 Lisp_Object process
;
5992 struct coding_system
*coding
;
5994 if (DATAGRAM_CONN_P (process
))
5997 proc
= get_process (process
);
5998 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
6000 /* Make sure the process is really alive. */
6001 if (! NILP (XPROCESS (proc
)->raw_status_low
))
6002 update_status (XPROCESS (proc
));
6003 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6004 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6006 if (CODING_REQUIRE_FLUSHING (coding
))
6008 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6009 send_process (proc
, "", 0, Qnil
);
6013 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6015 if (!NILP (XPROCESS (proc
)->pty_flag
))
6016 send_process (proc
, "\004", 1, Qnil
);
6019 int old_outfd
, new_outfd
;
6021 #ifdef HAVE_SHUTDOWN
6022 /* If this is a network connection, or socketpair is used
6023 for communication with the subprocess, call shutdown to cause EOF.
6024 (In some old system, shutdown to socketpair doesn't work.
6025 Then we just can't win.) */
6026 if (NILP (XPROCESS (proc
)->pid
)
6027 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
6028 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
6029 /* In case of socketpair, outfd == infd, so don't close it. */
6030 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
6031 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6032 #else /* not HAVE_SHUTDOWN */
6033 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6034 #endif /* not HAVE_SHUTDOWN */
6035 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6036 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
6038 if (!proc_encode_coding_system
[new_outfd
])
6039 proc_encode_coding_system
[new_outfd
]
6040 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6041 bcopy (proc_encode_coding_system
[old_outfd
],
6042 proc_encode_coding_system
[new_outfd
],
6043 sizeof (struct coding_system
));
6044 bzero (proc_encode_coding_system
[old_outfd
],
6045 sizeof (struct coding_system
));
6047 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
6053 /* Kill all processes associated with `buffer'.
6054 If `buffer' is nil, kill all processes */
6057 kill_buffer_processes (buffer
)
6060 Lisp_Object tail
, proc
;
6062 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6064 proc
= XCDR (XCAR (tail
));
6065 if (GC_PROCESSP (proc
)
6066 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6068 if (NETCONN_P (proc
))
6069 Fdelete_process (proc
);
6070 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
6071 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6076 /* On receipt of a signal that a child status has changed, loop asking
6077 about children with changed statuses until the system says there
6080 All we do is change the status; we do not run sentinels or print
6081 notifications. That is saved for the next time keyboard input is
6082 done, in order to avoid timing errors.
6084 ** WARNING: this can be called during garbage collection.
6085 Therefore, it must not be fooled by the presence of mark bits in
6088 ** USG WARNING: Although it is not obvious from the documentation
6089 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6090 signal() before executing at least one wait(), otherwise the
6091 handler will be called again, resulting in an infinite loop. The
6092 relevant portion of the documentation reads "SIGCLD signals will be
6093 queued and the signal-catching function will be continually
6094 reentered until the queue is empty". Invoking signal() causes the
6095 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6098 ** Malloc WARNING: This should never call malloc either directly or
6099 indirectly; if it does, that is a bug */
6102 sigchld_handler (signo
)
6105 int old_errno
= errno
;
6107 register struct Lisp_Process
*p
;
6108 extern EMACS_TIME
*input_available_clear_time
;
6112 sigheld
|= sigbit (SIGCHLD
);
6124 #endif /* no WUNTRACED */
6125 /* Keep trying to get a status until we get a definitive result. */
6129 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6131 while (pid
< 0 && errno
== EINTR
);
6135 /* PID == 0 means no processes found, PID == -1 means a real
6136 failure. We have done all our job, so return. */
6138 /* USG systems forget handlers when they are used;
6139 must reestablish each time */
6140 #if defined (USG) && !defined (POSIX_SIGNALS)
6141 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6144 sigheld
&= ~sigbit (SIGCHLD
);
6152 #endif /* no WNOHANG */
6154 /* Find the process that signaled us, and record its status. */
6157 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6159 proc
= XCDR (XCAR (tail
));
6160 p
= XPROCESS (proc
);
6161 if (GC_EQ (p
->childp
, Qt
) && XINT (p
->pid
) == pid
)
6166 /* Look for an asynchronous process whose pid hasn't been filled
6169 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6171 proc
= XCDR (XCAR (tail
));
6172 p
= XPROCESS (proc
);
6173 if (GC_INTEGERP (p
->pid
) && XINT (p
->pid
) == -1)
6178 /* Change the status of the process that was found. */
6181 union { int i
; WAITTYPE wt
; } u
;
6182 int clear_desc_flag
= 0;
6184 XSETINT (p
->tick
, ++process_tick
);
6186 XSETINT (p
->raw_status_low
, u
.i
& 0xffff);
6187 XSETINT (p
->raw_status_high
, u
.i
>> 16);
6189 /* If process has terminated, stop waiting for its output. */
6190 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6191 && XINT (p
->infd
) >= 0)
6192 clear_desc_flag
= 1;
6194 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6195 if (clear_desc_flag
)
6197 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6198 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6201 /* Tell wait_reading_process_input that it needs to wake up and
6203 if (input_available_clear_time
)
6204 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6207 /* There was no asynchronous process found for that id. Check
6208 if we have a synchronous process. */
6211 synch_process_alive
= 0;
6213 /* Report the status of the synchronous process. */
6215 synch_process_retcode
= WRETCODE (w
);
6216 else if (WIFSIGNALED (w
))
6217 synch_process_termsig
= WTERMSIG (w
);
6219 /* Tell wait_reading_process_input that it needs to wake up and
6221 if (input_available_clear_time
)
6222 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6225 /* On some systems, we must return right away.
6226 If any more processes want to signal us, we will
6228 Otherwise (on systems that have WNOHANG), loop around
6229 to use up all the processes that have something to tell us. */
6230 #if (defined WINDOWSNT \
6231 || (defined USG && !defined GNU_LINUX \
6232 && !(defined HPUX && defined WNOHANG)))
6233 #if defined (USG) && ! defined (POSIX_SIGNALS)
6234 signal (signo
, sigchld_handler
);
6238 #endif /* USG, but not HPUX with WNOHANG */
6244 exec_sentinel_unwind (data
)
6247 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6252 exec_sentinel_error_handler (error
)
6255 cmd_error_internal (error
, "error in process sentinel: ");
6257 update_echo_area ();
6258 Fsleep_for (make_number (2), Qnil
);
6263 exec_sentinel (proc
, reason
)
6264 Lisp_Object proc
, reason
;
6266 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6267 register struct Lisp_Process
*p
= XPROCESS (proc
);
6268 int count
= SPECPDL_INDEX ();
6269 int outer_running_asynch_code
= running_asynch_code
;
6270 int waiting
= waiting_for_user_input_p
;
6272 /* No need to gcpro these, because all we do with them later
6273 is test them for EQness, and none of them should be a string. */
6274 odeactivate
= Vdeactivate_mark
;
6275 XSETBUFFER (obuffer
, current_buffer
);
6276 okeymap
= current_buffer
->keymap
;
6278 sentinel
= p
->sentinel
;
6279 if (NILP (sentinel
))
6282 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6283 assure that it gets restored no matter how the sentinel exits. */
6285 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6286 /* Inhibit quit so that random quits don't screw up a running filter. */
6287 specbind (Qinhibit_quit
, Qt
);
6288 specbind (Qlast_nonmenu_event
, Qt
);
6290 /* In case we get recursively called,
6291 and we already saved the match data nonrecursively,
6292 save the same match data in safely recursive fashion. */
6293 if (outer_running_asynch_code
)
6296 tem
= Fmatch_data (Qnil
, Qnil
);
6297 restore_match_data ();
6298 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
6299 Fset_match_data (tem
);
6302 /* For speed, if a search happens within this code,
6303 save the match data in a special nonrecursive fashion. */
6304 running_asynch_code
= 1;
6306 internal_condition_case_1 (read_process_output_call
,
6308 Fcons (proc
, Fcons (reason
, Qnil
))),
6309 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6310 exec_sentinel_error_handler
);
6312 /* If we saved the match data nonrecursively, restore it now. */
6313 restore_match_data ();
6314 running_asynch_code
= outer_running_asynch_code
;
6316 Vdeactivate_mark
= odeactivate
;
6318 /* Restore waiting_for_user_input_p as it was
6319 when we were called, in case the filter clobbered it. */
6320 waiting_for_user_input_p
= waiting
;
6323 if (! EQ (Fcurrent_buffer (), obuffer
)
6324 || ! EQ (current_buffer
->keymap
, okeymap
))
6326 /* But do it only if the caller is actually going to read events.
6327 Otherwise there's no need to make him wake up, and it could
6328 cause trouble (for example it would make Fsit_for return). */
6329 if (waiting_for_user_input_p
== -1)
6330 record_asynch_buffer_change ();
6332 unbind_to (count
, Qnil
);
6335 /* Report all recent events of a change in process status
6336 (either run the sentinel or output a message).
6337 This is usually done while Emacs is waiting for keyboard input
6338 but can be done at other times. */
6343 register Lisp_Object proc
, buffer
;
6344 Lisp_Object tail
, msg
;
6345 struct gcpro gcpro1
, gcpro2
;
6349 /* We need to gcpro tail; if read_process_output calls a filter
6350 which deletes a process and removes the cons to which tail points
6351 from Vprocess_alist, and then causes a GC, tail is an unprotected
6355 /* Set this now, so that if new processes are created by sentinels
6356 that we run, we get called again to handle their status changes. */
6357 update_tick
= process_tick
;
6359 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6362 register struct Lisp_Process
*p
;
6364 proc
= Fcdr (Fcar (tail
));
6365 p
= XPROCESS (proc
);
6367 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6369 XSETINT (p
->update_tick
, XINT (p
->tick
));
6371 /* If process is still active, read any output that remains. */
6372 while (! EQ (p
->filter
, Qt
)
6373 && ! EQ (p
->status
, Qconnect
)
6374 && ! EQ (p
->status
, Qlisten
)
6375 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6376 && XINT (p
->infd
) >= 0
6377 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6381 /* Get the text to use for the message. */
6382 if (!NILP (p
->raw_status_low
))
6384 msg
= status_message (p
->status
);
6386 /* If process is terminated, deactivate it or delete it. */
6388 if (CONSP (p
->status
))
6389 symbol
= XCAR (p
->status
);
6391 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6392 || EQ (symbol
, Qclosed
))
6394 if (delete_exited_processes
)
6395 remove_process (proc
);
6397 deactivate_process (proc
);
6400 /* The actions above may have further incremented p->tick.
6401 So set p->update_tick again
6402 so that an error in the sentinel will not cause
6403 this code to be run again. */
6404 XSETINT (p
->update_tick
, XINT (p
->tick
));
6405 /* Now output the message suitably. */
6406 if (!NILP (p
->sentinel
))
6407 exec_sentinel (proc
, msg
);
6408 /* Don't bother with a message in the buffer
6409 when a process becomes runnable. */
6410 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6412 Lisp_Object ro
, tem
;
6413 struct buffer
*old
= current_buffer
;
6414 int opoint
, opoint_byte
;
6415 int before
, before_byte
;
6417 ro
= XBUFFER (buffer
)->read_only
;
6419 /* Avoid error if buffer is deleted
6420 (probably that's why the process is dead, too) */
6421 if (NILP (XBUFFER (buffer
)->name
))
6423 Fset_buffer (buffer
);
6426 opoint_byte
= PT_BYTE
;
6427 /* Insert new output into buffer
6428 at the current end-of-output marker,
6429 thus preserving logical ordering of input and output. */
6430 if (XMARKER (p
->mark
)->buffer
)
6431 Fgoto_char (p
->mark
);
6433 SET_PT_BOTH (ZV
, ZV_BYTE
);
6436 before_byte
= PT_BYTE
;
6438 tem
= current_buffer
->read_only
;
6439 current_buffer
->read_only
= Qnil
;
6440 insert_string ("\nProcess ");
6441 Finsert (1, &p
->name
);
6442 insert_string (" ");
6444 current_buffer
->read_only
= tem
;
6445 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6447 if (opoint
>= before
)
6448 SET_PT_BOTH (opoint
+ (PT
- before
),
6449 opoint_byte
+ (PT_BYTE
- before_byte
));
6451 SET_PT_BOTH (opoint
, opoint_byte
);
6453 set_buffer_internal (old
);
6458 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6459 redisplay_preserve_echo_area (13);
6465 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6466 Sset_process_coding_system
, 1, 3, 0,
6467 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6468 DECODING will be used to decode subprocess output and ENCODING to
6469 encode subprocess input. */)
6470 (proc
, decoding
, encoding
)
6471 register Lisp_Object proc
, decoding
, encoding
;
6473 register struct Lisp_Process
*p
;
6475 CHECK_PROCESS (proc
);
6476 p
= XPROCESS (proc
);
6477 if (XINT (p
->infd
) < 0)
6478 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6479 if (XINT (p
->outfd
) < 0)
6480 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6481 Fcheck_coding_system (decoding
);
6482 Fcheck_coding_system (encoding
);
6484 p
->decode_coding_system
= decoding
;
6485 p
->encode_coding_system
= encoding
;
6486 setup_process_coding_systems (proc
);
6491 DEFUN ("process-coding-system",
6492 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6493 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6495 register Lisp_Object proc
;
6497 CHECK_PROCESS (proc
);
6498 return Fcons (XPROCESS (proc
)->decode_coding_system
,
6499 XPROCESS (proc
)->encode_coding_system
);
6502 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6503 Sset_process_filter_multibyte
, 2, 2, 0,
6504 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6505 If FLAG is non-nil, the filter is given multibyte strings.
6506 If FLAG is nil, the filter is given unibyte strings. In this case,
6507 all character code conversion except for end-of-line conversion is
6510 Lisp_Object proc
, flag
;
6512 register struct Lisp_Process
*p
;
6514 CHECK_PROCESS (proc
);
6515 p
= XPROCESS (proc
);
6516 p
->filter_multibyte
= flag
;
6517 setup_process_coding_systems (proc
);
6522 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6523 Sprocess_filter_multibyte_p
, 1, 1, 0,
6524 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6528 register struct Lisp_Process
*p
;
6530 CHECK_PROCESS (proc
);
6531 p
= XPROCESS (proc
);
6533 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6538 /* The first time this is called, assume keyboard input comes from DESC
6539 instead of from where we used to expect it.
6540 Subsequent calls mean assume input keyboard can come from DESC
6541 in addition to other places. */
6543 static int add_keyboard_wait_descriptor_called_flag
;
6546 add_keyboard_wait_descriptor (desc
)
6549 if (! add_keyboard_wait_descriptor_called_flag
)
6550 FD_CLR (0, &input_wait_mask
);
6551 add_keyboard_wait_descriptor_called_flag
= 1;
6552 FD_SET (desc
, &input_wait_mask
);
6553 FD_SET (desc
, &non_process_wait_mask
);
6554 if (desc
> max_keyboard_desc
)
6555 max_keyboard_desc
= desc
;
6558 /* From now on, do not expect DESC to give keyboard input. */
6561 delete_keyboard_wait_descriptor (desc
)
6565 int lim
= max_keyboard_desc
;
6567 FD_CLR (desc
, &input_wait_mask
);
6568 FD_CLR (desc
, &non_process_wait_mask
);
6570 if (desc
== max_keyboard_desc
)
6571 for (fd
= 0; fd
< lim
; fd
++)
6572 if (FD_ISSET (fd
, &input_wait_mask
)
6573 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6574 max_keyboard_desc
= fd
;
6577 /* Return nonzero if *MASK has a bit set
6578 that corresponds to one of the keyboard input descriptors. */
6581 keyboard_bit_set (mask
)
6586 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6587 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6588 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6601 if (! noninteractive
|| initialized
)
6603 signal (SIGCHLD
, sigchld_handler
);
6606 FD_ZERO (&input_wait_mask
);
6607 FD_ZERO (&non_keyboard_wait_mask
);
6608 FD_ZERO (&non_process_wait_mask
);
6609 max_process_desc
= 0;
6611 #ifdef ADAPTIVE_READ_BUFFERING
6612 process_output_delay_count
= 0;
6613 process_output_skip
= 0;
6616 FD_SET (0, &input_wait_mask
);
6618 Vprocess_alist
= Qnil
;
6619 for (i
= 0; i
< MAXDESC
; i
++)
6621 chan_process
[i
] = Qnil
;
6622 proc_buffered_char
[i
] = -1;
6624 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6625 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6626 #ifdef DATAGRAM_SOCKETS
6627 bzero (datagram_address
, sizeof datagram_address
);
6632 Lisp_Object subfeatures
= Qnil
;
6633 struct socket_options
*sopt
;
6635 #define ADD_SUBFEATURE(key, val) \
6636 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6638 #ifdef NON_BLOCKING_CONNECT
6639 ADD_SUBFEATURE (QCnowait
, Qt
);
6641 #ifdef DATAGRAM_SOCKETS
6642 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6644 #ifdef HAVE_LOCAL_SOCKETS
6645 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6647 #ifdef HAVE_GETSOCKNAME
6648 ADD_SUBFEATURE (QCservice
, Qt
);
6650 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6651 ADD_SUBFEATURE (QCserver
, Qt
);
6654 for (sopt
= socket_options
; sopt
->name
; sopt
++)
6655 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
6657 Fprovide (intern ("make-network-process"), subfeatures
);
6659 #endif /* HAVE_SOCKETS */
6665 Qprocessp
= intern ("processp");
6666 staticpro (&Qprocessp
);
6667 Qrun
= intern ("run");
6669 Qstop
= intern ("stop");
6671 Qsignal
= intern ("signal");
6672 staticpro (&Qsignal
);
6674 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6677 Qexit = intern ("exit");
6678 staticpro (&Qexit); */
6680 Qopen
= intern ("open");
6682 Qclosed
= intern ("closed");
6683 staticpro (&Qclosed
);
6684 Qconnect
= intern ("connect");
6685 staticpro (&Qconnect
);
6686 Qfailed
= intern ("failed");
6687 staticpro (&Qfailed
);
6688 Qlisten
= intern ("listen");
6689 staticpro (&Qlisten
);
6690 Qlocal
= intern ("local");
6691 staticpro (&Qlocal
);
6692 Qdatagram
= intern ("datagram");
6693 staticpro (&Qdatagram
);
6695 QCname
= intern (":name");
6696 staticpro (&QCname
);
6697 QCbuffer
= intern (":buffer");
6698 staticpro (&QCbuffer
);
6699 QChost
= intern (":host");
6700 staticpro (&QChost
);
6701 QCservice
= intern (":service");
6702 staticpro (&QCservice
);
6703 QCtype
= intern (":type");
6704 staticpro (&QCtype
);
6705 QClocal
= intern (":local");
6706 staticpro (&QClocal
);
6707 QCremote
= intern (":remote");
6708 staticpro (&QCremote
);
6709 QCcoding
= intern (":coding");
6710 staticpro (&QCcoding
);
6711 QCserver
= intern (":server");
6712 staticpro (&QCserver
);
6713 QCnowait
= intern (":nowait");
6714 staticpro (&QCnowait
);
6715 QCsentinel
= intern (":sentinel");
6716 staticpro (&QCsentinel
);
6717 QClog
= intern (":log");
6719 QCnoquery
= intern (":noquery");
6720 staticpro (&QCnoquery
);
6721 QCstop
= intern (":stop");
6722 staticpro (&QCstop
);
6723 QCoptions
= intern (":options");
6724 staticpro (&QCoptions
);
6725 QCplist
= intern (":plist");
6726 staticpro (&QCplist
);
6727 QCfilter_multibyte
= intern (":filter-multibyte");
6728 staticpro (&QCfilter_multibyte
);
6730 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
6731 staticpro (&Qlast_nonmenu_event
);
6733 staticpro (&Vprocess_alist
);
6735 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
6736 doc
: /* *Non-nil means delete processes immediately when they exit.
6737 nil means don't delete them until `list-processes' is run. */);
6739 delete_exited_processes
= 1;
6741 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
6742 doc
: /* Control type of device used to communicate with subprocesses.
6743 Values are nil to use a pipe, or t or `pty' to use a pty.
6744 The value has no effect if the system has no ptys or if all ptys are busy:
6745 then a pipe is used in any case.
6746 The value takes effect when `start-process' is called. */);
6747 Vprocess_connection_type
= Qt
;
6749 #ifdef ADAPTIVE_READ_BUFFERING
6750 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
6751 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
6752 On some systems, when emacs reads the output from a subprocess, the output data
6753 is read in very small blocks, potentially resulting in very poor performance.
6754 This behaviour can be remedied to some extent by setting this variable to a
6755 non-nil value, as it will automatically delay reading from such processes, to
6756 allowing them to produce more output before emacs tries to read it.
6757 If the value is t, the delay is reset after each write to the process; any other
6758 non-nil value means that the delay is not reset on write.
6759 The variable takes effect when `start-process' is called. */);
6760 Vprocess_adaptive_read_buffering
= Qt
;
6763 defsubr (&Sprocessp
);
6764 defsubr (&Sget_process
);
6765 defsubr (&Sget_buffer_process
);
6766 defsubr (&Sdelete_process
);
6767 defsubr (&Sprocess_status
);
6768 defsubr (&Sprocess_exit_status
);
6769 defsubr (&Sprocess_id
);
6770 defsubr (&Sprocess_name
);
6771 defsubr (&Sprocess_tty_name
);
6772 defsubr (&Sprocess_command
);
6773 defsubr (&Sset_process_buffer
);
6774 defsubr (&Sprocess_buffer
);
6775 defsubr (&Sprocess_mark
);
6776 defsubr (&Sset_process_filter
);
6777 defsubr (&Sprocess_filter
);
6778 defsubr (&Sset_process_sentinel
);
6779 defsubr (&Sprocess_sentinel
);
6780 defsubr (&Sset_process_window_size
);
6781 defsubr (&Sset_process_inherit_coding_system_flag
);
6782 defsubr (&Sprocess_inherit_coding_system_flag
);
6783 defsubr (&Sset_process_query_on_exit_flag
);
6784 defsubr (&Sprocess_query_on_exit_flag
);
6785 defsubr (&Sprocess_contact
);
6786 defsubr (&Sprocess_plist
);
6787 defsubr (&Sset_process_plist
);
6788 defsubr (&Slist_processes
);
6789 defsubr (&Sprocess_list
);
6790 defsubr (&Sstart_process
);
6792 defsubr (&Sset_network_process_option
);
6793 defsubr (&Smake_network_process
);
6794 defsubr (&Sformat_network_address
);
6795 #endif /* HAVE_SOCKETS */
6796 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
6798 defsubr (&Snetwork_interface_list
);
6800 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
6801 defsubr (&Snetwork_interface_info
);
6803 #endif /* HAVE_SOCKETS ... */
6804 #ifdef DATAGRAM_SOCKETS
6805 defsubr (&Sprocess_datagram_address
);
6806 defsubr (&Sset_process_datagram_address
);
6808 defsubr (&Saccept_process_output
);
6809 defsubr (&Sprocess_send_region
);
6810 defsubr (&Sprocess_send_string
);
6811 defsubr (&Sinterrupt_process
);
6812 defsubr (&Skill_process
);
6813 defsubr (&Squit_process
);
6814 defsubr (&Sstop_process
);
6815 defsubr (&Scontinue_process
);
6816 defsubr (&Sprocess_running_child_p
);
6817 defsubr (&Sprocess_send_eof
);
6818 defsubr (&Ssignal_process
);
6819 defsubr (&Swaiting_for_user_input_p
);
6820 /* defsubr (&Sprocess_connection); */
6821 defsubr (&Sset_process_coding_system
);
6822 defsubr (&Sprocess_coding_system
);
6823 defsubr (&Sset_process_filter_multibyte
);
6824 defsubr (&Sprocess_filter_multibyte_p
);
6828 #else /* not subprocesses */
6830 #include <sys/types.h>
6834 #include "systime.h"
6835 #include "character.h"
6837 #include "termopts.h"
6838 #include "sysselect.h"
6840 extern int frame_garbaged
;
6842 extern EMACS_TIME
timer_check ();
6843 extern int timers_run
;
6847 /* As described above, except assuming that there are no subprocesses:
6849 Wait for timeout to elapse and/or keyboard input to be available.
6852 timeout in seconds, or
6853 zero for no limit, or
6854 -1 means gobble data immediately available but don't wait for any.
6856 read_kbd is a Lisp_Object:
6857 0 to ignore keyboard input, or
6858 1 to return when input is available, or
6859 -1 means caller will actually read the input, so don't throw to
6861 a cons cell, meaning wait until its car is non-nil
6862 (and gobble terminal input into the buffer if any arrives), or
6863 We know that read_kbd will never be a Lisp_Process, since
6864 `subprocesses' isn't defined.
6866 do_display != 0 means redisplay should be done to show subprocess
6867 output that arrives.
6869 Return true iff we received input from any process. */
6872 wait_reading_process_input (time_limit
, microsecs
, read_kbd
, do_display
)
6873 int time_limit
, microsecs
;
6874 Lisp_Object read_kbd
;
6878 EMACS_TIME end_time
, timeout
;
6879 SELECT_TYPE waitchannels
;
6881 /* Either nil or a cons cell, the car of which is of interest and
6882 may be changed outside of this routine. */
6883 Lisp_Object wait_for_cell
;
6885 wait_for_cell
= Qnil
;
6887 /* If waiting for non-nil in a cell, record where. */
6888 if (CONSP (read_kbd
))
6890 wait_for_cell
= read_kbd
;
6891 XSETFASTINT (read_kbd
, 0);
6894 /* What does time_limit really mean? */
6895 if (time_limit
|| microsecs
)
6897 EMACS_GET_TIME (end_time
);
6898 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
6899 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
6902 /* Turn off periodic alarms (in case they are in use)
6903 and then turn off any other atimers,
6904 because the select emulator uses alarms. */
6906 turn_on_atimers (0);
6910 int timeout_reduced_for_timers
= 0;
6912 /* If calling from keyboard input, do not quit
6913 since we want to return C-g as an input character.
6914 Otherwise, do pending quit if requested. */
6915 if (XINT (read_kbd
) >= 0)
6918 /* Exit now if the cell we're waiting for became non-nil. */
6919 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
6922 /* Compute time from now till when time limit is up */
6923 /* Exit if already run out */
6924 if (time_limit
== -1)
6926 /* -1 specified for timeout means
6927 gobble output available now
6928 but don't wait at all. */
6930 EMACS_SET_SECS_USECS (timeout
, 0, 0);
6932 else if (time_limit
|| microsecs
)
6934 EMACS_GET_TIME (timeout
);
6935 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
6936 if (EMACS_TIME_NEG_P (timeout
))
6941 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
6944 /* If our caller will not immediately handle keyboard events,
6945 run timer events directly.
6946 (Callers that will immediately read keyboard events
6947 call timer_delay on their own.) */
6948 if (NILP (wait_for_cell
))
6950 EMACS_TIME timer_delay
;
6954 int old_timers_run
= timers_run
;
6955 timer_delay
= timer_check (1);
6956 if (timers_run
!= old_timers_run
&& do_display
)
6957 /* We must retry, since a timer may have requeued itself
6958 and that could alter the time delay. */
6959 redisplay_preserve_echo_area (14);
6963 while (!detect_input_pending ());
6965 /* If there is unread keyboard input, also return. */
6966 if (XINT (read_kbd
) != 0
6967 && requeued_events_pending_p ())
6970 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
6972 EMACS_TIME difference
;
6973 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
6974 if (EMACS_TIME_NEG_P (difference
))
6976 timeout
= timer_delay
;
6977 timeout_reduced_for_timers
= 1;
6982 /* Cause C-g and alarm signals to take immediate action,
6983 and cause input available signals to zero out timeout. */
6984 if (XINT (read_kbd
) < 0)
6985 set_waiting_for_input (&timeout
);
6987 /* Wait till there is something to do. */
6989 if (! XINT (read_kbd
) && NILP (wait_for_cell
))
6990 FD_ZERO (&waitchannels
);
6992 FD_SET (0, &waitchannels
);
6994 /* If a frame has been newly mapped and needs updating,
6995 reprocess its display stuff. */
6996 if (frame_garbaged
&& do_display
)
6998 clear_waiting_for_input ();
6999 redisplay_preserve_echo_area (15);
7000 if (XINT (read_kbd
) < 0)
7001 set_waiting_for_input (&timeout
);
7004 if (XINT (read_kbd
) && detect_input_pending ())
7007 FD_ZERO (&waitchannels
);
7010 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7015 /* Make C-g and alarm signals set flags again */
7016 clear_waiting_for_input ();
7018 /* If we woke up due to SIGWINCH, actually change size now. */
7019 do_pending_window_change (0);
7021 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7022 /* We waited the full specified time, so return now. */
7027 /* If the system call was interrupted, then go around the
7029 if (xerrno
== EINTR
)
7030 FD_ZERO (&waitchannels
);
7032 error ("select error: %s", emacs_strerror (xerrno
));
7035 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7036 /* System sometimes fails to deliver SIGIO. */
7037 kill (getpid (), SIGIO
);
7040 if (XINT (read_kbd
) && interrupt_input
&& (waitchannels
& 1))
7041 kill (getpid (), SIGIO
);
7044 /* Check for keyboard input */
7046 if ((XINT (read_kbd
) != 0)
7047 && detect_input_pending_run_timers (do_display
))
7049 swallow_events (do_display
);
7050 if (detect_input_pending_run_timers (do_display
))
7054 /* If there is unread keyboard input, also return. */
7055 if (XINT (read_kbd
) != 0
7056 && requeued_events_pending_p ())
7059 /* If wait_for_cell. check for keyboard input
7060 but don't run any timers.
7061 ??? (It seems wrong to me to check for keyboard
7062 input at all when wait_for_cell, but the code
7063 has been this way since July 1994.
7064 Try changing this after version 19.31.) */
7065 if (! NILP (wait_for_cell
)
7066 && detect_input_pending ())
7068 swallow_events (do_display
);
7069 if (detect_input_pending ())
7073 /* Exit now if the cell we're waiting for became non-nil. */
7074 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7084 /* Don't confuse make-docfile by having two doc strings for this function.
7085 make-docfile does not pay attention to #if, for good reason! */
7086 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7089 register Lisp_Object name
;
7094 /* Don't confuse make-docfile by having two doc strings for this function.
7095 make-docfile does not pay attention to #if, for good reason! */
7096 DEFUN ("process-inherit-coding-system-flag",
7097 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7101 register Lisp_Object process
;
7103 /* Ignore the argument and return the value of
7104 inherit-process-coding-system. */
7105 return inherit_process_coding_system
? Qt
: Qnil
;
7108 /* Kill all processes associated with `buffer'.
7109 If `buffer' is nil, kill all processes.
7110 Since we have no subprocesses, this does nothing. */
7113 kill_buffer_processes (buffer
)
7126 QCtype
= intern (":type");
7127 staticpro (&QCtype
);
7129 defsubr (&Sget_buffer_process
);
7130 defsubr (&Sprocess_inherit_coding_system_flag
);
7134 #endif /* not subprocesses */
7136 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7137 (do not change this comment) */