1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
3 1996, 1998, 1999, 2001, 2002, 2003, 2004,
4 2005, 2006 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
27 /* This file is split into two parts by the following preprocessor
28 conditional. The 'then' clause contains all of the support for
29 asynchronous subprocesses. The 'else' clause contains stub
30 versions of some of the asynchronous subprocess routines that are
31 often called elsewhere in Emacs, so we don't have to #ifdef the
32 sections that call them. */
40 #include <sys/types.h> /* some typedefs are used in sys/file.h */
43 #ifdef HAVE_INTTYPES_H
50 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
53 #endif /* not WINDOWSNT */
55 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
56 #include <sys/socket.h>
58 #include <netinet/in.h>
59 #include <arpa/inet.h>
60 #ifdef NEED_NET_ERRNO_H
61 #include <net/errno.h>
62 #endif /* NEED_NET_ERRNO_H */
64 /* Are local (unix) sockets supported? */
65 #if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
66 #if !defined (AF_LOCAL) && defined (AF_UNIX)
67 #define AF_LOCAL AF_UNIX
70 #define HAVE_LOCAL_SOCKETS
74 #endif /* HAVE_SOCKETS */
76 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
81 /* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
82 #ifdef HAVE_BROKEN_INET_ADDR
83 #define IN_ADDR struct in_addr
84 #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
86 #define IN_ADDR unsigned long
87 #define NUMERIC_ADDR_ERROR (numeric_addr == -1)
90 #if defined(BSD_SYSTEM) || defined(STRIDE)
91 #include <sys/ioctl.h>
92 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
94 #endif /* HAVE_PTYS and no O_NDELAY */
95 #endif /* BSD_SYSTEM || STRIDE */
97 #ifdef BROKEN_O_NONBLOCK
99 #endif /* BROKEN_O_NONBLOCK */
105 /* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
107 #if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
108 /* sys/ioctl.h may have been included already */
110 #include <sys/ioctl.h>
117 #include <sys/sysmacros.h> /* for "minor" */
118 #endif /* not IRIS */
121 #include <sys/wait.h>
124 /* Disable IPv6 support for w32 until someone figures out how to do it
141 #include "termhooks.h"
142 #include "termopts.h"
143 #include "commands.h"
144 #include "keyboard.h"
146 #include "blockinput.h"
147 #include "dispextern.h"
148 #include "composite.h"
151 Lisp_Object Qprocessp
;
152 Lisp_Object Qrun
, Qstop
, Qsignal
;
153 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
154 Lisp_Object Qlocal
, Qipv4
, Qdatagram
;
158 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
159 Lisp_Object QClocal
, QCremote
, QCcoding
;
160 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
161 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
162 Lisp_Object QCfilter_multibyte
;
163 Lisp_Object Qlast_nonmenu_event
;
164 /* QCfamily is declared and initialized in xfaces.c,
165 QCfilter in keyboard.c. */
166 extern Lisp_Object QCfamily
, QCfilter
;
168 /* Qexit is declared and initialized in eval.c. */
170 /* QCfamily is defined in xfaces.c. */
171 extern Lisp_Object QCfamily
;
172 /* QCfilter is defined in keyboard.c. */
173 extern Lisp_Object QCfilter
;
175 /* a process object is a network connection when its childp field is neither
176 Qt nor Qnil but is instead a property list (KEY VAL ...). */
179 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
180 #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
182 #define NETCONN_P(p) 0
183 #define NETCONN1_P(p) 0
184 #endif /* HAVE_SOCKETS */
186 /* Define first descriptor number available for subprocesses. */
188 #define FIRST_PROC_DESC 1
190 #define FIRST_PROC_DESC 3
193 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
196 #if !defined (SIGCHLD) && defined (SIGCLD)
197 #define SIGCHLD SIGCLD
200 #include "syssignal.h"
204 extern char *get_operating_system_release ();
210 extern char *sys_errlist
[];
217 /* t means use pty, nil means use a pipe,
218 maybe other values to come. */
219 static Lisp_Object Vprocess_connection_type
;
223 #include <sys/socket.h>
227 /* These next two vars are non-static since sysdep.c uses them in the
228 emulation of `select'. */
229 /* Number of events of change of status of a process. */
231 /* Number of events for which the user or sentinel has been notified. */
234 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
236 #ifdef BROKEN_NON_BLOCKING_CONNECT
237 #undef NON_BLOCKING_CONNECT
239 #ifndef NON_BLOCKING_CONNECT
242 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
243 #if defined (O_NONBLOCK) || defined (O_NDELAY)
244 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
245 #define NON_BLOCKING_CONNECT
246 #endif /* EWOULDBLOCK || EINPROGRESS */
247 #endif /* O_NONBLOCK || O_NDELAY */
248 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
249 #endif /* HAVE_SELECT */
250 #endif /* HAVE_SOCKETS */
251 #endif /* NON_BLOCKING_CONNECT */
252 #endif /* BROKEN_NON_BLOCKING_CONNECT */
254 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
255 this system. We need to read full packets, so we need a
256 "non-destructive" select. So we require either native select,
257 or emulation of select using FIONREAD. */
259 #ifdef BROKEN_DATAGRAM_SOCKETS
260 #undef DATAGRAM_SOCKETS
262 #ifndef DATAGRAM_SOCKETS
264 #if defined (HAVE_SELECT) || defined (FIONREAD)
265 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
266 #define DATAGRAM_SOCKETS
267 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
268 #endif /* HAVE_SELECT || FIONREAD */
269 #endif /* HAVE_SOCKETS */
270 #endif /* DATAGRAM_SOCKETS */
271 #endif /* BROKEN_DATAGRAM_SOCKETS */
274 #undef NON_BLOCKING_CONNECT
275 #undef DATAGRAM_SOCKETS
278 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
279 #ifdef EMACS_HAS_USECS
280 #define ADAPTIVE_READ_BUFFERING
284 #ifdef ADAPTIVE_READ_BUFFERING
285 #define READ_OUTPUT_DELAY_INCREMENT 10000
286 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
287 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
289 /* Number of processes which have a non-zero read_output_delay,
290 and therefore might be delayed for adaptive read buffering. */
292 static int process_output_delay_count
;
294 /* Non-zero if any process has non-nil read_output_skip. */
296 static int process_output_skip
;
298 /* Non-nil means to delay reading process output to improve buffering.
299 A value of t means that delay is reset after each send, any other
300 non-nil value does not reset the delay. A value of nil disables
301 adaptive read buffering completely. */
302 static Lisp_Object Vprocess_adaptive_read_buffering
;
304 #define process_output_delay_count 0
308 #include "sysselect.h"
310 static int keyboard_bit_set
P_ ((SELECT_TYPE
*));
311 static void deactivate_process
P_ ((Lisp_Object
));
312 static void status_notify
P_ ((struct Lisp_Process
*));
313 static int read_process_output
P_ ((Lisp_Object
, int));
315 /* If we support a window system, turn on the code to poll periodically
316 to detect C-g. It isn't actually used when doing interrupt input. */
317 #ifdef HAVE_WINDOW_SYSTEM
318 #define POLL_FOR_INPUT
321 static Lisp_Object
get_process ();
322 static void exec_sentinel ();
324 extern EMACS_TIME
timer_check ();
325 extern int timers_run
;
327 /* Mask of bits indicating the descriptors that we wait for input on. */
329 static SELECT_TYPE input_wait_mask
;
331 /* Mask that excludes keyboard input descriptor (s). */
333 static SELECT_TYPE non_keyboard_wait_mask
;
335 /* Mask that excludes process input descriptor (s). */
337 static SELECT_TYPE non_process_wait_mask
;
339 #ifdef NON_BLOCKING_CONNECT
340 /* Mask of bits indicating the descriptors that we wait for connect to
341 complete on. Once they complete, they are removed from this mask
342 and added to the input_wait_mask and non_keyboard_wait_mask. */
344 static SELECT_TYPE connect_wait_mask
;
346 /* Number of bits set in connect_wait_mask. */
347 static int num_pending_connects
;
349 #define IF_NON_BLOCKING_CONNECT(s) s
351 #define IF_NON_BLOCKING_CONNECT(s)
354 /* The largest descriptor currently in use for a process object. */
355 static int max_process_desc
;
357 /* The largest descriptor currently in use for keyboard input. */
358 static int max_keyboard_desc
;
360 /* Nonzero means delete a process right away if it exits. */
361 static int delete_exited_processes
;
363 /* Indexed by descriptor, gives the process (if any) for that descriptor */
364 Lisp_Object chan_process
[MAXDESC
];
366 /* Alist of elements (NAME . PROCESS) */
367 Lisp_Object Vprocess_alist
;
369 /* Buffered-ahead input char from process, indexed by channel.
370 -1 means empty (no char is buffered).
371 Used on sys V where the only way to tell if there is any
372 output from the process is to read at least one char.
373 Always -1 on systems that support FIONREAD. */
375 /* Don't make static; need to access externally. */
376 int proc_buffered_char
[MAXDESC
];
378 /* Table of `struct coding-system' for each process. */
379 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
380 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
382 #ifdef DATAGRAM_SOCKETS
383 /* Table of `partner address' for datagram sockets. */
384 struct sockaddr_and_len
{
387 } datagram_address
[MAXDESC
];
388 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
389 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
391 #define DATAGRAM_CHAN_P(chan) (0)
392 #define DATAGRAM_CONN_P(proc) (0)
395 /* Maximum number of bytes to send to a pty without an eof. */
396 static int pty_max_bytes
;
398 /* Nonzero means don't run process sentinels. This is used
400 int inhibit_sentinels
;
406 /* The file name of the pty opened by allocate_pty. */
408 static char pty_name
[24];
411 /* Compute the Lisp form of the process status, p->status, from
412 the numeric status that was returned by `wait'. */
414 static Lisp_Object
status_convert ();
418 struct Lisp_Process
*p
;
420 union { int i
; WAITTYPE wt
; } u
;
421 eassert (p
->raw_status_new
);
423 p
->status
= status_convert (u
.wt
);
424 p
->raw_status_new
= 0;
427 /* Convert a process status word in Unix format to
428 the list that we use internally. */
435 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
436 else if (WIFEXITED (w
))
437 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
438 WCOREDUMP (w
) ? Qt
: Qnil
));
439 else if (WIFSIGNALED (w
))
440 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
441 WCOREDUMP (w
) ? Qt
: Qnil
));
446 /* Given a status-list, extract the three pieces of information
447 and store them individually through the three pointers. */
450 decode_status (l
, symbol
, code
, coredump
)
468 *code
= XFASTINT (XCAR (tem
));
470 *coredump
= !NILP (tem
);
474 /* Return a string describing a process status list. */
478 struct Lisp_Process
*p
;
480 Lisp_Object status
= p
->status
;
483 Lisp_Object string
, string2
;
485 decode_status (status
, &symbol
, &code
, &coredump
);
487 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
490 synchronize_system_messages_locale ();
491 signame
= strsignal (code
);
494 string
= build_string (signame
);
495 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
496 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
497 return concat2 (string
, string2
);
499 else if (EQ (symbol
, Qexit
))
502 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
504 return build_string ("finished\n");
505 string
= Fnumber_to_string (make_number (code
));
506 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
507 return concat3 (build_string ("exited abnormally with code "),
510 else if (EQ (symbol
, Qfailed
))
512 string
= Fnumber_to_string (make_number (code
));
513 string2
= build_string ("\n");
514 return concat3 (build_string ("failed with code "),
518 return Fcopy_sequence (Fsymbol_name (symbol
));
523 /* Open an available pty, returning a file descriptor.
524 Return -1 on failure.
525 The file name of the terminal corresponding to the pty
526 is left in the variable pty_name. */
537 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
538 for (i
= 0; i
< 16; i
++)
541 struct stat stb
; /* Used in some PTY_OPEN. */
542 #ifdef PTY_NAME_SPRINTF
545 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
546 #endif /* no PTY_NAME_SPRINTF */
550 #else /* no PTY_OPEN */
553 /* Unusual IRIS code */
554 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
557 if (fstat (fd
, &stb
) < 0)
559 # else /* not IRIS */
560 { /* Some systems name their pseudoterminals so that there are gaps in
561 the usual sequence - for example, on HP9000/S700 systems, there
562 are no pseudoterminals with names ending in 'f'. So we wait for
563 three failures in a row before deciding that we've reached the
565 int failed_count
= 0;
567 if (stat (pty_name
, &stb
) < 0)
570 if (failed_count
>= 3)
577 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
579 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
581 # endif /* not IRIS */
583 #endif /* no PTY_OPEN */
587 /* check to make certain that both sides are available
588 this avoids a nasty yet stupid bug in rlogins */
589 #ifdef PTY_TTY_NAME_SPRINTF
592 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
593 #endif /* no PTY_TTY_NAME_SPRINTF */
595 if (access (pty_name
, 6) != 0)
598 # if !defined(IRIS) && !defined(__sgi)
604 #endif /* not UNIPLUS */
611 #endif /* HAVE_PTYS */
617 register Lisp_Object val
, tem
, name1
;
618 register struct Lisp_Process
*p
;
622 p
= allocate_process ();
624 XSETINT (p
->infd
, -1);
625 XSETINT (p
->outfd
, -1);
626 XSETFASTINT (p
->tick
, 0);
627 XSETFASTINT (p
->update_tick
, 0);
629 p
->raw_status_new
= 0;
631 p
->mark
= Fmake_marker ();
633 #ifdef ADAPTIVE_READ_BUFFERING
634 p
->adaptive_read_buffering
= Qnil
;
635 XSETFASTINT (p
->read_output_delay
, 0);
636 p
->read_output_skip
= Qnil
;
639 /* If name is already in use, modify it until it is unused. */
644 tem
= Fget_process (name1
);
645 if (NILP (tem
)) break;
646 sprintf (suffix
, "<%d>", i
);
647 name1
= concat2 (name
, build_string (suffix
));
651 XSETPROCESS (val
, p
);
652 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
657 remove_process (proc
)
658 register Lisp_Object proc
;
660 register Lisp_Object pair
;
662 pair
= Frassq (proc
, Vprocess_alist
);
663 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
665 deactivate_process (proc
);
668 /* Setup coding systems of PROCESS. */
671 setup_process_coding_systems (process
)
674 struct Lisp_Process
*p
= XPROCESS (process
);
675 int inch
= XINT (p
->infd
);
676 int outch
= XINT (p
->outfd
);
678 if (inch
< 0 || outch
< 0)
681 if (!proc_decode_coding_system
[inch
])
682 proc_decode_coding_system
[inch
]
683 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
684 setup_coding_system (p
->decode_coding_system
,
685 proc_decode_coding_system
[inch
]);
686 if (! NILP (p
->filter
))
688 if (NILP (p
->filter_multibyte
))
689 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
691 else if (BUFFERP (p
->buffer
))
693 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
694 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
697 if (!proc_encode_coding_system
[outch
])
698 proc_encode_coding_system
[outch
]
699 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
700 setup_coding_system (p
->encode_coding_system
,
701 proc_encode_coding_system
[outch
]);
702 if (proc_encode_coding_system
[outch
]->eol_type
== CODING_EOL_UNDECIDED
)
703 proc_encode_coding_system
[outch
]->eol_type
= system_eol_type
;
706 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
707 doc
: /* Return t if OBJECT is a process. */)
711 return PROCESSP (object
) ? Qt
: Qnil
;
714 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
715 doc
: /* Return the process named NAME, or nil if there is none. */)
717 register Lisp_Object name
;
722 return Fcdr (Fassoc (name
, Vprocess_alist
));
725 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
726 doc
: /* Return the (or a) process associated with BUFFER.
727 BUFFER may be a buffer or the name of one. */)
729 register Lisp_Object buffer
;
731 register Lisp_Object buf
, tail
, proc
;
733 if (NILP (buffer
)) return Qnil
;
734 buf
= Fget_buffer (buffer
);
735 if (NILP (buf
)) return Qnil
;
737 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
739 proc
= Fcdr (Fcar (tail
));
740 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
746 /* This is how commands for the user decode process arguments. It
747 accepts a process, a process name, a buffer, a buffer name, or nil.
748 Buffers denote the first process in the buffer, and nil denotes the
753 register Lisp_Object name
;
755 register Lisp_Object proc
, obj
;
758 obj
= Fget_process (name
);
760 obj
= Fget_buffer (name
);
762 error ("Process %s does not exist", SDATA (name
));
764 else if (NILP (name
))
765 obj
= Fcurrent_buffer ();
769 /* Now obj should be either a buffer object or a process object.
773 proc
= Fget_buffer_process (obj
);
775 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
787 /* Fdelete_process promises to immediately forget about the process, but in
788 reality, Emacs needs to remember those processes until they have been
789 treated by sigchld_handler; otherwise this handler would consider the
790 process as being synchronous and say that the synchronous process is
792 static Lisp_Object deleted_pid_list
;
795 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
796 doc
: /* Delete PROCESS: kill it and forget about it immediately.
797 PROCESS may be a process, a buffer, the name of a process or buffer, or
798 nil, indicating the current buffer's process. */)
800 register Lisp_Object process
;
802 register struct Lisp_Process
*p
;
804 process
= get_process (process
);
805 p
= XPROCESS (process
);
807 p
->raw_status_new
= 0;
810 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
811 XSETINT (p
->tick
, ++process_tick
);
814 else if (XINT (p
->infd
) >= 0)
819 /* No problem storing the pid here, as it is still in Vprocess_alist. */
820 deleted_pid_list
= Fcons (make_fixnum_or_float (p
->pid
),
821 /* GC treated elements set to nil. */
822 Fdelq (Qnil
, deleted_pid_list
));
823 /* If the process has already signaled, remove it from the list. */
824 if (p
->raw_status_new
)
827 if (CONSP (p
->status
))
828 symbol
= XCAR (p
->status
);
829 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
830 Fdelete (make_fixnum_or_float (p
->pid
), deleted_pid_list
);
834 Fkill_process (process
, Qnil
);
835 /* Do this now, since remove_process will make sigchld_handler do nothing. */
837 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
838 XSETINT (p
->tick
, ++process_tick
);
842 remove_process (process
);
846 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
847 doc
: /* Return the status of PROCESS.
848 The returned value is one of the following symbols:
849 run -- for a process that is running.
850 stop -- for a process stopped but continuable.
851 exit -- for a process that has exited.
852 signal -- for a process that has got a fatal signal.
853 open -- for a network stream connection that is open.
854 listen -- for a network stream server that is listening.
855 closed -- for a network stream connection that is closed.
856 connect -- when waiting for a non-blocking connection to complete.
857 failed -- when a non-blocking connection has failed.
858 nil -- if arg is a process name and no such process exists.
859 PROCESS may be a process, a buffer, the name of a process, or
860 nil, indicating the current buffer's process. */)
862 register Lisp_Object process
;
864 register struct Lisp_Process
*p
;
865 register Lisp_Object status
;
867 if (STRINGP (process
))
868 process
= Fget_process (process
);
870 process
= get_process (process
);
875 p
= XPROCESS (process
);
876 if (p
->raw_status_new
)
880 status
= XCAR (status
);
883 if (EQ (status
, Qexit
))
885 else if (EQ (p
->command
, Qt
))
887 else if (EQ (status
, Qrun
))
893 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
895 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
896 If PROCESS has not yet exited or died, return 0. */)
898 register Lisp_Object process
;
900 CHECK_PROCESS (process
);
901 if (XPROCESS (process
)->raw_status_new
)
902 update_status (XPROCESS (process
));
903 if (CONSP (XPROCESS (process
)->status
))
904 return XCAR (XCDR (XPROCESS (process
)->status
));
905 return make_number (0);
908 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
909 doc
: /* Return the process id of PROCESS.
910 This is the pid of the external process which PROCESS uses or talks to.
911 For a network connection, this value is nil. */)
913 register Lisp_Object process
;
915 CHECK_PROCESS (process
);
916 return (XPROCESS (process
)->pid
917 ? make_fixnum_or_float (XPROCESS (process
)->pid
)
921 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
922 doc
: /* Return the name of PROCESS, as a string.
923 This is the name of the program invoked in PROCESS,
924 possibly modified to make it unique among process names. */)
926 register Lisp_Object process
;
928 CHECK_PROCESS (process
);
929 return XPROCESS (process
)->name
;
932 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
933 doc
: /* Return the command that was executed to start PROCESS.
934 This is a list of strings, the first string being the program executed
935 and the rest of the strings being the arguments given to it.
936 For a non-child channel, this is nil. */)
938 register Lisp_Object process
;
940 CHECK_PROCESS (process
);
941 return XPROCESS (process
)->command
;
944 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
945 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
946 This is the terminal that the process itself reads and writes on,
947 not the name of the pty that Emacs uses to talk with that terminal. */)
949 register Lisp_Object process
;
951 CHECK_PROCESS (process
);
952 return XPROCESS (process
)->tty_name
;
955 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
957 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
959 register Lisp_Object process
, buffer
;
961 struct Lisp_Process
*p
;
963 CHECK_PROCESS (process
);
965 CHECK_BUFFER (buffer
);
966 p
= XPROCESS (process
);
969 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
970 setup_process_coding_systems (process
);
974 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
976 doc
: /* Return the buffer PROCESS is associated with.
977 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
979 register Lisp_Object process
;
981 CHECK_PROCESS (process
);
982 return XPROCESS (process
)->buffer
;
985 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
987 doc
: /* Return the marker for the end of the last output from PROCESS. */)
989 register Lisp_Object process
;
991 CHECK_PROCESS (process
);
992 return XPROCESS (process
)->mark
;
995 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
997 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
998 t means stop accepting output from the process.
1000 When a process has a filter, its buffer is not used for output.
1001 Instead, each time it does output, the entire string of output is
1002 passed to the filter.
1004 The filter gets two arguments: the process and the string of output.
1005 The string argument is normally a multibyte string, except:
1006 - if the process' input coding system is no-conversion or raw-text,
1007 it is a unibyte string (the non-converted input), or else
1008 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1009 string (the result of converting the decoded input multibyte
1010 string to unibyte with `string-make-unibyte'). */)
1012 register Lisp_Object process
, filter
;
1014 struct Lisp_Process
*p
;
1016 CHECK_PROCESS (process
);
1017 p
= XPROCESS (process
);
1019 /* Don't signal an error if the process' input file descriptor
1020 is closed. This could make debugging Lisp more difficult,
1021 for example when doing something like
1023 (setq process (start-process ...))
1025 (set-process-filter process ...) */
1027 if (XINT (p
->infd
) >= 0)
1029 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
1031 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
1032 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
1034 else if (EQ (p
->filter
, Qt
)
1035 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
1037 FD_SET (XINT (p
->infd
), &input_wait_mask
);
1038 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
1044 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
1045 setup_process_coding_systems (process
);
1049 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1051 doc
: /* Returns the filter function of PROCESS; nil if none.
1052 See `set-process-filter' for more info on filter functions. */)
1054 register Lisp_Object process
;
1056 CHECK_PROCESS (process
);
1057 return XPROCESS (process
)->filter
;
1060 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1062 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1063 The sentinel is called as a function when the process changes state.
1064 It gets two arguments: the process, and a string describing the change. */)
1066 register Lisp_Object process
, sentinel
;
1068 struct Lisp_Process
*p
;
1070 CHECK_PROCESS (process
);
1071 p
= XPROCESS (process
);
1073 p
->sentinel
= sentinel
;
1075 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1079 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1081 doc
: /* Return the sentinel of PROCESS; nil if none.
1082 See `set-process-sentinel' for more info on sentinels. */)
1084 register Lisp_Object process
;
1086 CHECK_PROCESS (process
);
1087 return XPROCESS (process
)->sentinel
;
1090 DEFUN ("set-process-window-size", Fset_process_window_size
,
1091 Sset_process_window_size
, 3, 3, 0,
1092 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1093 (process
, height
, width
)
1094 register Lisp_Object process
, height
, width
;
1096 CHECK_PROCESS (process
);
1097 CHECK_NATNUM (height
);
1098 CHECK_NATNUM (width
);
1100 if (XINT (XPROCESS (process
)->infd
) < 0
1101 || set_window_size (XINT (XPROCESS (process
)->infd
),
1102 XINT (height
), XINT (width
)) <= 0)
1108 DEFUN ("set-process-inherit-coding-system-flag",
1109 Fset_process_inherit_coding_system_flag
,
1110 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1111 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1112 If the second argument FLAG is non-nil, then the variable
1113 `buffer-file-coding-system' of the buffer associated with PROCESS
1114 will be bound to the value of the coding system used to decode
1117 This is useful when the coding system specified for the process buffer
1118 leaves either the character code conversion or the end-of-line conversion
1119 unspecified, or if the coding system used to decode the process output
1120 is more appropriate for saving the process buffer.
1122 Binding the variable `inherit-process-coding-system' to non-nil before
1123 starting the process is an alternative way of setting the inherit flag
1124 for the process which will run. */)
1126 register Lisp_Object process
, flag
;
1128 CHECK_PROCESS (process
);
1129 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
1133 DEFUN ("process-inherit-coding-system-flag",
1134 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1136 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1137 If this flag is t, `buffer-file-coding-system' of the buffer
1138 associated with PROCESS will inherit the coding system used to decode
1139 the process output. */)
1141 register Lisp_Object process
;
1143 CHECK_PROCESS (process
);
1144 return XPROCESS (process
)->inherit_coding_system_flag
;
1147 DEFUN ("set-process-query-on-exit-flag",
1148 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1150 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1151 If the second argument FLAG is non-nil, Emacs will query the user before
1152 exiting if PROCESS is running. */)
1154 register Lisp_Object process
, flag
;
1156 CHECK_PROCESS (process
);
1157 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
1161 DEFUN ("process-query-on-exit-flag",
1162 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1164 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1166 register Lisp_Object process
;
1168 CHECK_PROCESS (process
);
1169 return Fnull (XPROCESS (process
)->kill_without_query
);
1172 #ifdef DATAGRAM_SOCKETS
1173 Lisp_Object
Fprocess_datagram_address ();
1176 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1178 doc
: /* Return the contact info of PROCESS; t for a real child.
1179 For a net connection, the value depends on the optional KEY arg.
1180 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1181 if KEY is t, the complete contact information for the connection is
1182 returned, else the specific value for the keyword KEY is returned.
1183 See `make-network-process' for a list of keywords. */)
1185 register Lisp_Object process
, key
;
1187 Lisp_Object contact
;
1189 CHECK_PROCESS (process
);
1190 contact
= XPROCESS (process
)->childp
;
1192 #ifdef DATAGRAM_SOCKETS
1193 if (DATAGRAM_CONN_P (process
)
1194 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1195 contact
= Fplist_put (contact
, QCremote
,
1196 Fprocess_datagram_address (process
));
1199 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1202 return Fcons (Fplist_get (contact
, QChost
),
1203 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1204 return Fplist_get (contact
, key
);
1207 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1209 doc
: /* Return the plist of PROCESS. */)
1211 register Lisp_Object process
;
1213 CHECK_PROCESS (process
);
1214 return XPROCESS (process
)->plist
;
1217 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1219 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1221 register Lisp_Object process
, plist
;
1223 CHECK_PROCESS (process
);
1226 XPROCESS (process
)->plist
= plist
;
1230 #if 0 /* Turned off because we don't currently record this info
1231 in the process. Perhaps add it. */
1232 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1233 doc
: /* Return the connection type of PROCESS.
1234 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1235 a socket connection. */)
1237 Lisp_Object process
;
1239 return XPROCESS (process
)->type
;
1244 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1246 doc
: /* Convert network ADDRESS from internal format to a string.
1247 A 4 or 5 element vector represents an IPv4 address (with port number).
1248 An 8 or 9 element vector represents an IPv6 address (with port number).
1249 If optional second argument OMIT-PORT is non-nil, don't include a port
1250 number in the string, even when present in ADDRESS.
1251 Returns nil if format of ADDRESS is invalid. */)
1252 (address
, omit_port
)
1253 Lisp_Object address
, omit_port
;
1258 if (STRINGP (address
)) /* AF_LOCAL */
1261 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1263 register struct Lisp_Vector
*p
= XVECTOR (address
);
1264 Lisp_Object args
[6];
1267 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1269 args
[0] = build_string ("%d.%d.%d.%d");
1272 else if (p
->size
== 5)
1274 args
[0] = build_string ("%d.%d.%d.%d:%d");
1277 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1279 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1282 else if (p
->size
== 9)
1284 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1290 for (i
= 0; i
< nargs
; i
++)
1291 args
[i
+1] = p
->contents
[i
];
1292 return Fformat (nargs
+1, args
);
1295 if (CONSP (address
))
1297 Lisp_Object args
[2];
1298 args
[0] = build_string ("<Family %d>");
1299 args
[1] = Fcar (address
);
1300 return Fformat (2, args
);
1309 list_processes_1 (query_only
)
1310 Lisp_Object query_only
;
1312 register Lisp_Object tail
, tem
;
1313 Lisp_Object proc
, minspace
, tem1
;
1314 register struct Lisp_Process
*p
;
1316 int w_proc
, w_buffer
, w_tty
;
1317 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1319 w_proc
= 4; /* Proc */
1320 w_buffer
= 6; /* Buffer */
1321 w_tty
= 0; /* Omit if no ttys */
1323 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1327 proc
= Fcdr (Fcar (tail
));
1328 p
= XPROCESS (proc
);
1329 if (NILP (p
->childp
))
1331 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1333 if (STRINGP (p
->name
)
1334 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1336 if (!NILP (p
->buffer
))
1338 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1339 w_buffer
= 8; /* (Killed) */
1340 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1343 if (STRINGP (p
->tty_name
)
1344 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1348 XSETFASTINT (i_status
, w_proc
+ 1);
1349 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1352 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1353 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1356 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1359 XSETFASTINT (minspace
, 1);
1361 set_buffer_internal (XBUFFER (Vstandard_output
));
1362 current_buffer
->undo_list
= Qt
;
1364 current_buffer
->truncate_lines
= Qt
;
1366 write_string ("Proc", -1);
1367 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1368 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1371 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1373 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1374 write_string ("\n", -1);
1376 write_string ("----", -1);
1377 Findent_to (i_status
, minspace
); write_string ("------", -1);
1378 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1381 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1383 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1384 write_string ("\n", -1);
1386 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1390 proc
= Fcdr (Fcar (tail
));
1391 p
= XPROCESS (proc
);
1392 if (NILP (p
->childp
))
1394 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1397 Finsert (1, &p
->name
);
1398 Findent_to (i_status
, minspace
);
1400 if (p
->raw_status_new
)
1403 if (CONSP (p
->status
))
1404 symbol
= XCAR (p
->status
);
1407 if (EQ (symbol
, Qsignal
))
1410 tem
= Fcar (Fcdr (p
->status
));
1412 if (XINT (tem
) < NSIG
)
1413 write_string (sys_errlist
[XINT (tem
)], -1);
1416 Fprinc (symbol
, Qnil
);
1418 else if (NETCONN1_P (p
))
1420 if (EQ (symbol
, Qexit
))
1421 write_string ("closed", -1);
1422 else if (EQ (p
->command
, Qt
))
1423 write_string ("stopped", -1);
1424 else if (EQ (symbol
, Qrun
))
1425 write_string ("open", -1);
1427 Fprinc (symbol
, Qnil
);
1430 Fprinc (symbol
, Qnil
);
1432 if (EQ (symbol
, Qexit
))
1435 tem
= Fcar (Fcdr (p
->status
));
1438 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1439 write_string (tembuf
, -1);
1443 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
1444 remove_process (proc
);
1446 Findent_to (i_buffer
, minspace
);
1447 if (NILP (p
->buffer
))
1448 insert_string ("(none)");
1449 else if (NILP (XBUFFER (p
->buffer
)->name
))
1450 insert_string ("(Killed)");
1452 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1456 Findent_to (i_tty
, minspace
);
1457 if (STRINGP (p
->tty_name
))
1458 Finsert (1, &p
->tty_name
);
1461 Findent_to (i_command
, minspace
);
1463 if (EQ (p
->status
, Qlisten
))
1465 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1466 if (INTEGERP (port
))
1467 port
= Fnumber_to_string (port
);
1469 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1470 sprintf (tembuf
, "(network %s server on %s)\n",
1471 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1472 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1473 insert_string (tembuf
);
1475 else if (NETCONN1_P (p
))
1477 /* For a local socket, there is no host name,
1478 so display service instead. */
1479 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1480 if (!STRINGP (host
))
1482 host
= Fplist_get (p
->childp
, QCservice
);
1483 if (INTEGERP (host
))
1484 host
= Fnumber_to_string (host
);
1487 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1488 sprintf (tembuf
, "(network %s connection to %s)\n",
1489 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1490 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1491 insert_string (tembuf
);
1503 insert_string (" ");
1505 insert_string ("\n");
1511 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1512 doc
: /* Display a list of all processes.
1513 If optional argument QUERY-ONLY is non-nil, only processes with
1514 the query-on-exit flag set will be listed.
1515 Any process listed as exited or signaled is actually eliminated
1516 after the listing is made. */)
1518 Lisp_Object query_only
;
1520 internal_with_output_to_temp_buffer ("*Process List*",
1521 list_processes_1
, query_only
);
1525 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1526 doc
: /* Return a list of all processes. */)
1529 return Fmapcar (Qcdr
, Vprocess_alist
);
1532 /* Starting asynchronous inferior processes. */
1534 static Lisp_Object
start_process_unwind ();
1536 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1537 doc
: /* Start a program in a subprocess. Return the process object for it.
1538 NAME is name for process. It is modified if necessary to make it unique.
1539 BUFFER is the buffer (or buffer name) to associate with the process.
1540 Process output goes at end of that buffer, unless you specify
1541 an output stream or filter function to handle the output.
1542 BUFFER may be also nil, meaning that this process is not associated
1544 PROGRAM is the program file name. It is searched for in PATH.
1545 Remaining arguments are strings to give program as arguments.
1547 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1550 register Lisp_Object
*args
;
1552 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1554 register unsigned char *new_argv
;
1557 register unsigned char **new_argv
;
1560 int count
= SPECPDL_INDEX ();
1564 buffer
= Fget_buffer_create (buffer
);
1566 /* Make sure that the child will be able to chdir to the current
1567 buffer's current directory, or its unhandled equivalent. We
1568 can't just have the child check for an error when it does the
1569 chdir, since it's in a vfork.
1571 We have to GCPRO around this because Fexpand_file_name and
1572 Funhandled_file_name_directory might call a file name handling
1573 function. The argument list is protected by the caller, so all
1574 we really have to worry about is buffer. */
1576 struct gcpro gcpro1
, gcpro2
;
1578 current_dir
= current_buffer
->directory
;
1580 GCPRO2 (buffer
, current_dir
);
1583 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1585 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1586 report_file_error ("Setting current directory",
1587 Fcons (current_buffer
->directory
, Qnil
));
1593 CHECK_STRING (name
);
1597 CHECK_STRING (program
);
1599 proc
= make_process (name
);
1600 /* If an error occurs and we can't start the process, we want to
1601 remove it from the process list. This means that each error
1602 check in create_process doesn't need to call remove_process
1603 itself; it's all taken care of here. */
1604 record_unwind_protect (start_process_unwind
, proc
);
1606 XPROCESS (proc
)->childp
= Qt
;
1607 XPROCESS (proc
)->plist
= Qnil
;
1608 XPROCESS (proc
)->buffer
= buffer
;
1609 XPROCESS (proc
)->sentinel
= Qnil
;
1610 XPROCESS (proc
)->filter
= Qnil
;
1611 XPROCESS (proc
)->filter_multibyte
1612 = buffer_defaults
.enable_multibyte_characters
;
1613 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1615 #ifdef ADAPTIVE_READ_BUFFERING
1616 XPROCESS (proc
)->adaptive_read_buffering
= Vprocess_adaptive_read_buffering
;
1619 /* Make the process marker point into the process buffer (if any). */
1620 if (BUFFERP (buffer
))
1621 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1622 BUF_ZV (XBUFFER (buffer
)),
1623 BUF_ZV_BYTE (XBUFFER (buffer
)));
1626 /* Decide coding systems for communicating with the process. Here
1627 we don't setup the structure coding_system nor pay attention to
1628 unibyte mode. They are done in create_process. */
1630 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1631 Lisp_Object coding_systems
= Qt
;
1632 Lisp_Object val
, *args2
;
1633 struct gcpro gcpro1
, gcpro2
;
1635 val
= Vcoding_system_for_read
;
1638 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1639 args2
[0] = Qstart_process
;
1640 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1641 GCPRO2 (proc
, current_dir
);
1642 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1644 if (CONSP (coding_systems
))
1645 val
= XCAR (coding_systems
);
1646 else if (CONSP (Vdefault_process_coding_system
))
1647 val
= XCAR (Vdefault_process_coding_system
);
1649 XPROCESS (proc
)->decode_coding_system
= val
;
1651 val
= Vcoding_system_for_write
;
1654 if (EQ (coding_systems
, Qt
))
1656 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1657 args2
[0] = Qstart_process
;
1658 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1659 GCPRO2 (proc
, current_dir
);
1660 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1663 if (CONSP (coding_systems
))
1664 val
= XCDR (coding_systems
);
1665 else if (CONSP (Vdefault_process_coding_system
))
1666 val
= XCDR (Vdefault_process_coding_system
);
1668 XPROCESS (proc
)->encode_coding_system
= val
;
1672 /* Make a one member argv with all args concatenated
1673 together separated by a blank. */
1674 len
= SBYTES (program
) + 2;
1675 for (i
= 3; i
< nargs
; i
++)
1679 len
+= SBYTES (tem
) + 1; /* count the blank */
1681 new_argv
= (unsigned char *) alloca (len
);
1682 strcpy (new_argv
, SDATA (program
));
1683 for (i
= 3; i
< nargs
; i
++)
1687 strcat (new_argv
, " ");
1688 strcat (new_argv
, SDATA (tem
));
1690 /* Need to add code here to check for program existence on VMS */
1693 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1695 /* If program file name is not absolute, search our path for it.
1696 Put the name we will really use in TEM. */
1697 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1698 && !(SCHARS (program
) > 1
1699 && IS_DEVICE_SEP (SREF (program
, 1))))
1701 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1704 GCPRO4 (name
, program
, buffer
, current_dir
);
1705 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1708 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1709 tem
= Fexpand_file_name (tem
, Qnil
);
1713 if (!NILP (Ffile_directory_p (program
)))
1714 error ("Specified program for new process is a directory");
1718 /* If program file name starts with /: for quoting a magic name,
1720 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1721 && SREF (tem
, 1) == ':')
1722 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1724 /* Encode the file name and put it in NEW_ARGV.
1725 That's where the child will use it to execute the program. */
1726 tem
= ENCODE_FILE (tem
);
1727 new_argv
[0] = SDATA (tem
);
1729 /* Here we encode arguments by the coding system used for sending
1730 data to the process. We don't support using different coding
1731 systems for encoding arguments and for encoding data sent to the
1734 for (i
= 3; i
< nargs
; i
++)
1738 if (STRING_MULTIBYTE (tem
))
1739 tem
= (code_convert_string_norecord
1740 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1741 new_argv
[i
- 2] = SDATA (tem
);
1743 new_argv
[i
- 2] = 0;
1744 #endif /* not VMS */
1746 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1747 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1748 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1749 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1751 XPROCESS (proc
)->inherit_coding_system_flag
1752 = (NILP (buffer
) || !inherit_process_coding_system
1755 create_process (proc
, (char **) new_argv
, current_dir
);
1757 return unbind_to (count
, proc
);
1760 /* This function is the unwind_protect form for Fstart_process. If
1761 PROC doesn't have its pid set, then we know someone has signaled
1762 an error and the process wasn't started successfully, so we should
1763 remove it from the process list. */
1765 start_process_unwind (proc
)
1768 if (!PROCESSP (proc
))
1771 /* Was PROC started successfully? */
1772 if (XPROCESS (proc
)->pid
<= 0)
1773 remove_process (proc
);
1779 create_process_1 (timer
)
1780 struct atimer
*timer
;
1782 /* Nothing to do. */
1786 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1789 /* Mimic blocking of signals on system V, which doesn't really have it. */
1791 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1792 int sigchld_deferred
;
1795 create_process_sigchld ()
1797 signal (SIGCHLD
, create_process_sigchld
);
1799 sigchld_deferred
= 1;
1805 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1807 create_process (process
, new_argv
, current_dir
)
1808 Lisp_Object process
;
1810 Lisp_Object current_dir
;
1812 int pid
, inchannel
, outchannel
;
1814 #ifdef POSIX_SIGNALS
1817 struct sigaction sigint_action
;
1818 struct sigaction sigquit_action
;
1820 struct sigaction sighup_action
;
1822 #else /* !POSIX_SIGNALS */
1825 SIGTYPE (*sigchld
)();
1828 #endif /* !POSIX_SIGNALS */
1829 /* Use volatile to protect variables from being clobbered by longjmp. */
1830 volatile int forkin
, forkout
;
1831 volatile int pty_flag
= 0;
1833 extern char **environ
;
1836 inchannel
= outchannel
= -1;
1839 if (!NILP (Vprocess_connection_type
))
1840 outchannel
= inchannel
= allocate_pty ();
1844 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1845 /* On most USG systems it does not work to open the pty's tty here,
1846 then close it and reopen it in the child. */
1848 /* Don't let this terminal become our controlling terminal
1849 (in case we don't have one). */
1850 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1852 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1855 report_file_error ("Opening pty", Qnil
);
1856 #if defined (RTU) || defined (UNIPLUS) || defined (DONT_REOPEN_PTY)
1857 /* In the case that vfork is defined as fork, the parent process
1858 (Emacs) may send some data before the child process completes
1859 tty options setup. So we setup tty before forking. */
1860 child_setup_tty (forkout
);
1861 #endif /* RTU or UNIPLUS or DONT_REOPEN_PTY */
1863 forkin
= forkout
= -1;
1864 #endif /* not USG, or USG_SUBTTY_WORKS */
1868 #endif /* HAVE_PTYS */
1871 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1872 report_file_error ("Opening socketpair", Qnil
);
1873 outchannel
= inchannel
= sv
[0];
1874 forkout
= forkin
= sv
[1];
1876 #else /* not SKTPAIR */
1881 report_file_error ("Creating pipe", Qnil
);
1887 emacs_close (inchannel
);
1888 emacs_close (forkout
);
1889 report_file_error ("Creating pipe", Qnil
);
1894 #endif /* not SKTPAIR */
1897 /* Replaced by close_process_descs */
1898 set_exclusive_use (inchannel
);
1899 set_exclusive_use (outchannel
);
1902 /* Stride people say it's a mystery why this is needed
1903 as well as the O_NDELAY, but that it fails without this. */
1904 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1907 ioctl (inchannel
, FIONBIO
, &one
);
1912 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1913 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1916 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1917 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1921 /* Record this as an active process, with its channels.
1922 As a result, child_setup will close Emacs's side of the pipes. */
1923 chan_process
[inchannel
] = process
;
1924 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1925 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1927 /* Previously we recorded the tty descriptor used in the subprocess.
1928 It was only used for getting the foreground tty process, so now
1929 we just reopen the device (see emacs_get_tty_pgrp) as this is
1930 more portable (see USG_SUBTTY_WORKS above). */
1932 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1933 XPROCESS (process
)->status
= Qrun
;
1934 setup_process_coding_systems (process
);
1936 /* Delay interrupts until we have a chance to store
1937 the new fork's pid in its process structure */
1938 #ifdef POSIX_SIGNALS
1939 sigemptyset (&blocked
);
1941 sigaddset (&blocked
, SIGCHLD
);
1943 #ifdef HAVE_WORKING_VFORK
1944 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1945 this sets the parent's signal handlers as well as the child's.
1946 So delay all interrupts whose handlers the child might munge,
1947 and record the current handlers so they can be restored later. */
1948 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1949 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1951 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1953 #endif /* HAVE_WORKING_VFORK */
1954 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1955 #else /* !POSIX_SIGNALS */
1959 #else /* not BSD4_1 */
1960 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1961 sigsetmask (sigmask (SIGCHLD
));
1962 #else /* ordinary USG */
1964 sigchld_deferred
= 0;
1965 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1967 #endif /* ordinary USG */
1968 #endif /* not BSD4_1 */
1969 #endif /* SIGCHLD */
1970 #endif /* !POSIX_SIGNALS */
1972 FD_SET (inchannel
, &input_wait_mask
);
1973 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1974 if (inchannel
> max_process_desc
)
1975 max_process_desc
= inchannel
;
1977 /* Until we store the proper pid, enable sigchld_handler
1978 to recognize an unknown pid as standing for this process.
1979 It is very important not to let this `marker' value stay
1980 in the table after this function has returned; if it does
1981 it might cause call-process to hang and subsequent asynchronous
1982 processes to get their return values scrambled. */
1983 XPROCESS (process
)->pid
= -1;
1988 /* child_setup must clobber environ on systems with true vfork.
1989 Protect it from permanent change. */
1990 char **save_environ
= environ
;
1992 current_dir
= ENCODE_FILE (current_dir
);
1997 #endif /* not WINDOWSNT */
1999 int xforkin
= forkin
;
2000 int xforkout
= forkout
;
2002 #if 0 /* This was probably a mistake--it duplicates code later on,
2003 but fails to handle all the cases. */
2004 /* Make sure SIGCHLD is not blocked in the child. */
2005 sigsetmask (SIGEMPTYMASK
);
2008 /* Make the pty be the controlling terminal of the process. */
2010 /* First, disconnect its current controlling terminal. */
2012 /* We tried doing setsid only if pty_flag, but it caused
2013 process_set_signal to fail on SGI when using a pipe. */
2015 /* Make the pty's terminal the controlling terminal. */
2019 /* We ignore the return value
2020 because faith@cs.unc.edu says that is necessary on Linux. */
2021 ioctl (xforkin
, TIOCSCTTY
, 0);
2024 #else /* not HAVE_SETSID */
2026 /* It's very important to call setpgrp here and no time
2027 afterwards. Otherwise, we lose our controlling tty which
2028 is set when we open the pty. */
2031 #endif /* not HAVE_SETSID */
2032 #if defined (HAVE_TERMIOS) && defined (LDISC1)
2033 if (pty_flag
&& xforkin
>= 0)
2036 tcgetattr (xforkin
, &t
);
2038 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
2039 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
2042 #if defined (NTTYDISC) && defined (TIOCSETD)
2043 if (pty_flag
&& xforkin
>= 0)
2045 /* Use new line discipline. */
2046 int ldisc
= NTTYDISC
;
2047 ioctl (xforkin
, TIOCSETD
, &ldisc
);
2052 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2053 can do TIOCSPGRP only to the process's controlling tty. */
2056 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2057 I can't test it since I don't have 4.3. */
2058 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
2059 ioctl (j
, TIOCNOTTY
, 0);
2062 /* In order to get a controlling terminal on some versions
2063 of BSD, it is necessary to put the process in pgrp 0
2064 before it opens the terminal. */
2072 #endif /* TIOCNOTTY */
2074 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2075 /*** There is a suggestion that this ought to be a
2076 conditional on TIOCSPGRP,
2077 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2078 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2079 that system does seem to need this code, even though
2080 both HAVE_SETSID and TIOCSCTTY are defined. */
2081 /* Now close the pty (if we had it open) and reopen it.
2082 This makes the pty the controlling terminal of the subprocess. */
2085 #ifdef SET_CHILD_PTY_PGRP
2086 int pgrp
= getpid ();
2089 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2092 emacs_close (xforkin
);
2093 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2097 emacs_write (1, "Couldn't open the pty terminal ", 31);
2098 emacs_write (1, pty_name
, strlen (pty_name
));
2099 emacs_write (1, "\n", 1);
2103 #ifdef SET_CHILD_PTY_PGRP
2104 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
2105 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
2108 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
2110 #ifdef SETUP_SLAVE_PTY
2115 #endif /* SETUP_SLAVE_PTY */
2117 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2118 Now reenable it in the child, so it will die when we want it to. */
2120 signal (SIGHUP
, SIG_DFL
);
2122 #endif /* HAVE_PTYS */
2124 signal (SIGINT
, SIG_DFL
);
2125 signal (SIGQUIT
, SIG_DFL
);
2127 /* Stop blocking signals in the child. */
2128 #ifdef POSIX_SIGNALS
2129 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2130 #else /* !POSIX_SIGNALS */
2134 #else /* not BSD4_1 */
2135 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2136 sigsetmask (SIGEMPTYMASK
);
2137 #else /* ordinary USG */
2139 signal (SIGCHLD
, sigchld
);
2141 #endif /* ordinary USG */
2142 #endif /* not BSD4_1 */
2143 #endif /* SIGCHLD */
2144 #endif /* !POSIX_SIGNALS */
2146 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2148 child_setup_tty (xforkout
);
2149 #endif /* not RTU and not UNIPLUS and not DONT_REOPEN_PTY */
2151 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2152 new_argv
, 1, current_dir
);
2153 #else /* not WINDOWSNT */
2154 child_setup (xforkin
, xforkout
, xforkout
,
2155 new_argv
, 1, current_dir
);
2156 #endif /* not WINDOWSNT */
2158 environ
= save_environ
;
2163 /* This runs in the Emacs process. */
2167 emacs_close (forkin
);
2168 if (forkin
!= forkout
&& forkout
>= 0)
2169 emacs_close (forkout
);
2173 /* vfork succeeded. */
2174 XPROCESS (process
)->pid
= pid
;
2177 register_child (pid
, inchannel
);
2178 #endif /* WINDOWSNT */
2180 /* If the subfork execv fails, and it exits,
2181 this close hangs. I don't know why.
2182 So have an interrupt jar it loose. */
2184 struct atimer
*timer
;
2188 EMACS_SET_SECS_USECS (offset
, 1, 0);
2189 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2192 emacs_close (forkin
);
2194 cancel_atimer (timer
);
2198 if (forkin
!= forkout
&& forkout
>= 0)
2199 emacs_close (forkout
);
2203 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2206 XPROCESS (process
)->tty_name
= Qnil
;
2209 /* Restore the signal state whether vfork succeeded or not.
2210 (We will signal an error, below, if it failed.) */
2211 #ifdef POSIX_SIGNALS
2212 #ifdef HAVE_WORKING_VFORK
2213 /* Restore the parent's signal handlers. */
2214 sigaction (SIGINT
, &sigint_action
, 0);
2215 sigaction (SIGQUIT
, &sigquit_action
, 0);
2217 sigaction (SIGHUP
, &sighup_action
, 0);
2219 #endif /* HAVE_WORKING_VFORK */
2220 /* Stop blocking signals in the parent. */
2221 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2222 #else /* !POSIX_SIGNALS */
2226 #else /* not BSD4_1 */
2227 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2228 sigsetmask (SIGEMPTYMASK
);
2229 #else /* ordinary USG */
2231 signal (SIGCHLD
, sigchld
);
2232 /* Now really handle any of these signals
2233 that came in during this function. */
2234 if (sigchld_deferred
)
2235 kill (getpid (), SIGCHLD
);
2237 #endif /* ordinary USG */
2238 #endif /* not BSD4_1 */
2239 #endif /* SIGCHLD */
2240 #endif /* !POSIX_SIGNALS */
2242 /* Now generate the error if vfork failed. */
2244 report_file_error ("Doing vfork", Qnil
);
2246 #endif /* not VMS */
2251 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2252 The address family of sa is not included in the result. */
2255 conv_sockaddr_to_lisp (sa
, len
)
2256 struct sockaddr
*sa
;
2259 Lisp_Object address
;
2262 register struct Lisp_Vector
*p
;
2264 switch (sa
->sa_family
)
2268 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2269 len
= sizeof (sin
->sin_addr
) + 1;
2270 address
= Fmake_vector (make_number (len
), Qnil
);
2271 p
= XVECTOR (address
);
2272 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2273 cp
= (unsigned char *)&sin
->sin_addr
;
2279 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2280 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2281 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2282 address
= Fmake_vector (make_number (len
), Qnil
);
2283 p
= XVECTOR (address
);
2284 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2285 for (i
= 0; i
< len
; i
++)
2286 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2290 #ifdef HAVE_LOCAL_SOCKETS
2293 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2294 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2295 if (sockun
->sun_path
[i
] == 0)
2297 return make_unibyte_string (sockun
->sun_path
, i
);
2301 len
-= sizeof (sa
->sa_family
);
2302 address
= Fcons (make_number (sa
->sa_family
),
2303 Fmake_vector (make_number (len
), Qnil
));
2304 p
= XVECTOR (XCDR (address
));
2305 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2311 p
->contents
[i
++] = make_number (*cp
++);
2317 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2320 get_lisp_to_sockaddr_size (address
, familyp
)
2321 Lisp_Object address
;
2324 register struct Lisp_Vector
*p
;
2326 if (VECTORP (address
))
2328 p
= XVECTOR (address
);
2332 return sizeof (struct sockaddr_in
);
2335 else if (p
->size
== 9)
2337 *familyp
= AF_INET6
;
2338 return sizeof (struct sockaddr_in6
);
2342 #ifdef HAVE_LOCAL_SOCKETS
2343 else if (STRINGP (address
))
2345 *familyp
= AF_LOCAL
;
2346 return sizeof (struct sockaddr_un
);
2349 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2351 struct sockaddr
*sa
;
2352 *familyp
= XINT (XCAR (address
));
2353 p
= XVECTOR (XCDR (address
));
2354 return p
->size
+ sizeof (sa
->sa_family
);
2359 /* Convert an address object (vector or string) to an internal sockaddr.
2361 The address format has been basically validated by
2362 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2363 it could have come from user data. So if FAMILY is not valid,
2364 we return after zeroing *SA. */
2367 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2369 Lisp_Object address
;
2370 struct sockaddr
*sa
;
2373 register struct Lisp_Vector
*p
;
2374 register unsigned char *cp
= NULL
;
2379 if (VECTORP (address
))
2381 p
= XVECTOR (address
);
2382 if (family
== AF_INET
)
2384 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2385 len
= sizeof (sin
->sin_addr
) + 1;
2386 i
= XINT (p
->contents
[--len
]);
2387 sin
->sin_port
= htons (i
);
2388 cp
= (unsigned char *)&sin
->sin_addr
;
2389 sa
->sa_family
= family
;
2392 else if (family
== AF_INET6
)
2394 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2395 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2396 len
= sizeof (sin6
->sin6_addr
) + 1;
2397 i
= XINT (p
->contents
[--len
]);
2398 sin6
->sin6_port
= htons (i
);
2399 for (i
= 0; i
< len
; i
++)
2400 if (INTEGERP (p
->contents
[i
]))
2402 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2405 sa
->sa_family
= family
;
2410 else if (STRINGP (address
))
2412 #ifdef HAVE_LOCAL_SOCKETS
2413 if (family
== AF_LOCAL
)
2415 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2416 cp
= SDATA (address
);
2417 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2418 sockun
->sun_path
[i
] = *cp
++;
2419 sa
->sa_family
= family
;
2426 p
= XVECTOR (XCDR (address
));
2427 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2430 for (i
= 0; i
< len
; i
++)
2431 if (INTEGERP (p
->contents
[i
]))
2432 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2435 #ifdef DATAGRAM_SOCKETS
2436 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2438 doc
: /* Get the current datagram address associated with PROCESS. */)
2440 Lisp_Object process
;
2444 CHECK_PROCESS (process
);
2446 if (!DATAGRAM_CONN_P (process
))
2449 channel
= XINT (XPROCESS (process
)->infd
);
2450 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2451 datagram_address
[channel
].len
);
2454 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2456 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2457 Returns nil upon error setting address, ADDRESS otherwise. */)
2459 Lisp_Object process
, address
;
2464 CHECK_PROCESS (process
);
2466 if (!DATAGRAM_CONN_P (process
))
2469 channel
= XINT (XPROCESS (process
)->infd
);
2471 len
= get_lisp_to_sockaddr_size (address
, &family
);
2472 if (datagram_address
[channel
].len
!= len
)
2474 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2480 static struct socket_options
{
2481 /* The name of this option. Should be lowercase version of option
2482 name without SO_ prefix. */
2484 /* Option level SOL_... */
2486 /* Option number SO_... */
2488 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2489 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2490 } socket_options
[] =
2492 #ifdef SO_BINDTODEVICE
2493 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2496 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2499 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2502 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2505 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2508 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2511 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2514 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2516 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2519 /* Set option OPT to value VAL on socket S.
2521 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2522 Signals an error if setting a known option fails.
2526 set_socket_option (s
, opt
, val
)
2528 Lisp_Object opt
, val
;
2531 struct socket_options
*sopt
;
2536 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2537 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2538 if (strcmp (name
, sopt
->name
) == 0)
2541 switch (sopt
->opttype
)
2546 optval
= NILP (val
) ? 0 : 1;
2547 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2548 &optval
, sizeof (optval
));
2556 optval
= XINT (val
);
2558 error ("Bad option value for %s", name
);
2559 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2560 &optval
, sizeof (optval
));
2564 #ifdef SO_BINDTODEVICE
2567 char devname
[IFNAMSIZ
+1];
2569 /* This is broken, at least in the Linux 2.4 kernel.
2570 To unbind, the arg must be a zero integer, not the empty string.
2571 This should work on all systems. KFS. 2003-09-23. */
2572 bzero (devname
, sizeof devname
);
2575 char *arg
= (char *) SDATA (val
);
2576 int len
= min (strlen (arg
), IFNAMSIZ
);
2577 bcopy (arg
, devname
, len
);
2579 else if (!NILP (val
))
2580 error ("Bad option value for %s", name
);
2581 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2590 struct linger linger
;
2593 linger
.l_linger
= 0;
2595 linger
.l_linger
= XINT (val
);
2597 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2598 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2599 &linger
, sizeof (linger
));
2609 report_file_error ("Cannot set network option",
2610 Fcons (opt
, Fcons (val
, Qnil
)));
2611 return (1 << sopt
->optbit
);
2615 DEFUN ("set-network-process-option",
2616 Fset_network_process_option
, Sset_network_process_option
,
2618 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2619 See `make-network-process' for a list of options and values.
2620 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2621 OPTION is not a supported option, return nil instead; otherwise return t. */)
2622 (process
, option
, value
, no_error
)
2623 Lisp_Object process
, option
, value
;
2624 Lisp_Object no_error
;
2627 struct Lisp_Process
*p
;
2629 CHECK_PROCESS (process
);
2630 p
= XPROCESS (process
);
2631 if (!NETCONN1_P (p
))
2632 error ("Process is not a network process");
2636 error ("Process is not running");
2638 if (set_socket_option (s
, option
, value
))
2640 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2644 if (NILP (no_error
))
2645 error ("Unknown or unsupported option");
2651 /* A version of request_sigio suitable for a record_unwind_protect. */
2654 unwind_request_sigio (dummy
)
2657 if (interrupt_input
)
2662 /* Create a network stream/datagram client/server process. Treated
2663 exactly like a normal process when reading and writing. Primary
2664 differences are in status display and process deletion. A network
2665 connection has no PID; you cannot signal it. All you can do is
2666 stop/continue it and deactivate/close it via delete-process */
2668 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2670 doc
: /* Create and return a network server or client process.
2672 In Emacs, network connections are represented by process objects, so
2673 input and output work as for subprocesses and `delete-process' closes
2674 a network connection. However, a network process has no process id,
2675 it cannot be signaled, and the status codes are different from normal
2678 Arguments are specified as keyword/argument pairs. The following
2679 arguments are defined:
2681 :name NAME -- NAME is name for process. It is modified if necessary
2684 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2685 with the process. Process output goes at end of that buffer, unless
2686 you specify an output stream or filter function to handle the output.
2687 BUFFER may be also nil, meaning that this process is not associated
2690 :host HOST -- HOST is name of the host to connect to, or its IP
2691 address. The symbol `local' specifies the local host. If specified
2692 for a server process, it must be a valid name or address for the local
2693 host, and only clients connecting to that address will be accepted.
2695 :service SERVICE -- SERVICE is name of the service desired, or an
2696 integer specifying a port number to connect to. If SERVICE is t,
2697 a random port number is selected for the server.
2699 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2700 stream type connection, `datagram' creates a datagram type connection.
2702 :family FAMILY -- FAMILY is the address (and protocol) family for the
2703 service specified by HOST and SERVICE. The default (nil) is to use
2704 whatever address family (IPv4 or IPv6) that is defined for the host
2705 and port number specified by HOST and SERVICE. Other address families
2707 local -- for a local (i.e. UNIX) address specified by SERVICE.
2708 ipv4 -- use IPv4 address family only.
2709 ipv6 -- use IPv6 address family only.
2711 :local ADDRESS -- ADDRESS is the local address used for the connection.
2712 This parameter is ignored when opening a client process. When specified
2713 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2715 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2716 connection. This parameter is ignored when opening a stream server
2717 process. For a datagram server process, it specifies the initial
2718 setting of the remote datagram address. When specified for a client
2719 process, the FAMILY, HOST, and SERVICE args are ignored.
2721 The format of ADDRESS depends on the address family:
2722 - An IPv4 address is represented as an vector of integers [A B C D P]
2723 corresponding to numeric IP address A.B.C.D and port number P.
2724 - A local address is represented as a string with the address in the
2725 local address space.
2726 - An "unsupported family" address is represented by a cons (F . AV)
2727 where F is the family number and AV is a vector containing the socket
2728 address data with one element per address data byte. Do not rely on
2729 this format in portable code, as it may depend on implementation
2730 defined constants, data sizes, and data structure alignment.
2732 :coding CODING -- If CODING is a symbol, it specifies the coding
2733 system used for both reading and writing for this process. If CODING
2734 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2735 ENCODING is used for writing.
2737 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2738 return without waiting for the connection to complete; instead, the
2739 sentinel function will be called with second arg matching "open" (if
2740 successful) or "failed" when the connect completes. Default is to use
2741 a blocking connect (i.e. wait) for stream type connections.
2743 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2744 running when Emacs is exited.
2746 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2747 In the stopped state, a server process does not accept new
2748 connections, and a client process does not handle incoming traffic.
2749 The stopped state is cleared by `continue-process' and set by
2752 :filter FILTER -- Install FILTER as the process filter.
2754 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2755 process filter are multibyte, otherwise they are unibyte.
2756 If this keyword is not specified, the strings are multibyte iff
2757 `default-enable-multibyte-characters' is non-nil.
2759 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2761 :log LOG -- Install LOG as the server process log function. This
2762 function is called when the server accepts a network connection from a
2763 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2764 is the server process, CLIENT is the new process for the connection,
2765 and MESSAGE is a string.
2767 :plist PLIST -- Install PLIST as the new process' initial plist.
2769 :server QLEN -- if QLEN is non-nil, create a server process for the
2770 specified FAMILY, SERVICE, and connection type (stream or datagram).
2771 If QLEN is an integer, it is used as the max. length of the server's
2772 pending connection queue (also known as the backlog); the default
2773 queue length is 5. Default is to create a client process.
2775 The following network options can be specified for this connection:
2777 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2778 :dontroute BOOL -- Only send to directly connected hosts.
2779 :keepalive BOOL -- Send keep-alive messages on network stream.
2780 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2781 :oobinline BOOL -- Place out-of-band data in receive data stream.
2782 :priority INT -- Set protocol defined priority for sent packets.
2783 :reuseaddr BOOL -- Allow reusing a recently used local address
2784 (this is allowed by default for a server process).
2785 :bindtodevice NAME -- bind to interface NAME. Using this may require
2786 special privileges on some systems.
2788 Consult the relevant system programmer's manual pages for more
2789 information on using these options.
2792 A server process will listen for and accept connections from clients.
2793 When a client connection is accepted, a new network process is created
2794 for the connection with the following parameters:
2796 - The client's process name is constructed by concatenating the server
2797 process' NAME and a client identification string.
2798 - If the FILTER argument is non-nil, the client process will not get a
2799 separate process buffer; otherwise, the client's process buffer is a newly
2800 created buffer named after the server process' BUFFER name or process
2801 NAME concatenated with the client identification string.
2802 - The connection type and the process filter and sentinel parameters are
2803 inherited from the server process' TYPE, FILTER and SENTINEL.
2804 - The client process' contact info is set according to the client's
2805 addressing information (typically an IP address and a port number).
2806 - The client process' plist is initialized from the server's plist.
2808 Notice that the FILTER and SENTINEL args are never used directly by
2809 the server process. Also, the BUFFER argument is not used directly by
2810 the server process, but via the optional :log function, accepted (and
2811 failed) connections may be logged in the server process' buffer.
2813 The original argument list, modified with the actual connection
2814 information, is available via the `process-contact' function.
2816 usage: (make-network-process &rest ARGS) */)
2822 Lisp_Object contact
;
2823 struct Lisp_Process
*p
;
2824 #ifdef HAVE_GETADDRINFO
2825 struct addrinfo ai
, *res
, *lres
;
2826 struct addrinfo hints
;
2827 char *portstring
, portbuf
[128];
2828 #else /* HAVE_GETADDRINFO */
2829 struct _emacs_addrinfo
2835 struct sockaddr
*ai_addr
;
2836 struct _emacs_addrinfo
*ai_next
;
2838 #endif /* HAVE_GETADDRINFO */
2839 struct sockaddr_in address_in
;
2840 #ifdef HAVE_LOCAL_SOCKETS
2841 struct sockaddr_un address_un
;
2846 int s
= -1, outch
, inch
;
2847 struct gcpro gcpro1
;
2848 int count
= SPECPDL_INDEX ();
2850 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2852 Lisp_Object name
, buffer
, host
, service
, address
;
2853 Lisp_Object filter
, sentinel
;
2854 int is_non_blocking_client
= 0;
2855 int is_server
= 0, backlog
= 5;
2862 /* Save arguments for process-contact and clone-process. */
2863 contact
= Flist (nargs
, args
);
2867 /* Ensure socket support is loaded if available. */
2868 init_winsock (TRUE
);
2871 /* :type TYPE (nil: stream, datagram */
2872 tem
= Fplist_get (contact
, QCtype
);
2874 socktype
= SOCK_STREAM
;
2875 #ifdef DATAGRAM_SOCKETS
2876 else if (EQ (tem
, Qdatagram
))
2877 socktype
= SOCK_DGRAM
;
2880 error ("Unsupported connection type");
2883 tem
= Fplist_get (contact
, QCserver
);
2886 /* Don't support network sockets when non-blocking mode is
2887 not available, since a blocked Emacs is not useful. */
2888 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2889 error ("Network servers not supported");
2893 backlog
= XINT (tem
);
2897 /* Make QCaddress an alias for :local (server) or :remote (client). */
2898 QCaddress
= is_server
? QClocal
: QCremote
;
2901 if (!is_server
&& socktype
== SOCK_STREAM
2902 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2904 #ifndef NON_BLOCKING_CONNECT
2905 error ("Non-blocking connect not supported");
2907 is_non_blocking_client
= 1;
2911 name
= Fplist_get (contact
, QCname
);
2912 buffer
= Fplist_get (contact
, QCbuffer
);
2913 filter
= Fplist_get (contact
, QCfilter
);
2914 sentinel
= Fplist_get (contact
, QCsentinel
);
2916 CHECK_STRING (name
);
2919 /* Let's handle TERM before things get complicated ... */
2920 host
= Fplist_get (contact
, QChost
);
2921 CHECK_STRING (host
);
2923 service
= Fplist_get (contact
, QCservice
);
2924 if (INTEGERP (service
))
2925 port
= htons ((unsigned short) XINT (service
));
2928 struct servent
*svc_info
;
2929 CHECK_STRING (service
);
2930 svc_info
= getservbyname (SDATA (service
), "tcp");
2932 error ("Unknown service: %s", SDATA (service
));
2933 port
= svc_info
->s_port
;
2936 s
= connect_server (0);
2938 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2939 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2940 send_command (s
, C_DUMB
, 1, 0);
2942 #else /* not TERM */
2944 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2945 ai
.ai_socktype
= socktype
;
2950 /* :local ADDRESS or :remote ADDRESS */
2951 address
= Fplist_get (contact
, QCaddress
);
2952 if (!NILP (address
))
2954 host
= service
= Qnil
;
2956 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2957 error ("Malformed :address");
2958 ai
.ai_family
= family
;
2959 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2960 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2964 /* :family FAMILY -- nil (for Inet), local, or integer. */
2965 tem
= Fplist_get (contact
, QCfamily
);
2968 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
2974 #ifdef HAVE_LOCAL_SOCKETS
2975 else if (EQ (tem
, Qlocal
))
2979 else if (EQ (tem
, Qipv6
))
2982 else if (EQ (tem
, Qipv4
))
2984 else if (INTEGERP (tem
))
2985 family
= XINT (tem
);
2987 error ("Unknown address family");
2989 ai
.ai_family
= family
;
2991 /* :service SERVICE -- string, integer (port number), or t (random port). */
2992 service
= Fplist_get (contact
, QCservice
);
2994 #ifdef HAVE_LOCAL_SOCKETS
2995 if (family
== AF_LOCAL
)
2997 /* Host is not used. */
2999 CHECK_STRING (service
);
3000 bzero (&address_un
, sizeof address_un
);
3001 address_un
.sun_family
= AF_LOCAL
;
3002 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
3003 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
3004 ai
.ai_addrlen
= sizeof address_un
;
3009 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3010 host
= Fplist_get (contact
, QChost
);
3013 if (EQ (host
, Qlocal
))
3014 host
= build_string ("localhost");
3015 CHECK_STRING (host
);
3018 /* Slow down polling to every ten seconds.
3019 Some kernels have a bug which causes retrying connect to fail
3020 after a connect. Polling can interfere with gethostbyname too. */
3021 #ifdef POLL_FOR_INPUT
3022 if (socktype
== SOCK_STREAM
)
3024 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
3025 bind_polling_period (10);
3029 #ifdef HAVE_GETADDRINFO
3030 /* If we have a host, use getaddrinfo to resolve both host and service.
3031 Otherwise, use getservbyname to lookup the service. */
3035 /* SERVICE can either be a string or int.
3036 Convert to a C string for later use by getaddrinfo. */
3037 if (EQ (service
, Qt
))
3039 else if (INTEGERP (service
))
3041 sprintf (portbuf
, "%ld", (long) XINT (service
));
3042 portstring
= portbuf
;
3046 CHECK_STRING (service
);
3047 portstring
= SDATA (service
);
3052 memset (&hints
, 0, sizeof (hints
));
3054 hints
.ai_family
= family
;
3055 hints
.ai_socktype
= socktype
;
3056 hints
.ai_protocol
= 0;
3057 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3059 #ifdef HAVE_GAI_STRERROR
3060 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
3062 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3068 #endif /* HAVE_GETADDRINFO */
3070 /* We end up here if getaddrinfo is not defined, or in case no hostname
3071 has been specified (e.g. for a local server process). */
3073 if (EQ (service
, Qt
))
3075 else if (INTEGERP (service
))
3076 port
= htons ((unsigned short) XINT (service
));
3079 struct servent
*svc_info
;
3080 CHECK_STRING (service
);
3081 svc_info
= getservbyname (SDATA (service
),
3082 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3084 error ("Unknown service: %s", SDATA (service
));
3085 port
= svc_info
->s_port
;
3088 bzero (&address_in
, sizeof address_in
);
3089 address_in
.sin_family
= family
;
3090 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3091 address_in
.sin_port
= port
;
3093 #ifndef HAVE_GETADDRINFO
3096 struct hostent
*host_info_ptr
;
3098 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3099 as it may `hang' Emacs for a very long time. */
3102 host_info_ptr
= gethostbyname (SDATA (host
));
3107 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
3108 host_info_ptr
->h_length
);
3109 family
= host_info_ptr
->h_addrtype
;
3110 address_in
.sin_family
= family
;
3113 /* Attempt to interpret host as numeric inet address */
3115 IN_ADDR numeric_addr
;
3116 numeric_addr
= inet_addr ((char *) SDATA (host
));
3117 if (NUMERIC_ADDR_ERROR
)
3118 error ("Unknown host \"%s\"", SDATA (host
));
3120 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
3121 sizeof (address_in
.sin_addr
));
3125 #endif /* not HAVE_GETADDRINFO */
3127 ai
.ai_family
= family
;
3128 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3129 ai
.ai_addrlen
= sizeof address_in
;
3133 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
3134 when connect is interrupted. So let's not let it get interrupted.
3135 Note we do not turn off polling, because polling is only used
3136 when not interrupt_input, and thus not normally used on the systems
3137 which have this bug. On systems which use polling, there's no way
3138 to quit if polling is turned off. */
3140 && !is_server
&& socktype
== SOCK_STREAM
)
3142 /* Comment from KFS: The original open-network-stream code
3143 didn't unwind protect this, but it seems like the proper
3144 thing to do. In any case, I don't see how it could harm to
3145 do this -- and it makes cleanup (using unbind_to) easier. */
3146 record_unwind_protect (unwind_request_sigio
, Qnil
);
3150 /* Do this in case we never enter the for-loop below. */
3151 count1
= SPECPDL_INDEX ();
3154 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3160 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3167 #ifdef DATAGRAM_SOCKETS
3168 if (!is_server
&& socktype
== SOCK_DGRAM
)
3170 #endif /* DATAGRAM_SOCKETS */
3172 #ifdef NON_BLOCKING_CONNECT
3173 if (is_non_blocking_client
)
3176 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3178 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3190 /* Make us close S if quit. */
3191 record_unwind_protect (close_file_unwind
, make_number (s
));
3193 /* Parse network options in the arg list.
3194 We simply ignore anything which isn't a known option (including other keywords).
3195 An error is signalled if setting a known option fails. */
3196 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3197 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3201 /* Configure as a server socket. */
3203 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3204 explicit :reuseaddr key to override this. */
3205 #ifdef HAVE_LOCAL_SOCKETS
3206 if (family
!= AF_LOCAL
)
3208 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3211 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3212 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3215 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3216 report_file_error ("Cannot bind server socket", Qnil
);
3218 #ifdef HAVE_GETSOCKNAME
3219 if (EQ (service
, Qt
))
3221 struct sockaddr_in sa1
;
3222 int len1
= sizeof (sa1
);
3223 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3225 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3226 service
= make_number (ntohs (sa1
.sin_port
));
3227 contact
= Fplist_put (contact
, QCservice
, service
);
3232 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3233 report_file_error ("Cannot listen on server socket", Qnil
);
3241 /* This turns off all alarm-based interrupts; the
3242 bind_polling_period call above doesn't always turn all the
3243 short-interval ones off, especially if interrupt_input is
3246 It'd be nice to be able to control the connect timeout
3247 though. Would non-blocking connect calls be portable?
3249 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3251 turn_on_atimers (0);
3253 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3256 turn_on_atimers (1);
3258 if (ret
== 0 || xerrno
== EISCONN
)
3260 /* The unwind-protect will be discarded afterwards.
3261 Likewise for immediate_quit. */
3265 #ifdef NON_BLOCKING_CONNECT
3267 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3271 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3279 /* Discard the unwind protect closing S. */
3280 specpdl_ptr
= specpdl
+ count1
;
3284 if (xerrno
== EINTR
)
3290 #ifdef DATAGRAM_SOCKETS
3291 if (socktype
== SOCK_DGRAM
)
3293 if (datagram_address
[s
].sa
)
3295 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3296 datagram_address
[s
].len
= lres
->ai_addrlen
;
3300 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3301 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3304 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3305 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3306 conv_lisp_to_sockaddr (rfamily
, remote
,
3307 datagram_address
[s
].sa
, rlen
);
3311 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3314 contact
= Fplist_put (contact
, QCaddress
,
3315 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3316 #ifdef HAVE_GETSOCKNAME
3319 struct sockaddr_in sa1
;
3320 int len1
= sizeof (sa1
);
3321 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3322 contact
= Fplist_put (contact
, QClocal
,
3323 conv_sockaddr_to_lisp (&sa1
, len1
));
3328 #ifdef HAVE_GETADDRINFO
3335 /* Discard the unwind protect for closing S, if any. */
3336 specpdl_ptr
= specpdl
+ count1
;
3338 /* Unwind bind_polling_period and request_sigio. */
3339 unbind_to (count
, Qnil
);
3343 /* If non-blocking got this far - and failed - assume non-blocking is
3344 not supported after all. This is probably a wrong assumption, but
3345 the normal blocking calls to open-network-stream handles this error
3347 if (is_non_blocking_client
)
3352 report_file_error ("make server process failed", contact
);
3354 report_file_error ("make client process failed", contact
);
3357 #endif /* not TERM */
3363 buffer
= Fget_buffer_create (buffer
);
3364 proc
= make_process (name
);
3366 chan_process
[inch
] = proc
;
3369 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3372 fcntl (inch
, F_SETFL
, O_NDELAY
);
3376 p
= XPROCESS (proc
);
3378 p
->childp
= contact
;
3379 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3382 p
->sentinel
= sentinel
;
3384 p
->filter_multibyte
= buffer_defaults
.enable_multibyte_characters
;
3385 /* Override the above only if :filter-multibyte is specified. */
3386 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3387 p
->filter_multibyte
= Fplist_get (contact
, QCfilter_multibyte
);
3388 p
->log
= Fplist_get (contact
, QClog
);
3389 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3390 p
->kill_without_query
= Qt
;
3391 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3394 XSETINT (p
->infd
, inch
);
3395 XSETINT (p
->outfd
, outch
);
3396 if (is_server
&& socktype
== SOCK_STREAM
)
3397 p
->status
= Qlisten
;
3399 /* Make the process marker point into the process buffer (if any). */
3400 if (BUFFERP (buffer
))
3401 set_marker_both (p
->mark
, buffer
,
3402 BUF_ZV (XBUFFER (buffer
)),
3403 BUF_ZV_BYTE (XBUFFER (buffer
)));
3405 #ifdef NON_BLOCKING_CONNECT
3406 if (is_non_blocking_client
)
3408 /* We may get here if connect did succeed immediately. However,
3409 in that case, we still need to signal this like a non-blocking
3411 p
->status
= Qconnect
;
3412 if (!FD_ISSET (inch
, &connect_wait_mask
))
3414 FD_SET (inch
, &connect_wait_mask
);
3415 num_pending_connects
++;
3420 /* A server may have a client filter setting of Qt, but it must
3421 still listen for incoming connects unless it is stopped. */
3422 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3423 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3425 FD_SET (inch
, &input_wait_mask
);
3426 FD_SET (inch
, &non_keyboard_wait_mask
);
3429 if (inch
> max_process_desc
)
3430 max_process_desc
= inch
;
3432 tem
= Fplist_member (contact
, QCcoding
);
3433 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3434 tem
= Qnil
; /* No error message (too late!). */
3437 /* Setup coding systems for communicating with the network stream. */
3438 struct gcpro gcpro1
;
3439 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3440 Lisp_Object coding_systems
= Qt
;
3441 Lisp_Object args
[5], val
;
3445 val
= XCAR (XCDR (tem
));
3449 else if (!NILP (Vcoding_system_for_read
))
3450 val
= Vcoding_system_for_read
;
3451 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3452 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3453 /* We dare not decode end-of-line format by setting VAL to
3454 Qraw_text, because the existing Emacs Lisp libraries
3455 assume that they receive bare code including a sequene of
3460 if (NILP (host
) || NILP (service
))
3461 coding_systems
= Qnil
;
3464 args
[0] = Qopen_network_stream
, args
[1] = name
,
3465 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3467 coding_systems
= Ffind_operation_coding_system (5, args
);
3470 if (CONSP (coding_systems
))
3471 val
= XCAR (coding_systems
);
3472 else if (CONSP (Vdefault_process_coding_system
))
3473 val
= XCAR (Vdefault_process_coding_system
);
3477 p
->decode_coding_system
= val
;
3481 val
= XCAR (XCDR (tem
));
3485 else if (!NILP (Vcoding_system_for_write
))
3486 val
= Vcoding_system_for_write
;
3487 else if (NILP (current_buffer
->enable_multibyte_characters
))
3491 if (EQ (coding_systems
, Qt
))
3493 if (NILP (host
) || NILP (service
))
3494 coding_systems
= Qnil
;
3497 args
[0] = Qopen_network_stream
, args
[1] = name
,
3498 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3500 coding_systems
= Ffind_operation_coding_system (5, args
);
3504 if (CONSP (coding_systems
))
3505 val
= XCDR (coding_systems
);
3506 else if (CONSP (Vdefault_process_coding_system
))
3507 val
= XCDR (Vdefault_process_coding_system
);
3511 p
->encode_coding_system
= val
;
3513 setup_process_coding_systems (proc
);
3515 p
->decoding_buf
= make_uninit_string (0);
3516 p
->decoding_carryover
= make_number (0);
3517 p
->encoding_buf
= make_uninit_string (0);
3518 p
->encoding_carryover
= make_number (0);
3520 p
->inherit_coding_system_flag
3521 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3527 #endif /* HAVE_SOCKETS */
3530 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3533 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3534 doc
: /* Return an alist of all network interfaces and their network address.
3535 Each element is a cons, the car of which is a string containing the
3536 interface name, and the cdr is the network address in internal
3537 format; see the description of ADDRESS in `make-network-process'. */)
3540 struct ifconf ifconf
;
3541 struct ifreq
*ifreqs
= NULL
;
3546 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3552 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3553 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3560 ifconf
.ifc_len
= buf_size
;
3561 ifconf
.ifc_req
= ifreqs
;
3562 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3568 if (ifconf
.ifc_len
== buf_size
)
3572 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3575 while (--ifaces
>= 0)
3577 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3578 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3579 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3581 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3582 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3583 res
= Fcons (Fcons (build_string (namebuf
),
3584 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3585 sizeof (struct sockaddr
))),
3591 #endif /* SIOCGIFCONF */
3593 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3600 static struct ifflag_def ifflag_table
[] = {
3604 #ifdef IFF_BROADCAST
3605 { IFF_BROADCAST
, "broadcast" },
3608 { IFF_DEBUG
, "debug" },
3611 { IFF_LOOPBACK
, "loopback" },
3613 #ifdef IFF_POINTOPOINT
3614 { IFF_POINTOPOINT
, "pointopoint" },
3617 { IFF_RUNNING
, "running" },
3620 { IFF_NOARP
, "noarp" },
3623 { IFF_PROMISC
, "promisc" },
3625 #ifdef IFF_NOTRAILERS
3626 { IFF_NOTRAILERS
, "notrailers" },
3629 { IFF_ALLMULTI
, "allmulti" },
3632 { IFF_MASTER
, "master" },
3635 { IFF_SLAVE
, "slave" },
3637 #ifdef IFF_MULTICAST
3638 { IFF_MULTICAST
, "multicast" },
3641 { IFF_PORTSEL
, "portsel" },
3643 #ifdef IFF_AUTOMEDIA
3644 { IFF_AUTOMEDIA
, "automedia" },
3647 { IFF_DYNAMIC
, "dynamic" },
3650 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3653 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3656 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3659 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3662 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3667 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3668 doc
: /* Return information about network interface named IFNAME.
3669 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3670 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3671 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3672 FLAGS is the current flags of the interface. */)
3677 Lisp_Object res
= Qnil
;
3682 CHECK_STRING (ifname
);
3684 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3685 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3687 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3692 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3693 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3695 int flags
= rq
.ifr_flags
;
3696 struct ifflag_def
*fp
;
3700 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3702 if (flags
& fp
->flag_bit
)
3704 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3705 flags
-= fp
->flag_bit
;
3708 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3710 if (flags
& (1 << fnum
))
3712 elt
= Fcons (make_number (fnum
), elt
);
3717 res
= Fcons (elt
, res
);
3720 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3721 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3723 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3724 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3728 for (n
= 0; n
< 6; n
++)
3729 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3730 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3733 res
= Fcons (elt
, res
);
3736 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
3737 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3740 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3741 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3743 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3747 res
= Fcons (elt
, res
);
3750 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3751 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3754 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3757 res
= Fcons (elt
, res
);
3760 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3761 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3764 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3767 res
= Fcons (elt
, res
);
3771 return any
? res
: Qnil
;
3774 #endif /* HAVE_SOCKETS */
3776 /* Turn off input and output for process PROC. */
3779 deactivate_process (proc
)
3782 register int inchannel
, outchannel
;
3783 register struct Lisp_Process
*p
= XPROCESS (proc
);
3785 inchannel
= XINT (p
->infd
);
3786 outchannel
= XINT (p
->outfd
);
3788 #ifdef ADAPTIVE_READ_BUFFERING
3789 if (XINT (p
->read_output_delay
) > 0)
3791 if (--process_output_delay_count
< 0)
3792 process_output_delay_count
= 0;
3793 XSETINT (p
->read_output_delay
, 0);
3794 p
->read_output_skip
= Qnil
;
3800 /* Beware SIGCHLD hereabouts. */
3801 flush_pending_output (inchannel
);
3804 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3805 sys$
dassgn (outchannel
);
3806 vs
= get_vms_process_pointer (p
->pid
);
3808 give_back_vms_process_stuff (vs
);
3811 emacs_close (inchannel
);
3812 if (outchannel
>= 0 && outchannel
!= inchannel
)
3813 emacs_close (outchannel
);
3816 XSETINT (p
->infd
, -1);
3817 XSETINT (p
->outfd
, -1);
3818 #ifdef DATAGRAM_SOCKETS
3819 if (DATAGRAM_CHAN_P (inchannel
))
3821 xfree (datagram_address
[inchannel
].sa
);
3822 datagram_address
[inchannel
].sa
= 0;
3823 datagram_address
[inchannel
].len
= 0;
3826 chan_process
[inchannel
] = Qnil
;
3827 FD_CLR (inchannel
, &input_wait_mask
);
3828 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3829 #ifdef NON_BLOCKING_CONNECT
3830 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3832 FD_CLR (inchannel
, &connect_wait_mask
);
3833 if (--num_pending_connects
< 0)
3837 if (inchannel
== max_process_desc
)
3840 /* We just closed the highest-numbered process input descriptor,
3841 so recompute the highest-numbered one now. */
3842 max_process_desc
= 0;
3843 for (i
= 0; i
< MAXDESC
; i
++)
3844 if (!NILP (chan_process
[i
]))
3845 max_process_desc
= i
;
3850 /* Close all descriptors currently in use for communication
3851 with subprocess. This is used in a newly-forked subprocess
3852 to get rid of irrelevant descriptors. */
3855 close_process_descs ()
3859 for (i
= 0; i
< MAXDESC
; i
++)
3861 Lisp_Object process
;
3862 process
= chan_process
[i
];
3863 if (!NILP (process
))
3865 int in
= XINT (XPROCESS (process
)->infd
);
3866 int out
= XINT (XPROCESS (process
)->outfd
);
3869 if (out
>= 0 && in
!= out
)
3876 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3878 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3879 It is read into the process' buffers or given to their filter functions.
3880 Non-nil arg PROCESS means do not return until some output has been received
3883 Non-nil second arg SECONDS and third arg MILLISEC are number of
3884 seconds and milliseconds to wait; return after that much time whether
3885 or not there is input. If SECONDS is a floating point number,
3886 it specifies a fractional number of seconds to wait.
3888 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3889 from PROCESS, suspending reading output from other processes.
3890 If JUST-THIS-ONE is an integer, don't run any timers either.
3891 Return non-nil iff we received any output before the timeout expired. */)
3892 (process
, seconds
, millisec
, just_this_one
)
3893 register Lisp_Object process
, seconds
, millisec
, just_this_one
;
3895 int secs
, usecs
= 0;
3897 if (! NILP (process
))
3898 CHECK_PROCESS (process
);
3900 just_this_one
= Qnil
;
3902 if (!NILP (seconds
))
3904 if (INTEGERP (seconds
))
3905 secs
= XINT (seconds
);
3906 else if (FLOATP (seconds
))
3908 double timeout
= XFLOAT_DATA (seconds
);
3909 secs
= (int) timeout
;
3910 usecs
= (int) ((timeout
- (double) secs
) * 1000000);
3913 wrong_type_argument (Qnumberp
, seconds
);
3915 if (INTEGERP (millisec
))
3918 usecs
+= XINT (millisec
) * 1000;
3919 carry
= usecs
/ 1000000;
3921 if ((usecs
-= carry
* 1000000) < 0)
3928 if (secs
< 0 || (secs
== 0 && usecs
== 0))
3929 secs
= -1, usecs
= 0;
3932 secs
= NILP (process
) ? -1 : 0;
3935 (wait_reading_process_output (secs
, usecs
, 0, 0,
3937 !NILP (process
) ? XPROCESS (process
) : NULL
,
3938 NILP (just_this_one
) ? 0 :
3939 !INTEGERP (just_this_one
) ? 1 : -1)
3943 /* Accept a connection for server process SERVER on CHANNEL. */
3945 static int connect_counter
= 0;
3948 server_accept_connection (server
, channel
)
3952 Lisp_Object proc
, caller
, name
, buffer
;
3953 Lisp_Object contact
, host
, service
;
3954 struct Lisp_Process
*ps
= XPROCESS (server
);
3955 struct Lisp_Process
*p
;
3959 struct sockaddr_in in
;
3961 struct sockaddr_in6 in6
;
3963 #ifdef HAVE_LOCAL_SOCKETS
3964 struct sockaddr_un un
;
3967 int len
= sizeof saddr
;
3969 s
= accept (channel
, &saddr
.sa
, &len
);
3978 if (code
== EWOULDBLOCK
)
3982 if (!NILP (ps
->log
))
3983 call3 (ps
->log
, server
, Qnil
,
3984 concat3 (build_string ("accept failed with code"),
3985 Fnumber_to_string (make_number (code
)),
3986 build_string ("\n")));
3992 /* Setup a new process to handle the connection. */
3994 /* Generate a unique identification of the caller, and build contact
3995 information for this process. */
3998 switch (saddr
.sa
.sa_family
)
4002 Lisp_Object args
[5];
4003 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4004 args
[0] = build_string ("%d.%d.%d.%d");
4005 args
[1] = make_number (*ip
++);
4006 args
[2] = make_number (*ip
++);
4007 args
[3] = make_number (*ip
++);
4008 args
[4] = make_number (*ip
++);
4009 host
= Fformat (5, args
);
4010 service
= make_number (ntohs (saddr
.in
.sin_port
));
4012 args
[0] = build_string (" <%s:%d>");
4015 caller
= Fformat (3, args
);
4022 Lisp_Object args
[9];
4023 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4025 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4026 for (i
= 0; i
< 8; i
++)
4027 args
[i
+1] = make_number (ntohs(ip6
[i
]));
4028 host
= Fformat (9, args
);
4029 service
= make_number (ntohs (saddr
.in
.sin_port
));
4031 args
[0] = build_string (" <[%s]:%d>");
4034 caller
= Fformat (3, args
);
4039 #ifdef HAVE_LOCAL_SOCKETS
4043 caller
= Fnumber_to_string (make_number (connect_counter
));
4044 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
4048 /* Create a new buffer name for this process if it doesn't have a
4049 filter. The new buffer name is based on the buffer name or
4050 process name of the server process concatenated with the caller
4053 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4057 buffer
= ps
->buffer
;
4059 buffer
= Fbuffer_name (buffer
);
4064 buffer
= concat2 (buffer
, caller
);
4065 buffer
= Fget_buffer_create (buffer
);
4069 /* Generate a unique name for the new server process. Combine the
4070 server process name with the caller identification. */
4072 name
= concat2 (ps
->name
, caller
);
4073 proc
= make_process (name
);
4075 chan_process
[s
] = proc
;
4078 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4081 fcntl (s
, F_SETFL
, O_NDELAY
);
4085 p
= XPROCESS (proc
);
4087 /* Build new contact information for this setup. */
4088 contact
= Fcopy_sequence (ps
->childp
);
4089 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4090 contact
= Fplist_put (contact
, QChost
, host
);
4091 if (!NILP (service
))
4092 contact
= Fplist_put (contact
, QCservice
, service
);
4093 contact
= Fplist_put (contact
, QCremote
,
4094 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4095 #ifdef HAVE_GETSOCKNAME
4097 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4098 contact
= Fplist_put (contact
, QClocal
,
4099 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4102 p
->childp
= contact
;
4103 p
->plist
= Fcopy_sequence (ps
->plist
);
4106 p
->sentinel
= ps
->sentinel
;
4107 p
->filter
= ps
->filter
;
4110 XSETINT (p
->infd
, s
);
4111 XSETINT (p
->outfd
, s
);
4114 /* Client processes for accepted connections are not stopped initially. */
4115 if (!EQ (p
->filter
, Qt
))
4117 FD_SET (s
, &input_wait_mask
);
4118 FD_SET (s
, &non_keyboard_wait_mask
);
4121 if (s
> max_process_desc
)
4122 max_process_desc
= s
;
4124 /* Setup coding system for new process based on server process.
4125 This seems to be the proper thing to do, as the coding system
4126 of the new process should reflect the settings at the time the
4127 server socket was opened; not the current settings. */
4129 p
->decode_coding_system
= ps
->decode_coding_system
;
4130 p
->encode_coding_system
= ps
->encode_coding_system
;
4131 setup_process_coding_systems (proc
);
4133 p
->decoding_buf
= make_uninit_string (0);
4134 p
->decoding_carryover
= make_number (0);
4135 p
->encoding_buf
= make_uninit_string (0);
4136 p
->encoding_carryover
= make_number (0);
4138 p
->inherit_coding_system_flag
4139 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
4141 if (!NILP (ps
->log
))
4142 call3 (ps
->log
, server
, proc
,
4143 concat3 (build_string ("accept from "),
4144 (STRINGP (host
) ? host
: build_string ("-")),
4145 build_string ("\n")));
4147 if (!NILP (p
->sentinel
))
4148 exec_sentinel (proc
,
4149 concat3 (build_string ("open from "),
4150 (STRINGP (host
) ? host
: build_string ("-")),
4151 build_string ("\n")));
4154 /* This variable is different from waiting_for_input in keyboard.c.
4155 It is used to communicate to a lisp process-filter/sentinel (via the
4156 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4157 for user-input when that process-filter was called.
4158 waiting_for_input cannot be used as that is by definition 0 when
4159 lisp code is being evalled.
4160 This is also used in record_asynch_buffer_change.
4161 For that purpose, this must be 0
4162 when not inside wait_reading_process_output. */
4163 static int waiting_for_user_input_p
;
4166 wait_reading_process_output_unwind (data
)
4169 waiting_for_user_input_p
= XINT (data
);
4173 /* This is here so breakpoints can be put on it. */
4175 wait_reading_process_output_1 ()
4179 /* Use a wrapper around select to work around a bug in gdb 5.3.
4180 Normally, the wrapper is optimzed away by inlining.
4182 If emacs is stopped inside select, the gdb backtrace doesn't
4183 show the function which called select, so it is practically
4184 impossible to step through wait_reading_process_output. */
4188 select_wrapper (n
, rfd
, wfd
, xfd
, tmo
)
4190 SELECT_TYPE
*rfd
, *wfd
, *xfd
;
4193 return select (n
, rfd
, wfd
, xfd
, tmo
);
4195 #define select select_wrapper
4198 /* Read and dispose of subprocess output while waiting for timeout to
4199 elapse and/or keyboard input to be available.
4202 timeout in seconds, or
4203 zero for no limit, or
4204 -1 means gobble data immediately available but don't wait for any.
4207 an additional duration to wait, measured in microseconds.
4208 If this is nonzero and time_limit is 0, then the timeout
4209 consists of MICROSECS only.
4211 READ_KBD is a lisp value:
4212 0 to ignore keyboard input, or
4213 1 to return when input is available, or
4214 -1 meaning caller will actually read the input, so don't throw to
4215 the quit handler, or
4217 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4218 output that arrives.
4220 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4221 (and gobble terminal input into the buffer if any arrives).
4223 If WAIT_PROC is specified, wait until something arrives from that
4224 process. The return value is true iff we read some input from
4227 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4228 (suspending output from other processes). A negative value
4229 means don't run any timers either.
4231 If WAIT_PROC is specified, then the function returns true iff we
4232 received input from that process before the timeout elapsed.
4233 Otherwise, return true iff we received input from any process. */
4236 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
4237 wait_for_cell
, wait_proc
, just_wait_proc
)
4238 int time_limit
, microsecs
, read_kbd
, do_display
;
4239 Lisp_Object wait_for_cell
;
4240 struct Lisp_Process
*wait_proc
;
4243 register int channel
, nfds
;
4244 SELECT_TYPE Available
;
4245 #ifdef NON_BLOCKING_CONNECT
4246 SELECT_TYPE Connecting
;
4249 int check_delay
, no_avail
;
4252 EMACS_TIME timeout
, end_time
;
4253 int wait_channel
= -1;
4254 int got_some_input
= 0;
4255 int count
= SPECPDL_INDEX ();
4257 FD_ZERO (&Available
);
4258 #ifdef NON_BLOCKING_CONNECT
4259 FD_ZERO (&Connecting
);
4262 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4263 if (wait_proc
!= NULL
)
4264 wait_channel
= XINT (wait_proc
->infd
);
4266 record_unwind_protect (wait_reading_process_output_unwind
,
4267 make_number (waiting_for_user_input_p
));
4268 waiting_for_user_input_p
= read_kbd
;
4270 /* Since we may need to wait several times,
4271 compute the absolute time to return at. */
4272 if (time_limit
|| microsecs
)
4274 EMACS_GET_TIME (end_time
);
4275 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4276 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4278 #ifdef POLL_INTERRUPTED_SYS_CALL
4279 /* AlainF 5-Jul-1996
4280 HP-UX 10.10 seem to have problems with signals coming in
4281 Causes "poll: interrupted system call" messages when Emacs is run
4283 Turn off periodic alarms (in case they are in use),
4284 and then turn off any other atimers. */
4286 turn_on_atimers (0);
4287 #endif /* POLL_INTERRUPTED_SYS_CALL */
4291 int timeout_reduced_for_timers
= 0;
4293 /* If calling from keyboard input, do not quit
4294 since we want to return C-g as an input character.
4295 Otherwise, do pending quit if requested. */
4299 else if (interrupt_input_pending
)
4300 handle_async_input ();
4303 /* Exit now if the cell we're waiting for became non-nil. */
4304 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4307 /* Compute time from now till when time limit is up */
4308 /* Exit if already run out */
4309 if (time_limit
== -1)
4311 /* -1 specified for timeout means
4312 gobble output available now
4313 but don't wait at all. */
4315 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4317 else if (time_limit
|| microsecs
)
4319 EMACS_GET_TIME (timeout
);
4320 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4321 if (EMACS_TIME_NEG_P (timeout
))
4326 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4329 /* Normally we run timers here.
4330 But not if wait_for_cell; in those cases,
4331 the wait is supposed to be short,
4332 and those callers cannot handle running arbitrary Lisp code here. */
4333 if (NILP (wait_for_cell
)
4334 && just_wait_proc
>= 0)
4336 EMACS_TIME timer_delay
;
4340 int old_timers_run
= timers_run
;
4341 struct buffer
*old_buffer
= current_buffer
;
4343 timer_delay
= timer_check (1);
4345 /* If a timer has run, this might have changed buffers
4346 an alike. Make read_key_sequence aware of that. */
4347 if (timers_run
!= old_timers_run
4348 && old_buffer
!= current_buffer
4349 && waiting_for_user_input_p
== -1)
4350 record_asynch_buffer_change ();
4352 if (timers_run
!= old_timers_run
&& do_display
)
4353 /* We must retry, since a timer may have requeued itself
4354 and that could alter the time_delay. */
4355 redisplay_preserve_echo_area (9);
4359 while (!detect_input_pending ());
4361 /* If there is unread keyboard input, also return. */
4363 && requeued_events_pending_p ())
4366 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4368 EMACS_TIME difference
;
4369 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4370 if (EMACS_TIME_NEG_P (difference
))
4372 timeout
= timer_delay
;
4373 timeout_reduced_for_timers
= 1;
4376 /* If time_limit is -1, we are not going to wait at all. */
4377 else if (time_limit
!= -1)
4379 /* This is so a breakpoint can be put here. */
4380 wait_reading_process_output_1 ();
4384 /* Cause C-g and alarm signals to take immediate action,
4385 and cause input available signals to zero out timeout.
4387 It is important that we do this before checking for process
4388 activity. If we get a SIGCHLD after the explicit checks for
4389 process activity, timeout is the only way we will know. */
4391 set_waiting_for_input (&timeout
);
4393 /* If status of something has changed, and no input is
4394 available, notify the user of the change right away. After
4395 this explicit check, we'll let the SIGCHLD handler zap
4396 timeout to get our attention. */
4397 if (update_tick
!= process_tick
&& do_display
)
4400 #ifdef NON_BLOCKING_CONNECT
4404 Atemp
= input_wait_mask
;
4406 /* On Mac OS X 10.0, the SELECT system call always says input is
4407 present (for reading) at stdin, even when none is. This
4408 causes the call to SELECT below to return 1 and
4409 status_notify not to be called. As a result output of
4410 subprocesses are incorrectly discarded.
4414 IF_NON_BLOCKING_CONNECT (Ctemp
= connect_wait_mask
);
4416 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4417 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
4419 #ifdef NON_BLOCKING_CONNECT
4420 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4424 (SELECT_TYPE
*)0, &timeout
)
4427 /* It's okay for us to do this and then continue with
4428 the loop, since timeout has already been zeroed out. */
4429 clear_waiting_for_input ();
4430 status_notify (NULL
);
4434 /* Don't wait for output from a non-running process. Just
4435 read whatever data has already been received. */
4436 if (wait_proc
&& wait_proc
->raw_status_new
)
4437 update_status (wait_proc
);
4439 && ! EQ (wait_proc
->status
, Qrun
)
4440 && ! EQ (wait_proc
->status
, Qconnect
))
4442 int nread
, total_nread
= 0;
4444 clear_waiting_for_input ();
4445 XSETPROCESS (proc
, wait_proc
);
4447 /* Read data from the process, until we exhaust it. */
4448 while (XINT (wait_proc
->infd
) >= 0)
4450 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
4456 total_nread
+= nread
;
4458 else if (nread
== -1 && EIO
== errno
)
4462 else if (nread
== -1 && EAGAIN
== errno
)
4466 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4470 if (total_nread
> 0 && do_display
)
4471 redisplay_preserve_echo_area (10);
4476 /* Wait till there is something to do */
4478 if (wait_proc
&& just_wait_proc
)
4480 if (XINT (wait_proc
->infd
) < 0) /* Terminated */
4482 FD_SET (XINT (wait_proc
->infd
), &Available
);
4484 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4486 else if (!NILP (wait_for_cell
))
4488 Available
= non_process_wait_mask
;
4490 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4495 Available
= non_keyboard_wait_mask
;
4497 Available
= input_wait_mask
;
4498 IF_NON_BLOCKING_CONNECT (check_connect
= (num_pending_connects
> 0));
4499 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4502 /* If frame size has changed or the window is newly mapped,
4503 redisplay now, before we start to wait. There is a race
4504 condition here; if a SIGIO arrives between now and the select
4505 and indicates that a frame is trashed, the select may block
4506 displaying a trashed screen. */
4507 if (frame_garbaged
&& do_display
)
4509 clear_waiting_for_input ();
4510 redisplay_preserve_echo_area (11);
4512 set_waiting_for_input (&timeout
);
4516 if (read_kbd
&& detect_input_pending ())
4523 #ifdef NON_BLOCKING_CONNECT
4525 Connecting
= connect_wait_mask
;
4528 #ifdef ADAPTIVE_READ_BUFFERING
4529 /* Set the timeout for adaptive read buffering if any
4530 process has non-nil read_output_skip and non-zero
4531 read_output_delay, and we are not reading output for a
4532 specific wait_channel. It is not executed if
4533 Vprocess_adaptive_read_buffering is nil. */
4534 if (process_output_skip
&& check_delay
> 0)
4536 int usecs
= EMACS_USECS (timeout
);
4537 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4538 usecs
= READ_OUTPUT_DELAY_MAX
;
4539 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4541 proc
= chan_process
[channel
];
4544 /* Find minimum non-zero read_output_delay among the
4545 processes with non-nil read_output_skip. */
4546 if (XINT (XPROCESS (proc
)->read_output_delay
) > 0)
4549 if (NILP (XPROCESS (proc
)->read_output_skip
))
4551 FD_CLR (channel
, &Available
);
4552 XPROCESS (proc
)->read_output_skip
= Qnil
;
4553 if (XINT (XPROCESS (proc
)->read_output_delay
) < usecs
)
4554 usecs
= XINT (XPROCESS (proc
)->read_output_delay
);
4557 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4558 process_output_skip
= 0;
4562 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4564 #ifdef NON_BLOCKING_CONNECT
4565 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4569 (SELECT_TYPE
*)0, &timeout
);
4574 /* Make C-g and alarm signals set flags again */
4575 clear_waiting_for_input ();
4577 /* If we woke up due to SIGWINCH, actually change size now. */
4578 do_pending_window_change (0);
4580 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4581 /* We wanted the full specified time, so return now. */
4585 if (xerrno
== EINTR
)
4588 /* Ultrix select seems to return ENOMEM when it is
4589 interrupted. Treat it just like EINTR. Bleah. Note
4590 that we want to test for the "ultrix" CPP symbol, not
4591 "__ultrix__"; the latter is only defined under GCC, but
4592 not by DEC's bundled CC. -JimB */
4593 else if (xerrno
== ENOMEM
)
4597 /* This happens for no known reason on ALLIANT.
4598 I am guessing that this is the right response. -- RMS. */
4599 else if (xerrno
== EFAULT
)
4602 else if (xerrno
== EBADF
)
4605 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4606 the child's closure of the pts gives the parent a SIGHUP, and
4607 the ptc file descriptor is automatically closed,
4608 yielding EBADF here or at select() call above.
4609 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4610 in m/ibmrt-aix.h), and here we just ignore the select error.
4611 Cleanup occurs c/o status_notify after SIGCLD. */
4612 no_avail
= 1; /* Cannot depend on values returned */
4618 error ("select error: %s", emacs_strerror (xerrno
));
4623 FD_ZERO (&Available
);
4624 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4627 #if defined(sun) && !defined(USG5_4)
4628 if (nfds
> 0 && keyboard_bit_set (&Available
)
4630 /* System sometimes fails to deliver SIGIO.
4632 David J. Mackenzie says that Emacs doesn't compile under
4633 Solaris if this code is enabled, thus the USG5_4 in the CPP
4634 conditional. "I haven't noticed any ill effects so far.
4635 If you find a Solaris expert somewhere, they might know
4637 kill (getpid (), SIGIO
);
4640 #if 0 /* When polling is used, interrupt_input is 0,
4641 so get_input_pending should read the input.
4642 So this should not be needed. */
4643 /* If we are using polling for input,
4644 and we see input available, make it get read now.
4645 Otherwise it might not actually get read for a second.
4646 And on hpux, since we turn off polling in wait_reading_process_output,
4647 it might never get read at all if we don't spend much time
4648 outside of wait_reading_process_output. */
4649 if (read_kbd
&& interrupt_input
4650 && keyboard_bit_set (&Available
)
4651 && input_polling_used ())
4652 kill (getpid (), SIGALRM
);
4655 /* Check for keyboard input */
4656 /* If there is any, return immediately
4657 to give it higher priority than subprocesses */
4661 int old_timers_run
= timers_run
;
4662 struct buffer
*old_buffer
= current_buffer
;
4665 if (detect_input_pending_run_timers (do_display
))
4667 swallow_events (do_display
);
4668 if (detect_input_pending_run_timers (do_display
))
4672 /* If a timer has run, this might have changed buffers
4673 an alike. Make read_key_sequence aware of that. */
4674 if (timers_run
!= old_timers_run
4675 && waiting_for_user_input_p
== -1
4676 && old_buffer
!= current_buffer
)
4677 record_asynch_buffer_change ();
4683 /* If there is unread keyboard input, also return. */
4685 && requeued_events_pending_p ())
4688 /* If we are not checking for keyboard input now,
4689 do process events (but don't run any timers).
4690 This is so that X events will be processed.
4691 Otherwise they may have to wait until polling takes place.
4692 That would causes delays in pasting selections, for example.
4694 (We used to do this only if wait_for_cell.) */
4695 if (read_kbd
== 0 && detect_input_pending ())
4697 swallow_events (do_display
);
4698 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4699 if (detect_input_pending ())
4704 /* Exit now if the cell we're waiting for became non-nil. */
4705 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4709 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4710 go read it. This can happen with X on BSD after logging out.
4711 In that case, there really is no input and no SIGIO,
4712 but select says there is input. */
4714 if (read_kbd
&& interrupt_input
4715 && keyboard_bit_set (&Available
) && ! noninteractive
)
4716 kill (getpid (), SIGIO
);
4720 got_some_input
|= nfds
> 0;
4722 /* If checking input just got us a size-change event from X,
4723 obey it now if we should. */
4724 if (read_kbd
|| ! NILP (wait_for_cell
))
4725 do_pending_window_change (0);
4727 /* Check for data from a process. */
4728 if (no_avail
|| nfds
== 0)
4731 /* Really FIRST_PROC_DESC should be 0 on Unix,
4732 but this is safer in the short run. */
4733 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4735 if (FD_ISSET (channel
, &Available
)
4736 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4740 /* If waiting for this channel, arrange to return as
4741 soon as no more input to be processed. No more
4743 if (wait_channel
== channel
)
4749 proc
= chan_process
[channel
];
4753 /* If this is a server stream socket, accept connection. */
4754 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4756 server_accept_connection (proc
, channel
);
4760 /* Read data from the process, starting with our
4761 buffered-ahead character if we have one. */
4763 nread
= read_process_output (proc
, channel
);
4766 /* Since read_process_output can run a filter,
4767 which can call accept-process-output,
4768 don't try to read from any other processes
4769 before doing the select again. */
4770 FD_ZERO (&Available
);
4773 redisplay_preserve_echo_area (12);
4776 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4779 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4780 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4782 else if (nread
== -1 && errno
== EAGAIN
)
4786 else if (nread
== -1 && errno
== EAGAIN
)
4788 /* Note that we cannot distinguish between no input
4789 available now and a closed pipe.
4790 With luck, a closed pipe will be accompanied by
4791 subprocess termination and SIGCHLD. */
4792 else if (nread
== 0 && !NETCONN_P (proc
))
4794 #endif /* O_NDELAY */
4795 #endif /* O_NONBLOCK */
4797 /* On some OSs with ptys, when the process on one end of
4798 a pty exits, the other end gets an error reading with
4799 errno = EIO instead of getting an EOF (0 bytes read).
4800 Therefore, if we get an error reading and errno =
4801 EIO, just continue, because the child process has
4802 exited and should clean itself up soon (e.g. when we
4805 However, it has been known to happen that the SIGCHLD
4806 got lost. So raise the signl again just in case.
4808 else if (nread
== -1 && errno
== EIO
)
4809 kill (getpid (), SIGCHLD
);
4810 #endif /* HAVE_PTYS */
4811 /* If we can detect process termination, don't consider the process
4812 gone just because its pipe is closed. */
4814 else if (nread
== 0 && !NETCONN_P (proc
))
4819 /* Preserve status of processes already terminated. */
4820 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4821 deactivate_process (proc
);
4822 if (XPROCESS (proc
)->raw_status_new
)
4823 update_status (XPROCESS (proc
));
4824 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4825 XPROCESS (proc
)->status
4826 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4829 #ifdef NON_BLOCKING_CONNECT
4830 if (check_connect
&& FD_ISSET (channel
, &Connecting
)
4831 && FD_ISSET (channel
, &connect_wait_mask
))
4833 struct Lisp_Process
*p
;
4835 FD_CLR (channel
, &connect_wait_mask
);
4836 if (--num_pending_connects
< 0)
4839 proc
= chan_process
[channel
];
4843 p
= XPROCESS (proc
);
4846 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4847 So only use it on systems where it is known to work. */
4849 int xlen
= sizeof(xerrno
);
4850 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4855 struct sockaddr pname
;
4856 int pnamelen
= sizeof(pname
);
4858 /* If connection failed, getpeername will fail. */
4860 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4862 /* Obtain connect failure code through error slippage. */
4865 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4872 XSETINT (p
->tick
, ++process_tick
);
4873 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4874 deactivate_process (proc
);
4879 /* Execute the sentinel here. If we had relied on
4880 status_notify to do it later, it will read input
4881 from the process before calling the sentinel. */
4882 exec_sentinel (proc
, build_string ("open\n"));
4883 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4885 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4886 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4890 #endif /* NON_BLOCKING_CONNECT */
4891 } /* end for each file descriptor */
4892 } /* end while exit conditions not met */
4894 unbind_to (count
, Qnil
);
4896 /* If calling from keyboard input, do not quit
4897 since we want to return C-g as an input character.
4898 Otherwise, do pending quit if requested. */
4901 /* Prevent input_pending from remaining set if we quit. */
4902 clear_input_pending ();
4905 #ifdef POLL_INTERRUPTED_SYS_CALL
4906 /* AlainF 5-Jul-1996
4907 HP-UX 10.10 seems to have problems with signals coming in
4908 Causes "poll: interrupted system call" messages when Emacs is run
4910 Turn periodic alarms back on */
4912 #endif /* POLL_INTERRUPTED_SYS_CALL */
4914 return got_some_input
;
4917 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4920 read_process_output_call (fun_and_args
)
4921 Lisp_Object fun_and_args
;
4923 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4927 read_process_output_error_handler (error
)
4930 cmd_error_internal (error
, "error in process filter: ");
4932 update_echo_area ();
4933 Fsleep_for (make_number (2), Qnil
);
4937 /* Read pending output from the process channel,
4938 starting with our buffered-ahead character if we have one.
4939 Yield number of decoded characters read.
4941 This function reads at most 4096 characters.
4942 If you want to read all available subprocess output,
4943 you must call it repeatedly until it returns zero.
4945 The characters read are decoded according to PROC's coding-system
4949 read_process_output (proc
, channel
)
4951 register int channel
;
4953 register int nbytes
;
4955 register Lisp_Object outstream
;
4956 register struct buffer
*old
= current_buffer
;
4957 register struct Lisp_Process
*p
= XPROCESS (proc
);
4958 register int opoint
;
4959 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4960 int carryover
= XINT (p
->decoding_carryover
);
4964 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4966 vs
= get_vms_process_pointer (p
->pid
);
4970 return (0); /* Really weird if it does this */
4971 if (!(vs
->iosb
[0] & 1))
4972 return -1; /* I/O error */
4975 error ("Could not get VMS process pointer");
4976 chars
= vs
->inputBuffer
;
4977 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4980 start_vms_process_read (vs
); /* Crank up the next read on the process */
4981 return 1; /* Nothing worth printing, say we got 1 */
4985 /* The data carried over in the previous decoding (which are at
4986 the tail of decoding buffer) should be prepended to the new
4987 data read to decode all together. */
4988 chars
= (char *) alloca (nbytes
+ carryover
);
4989 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4990 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4994 chars
= (char *) alloca (carryover
+ readmax
);
4996 /* See the comment above. */
4997 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
4999 #ifdef DATAGRAM_SOCKETS
5000 /* We have a working select, so proc_buffered_char is always -1. */
5001 if (DATAGRAM_CHAN_P (channel
))
5003 int len
= datagram_address
[channel
].len
;
5004 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5005 0, datagram_address
[channel
].sa
, &len
);
5009 if (proc_buffered_char
[channel
] < 0)
5011 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
5012 #ifdef ADAPTIVE_READ_BUFFERING
5013 if (nbytes
> 0 && !NILP (p
->adaptive_read_buffering
))
5015 int delay
= XINT (p
->read_output_delay
);
5018 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5021 process_output_delay_count
++;
5022 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5025 else if (delay
> 0 && (nbytes
== readmax
))
5027 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5029 process_output_delay_count
--;
5031 XSETINT (p
->read_output_delay
, delay
);
5034 p
->read_output_skip
= Qt
;
5035 process_output_skip
= 1;
5042 chars
[carryover
] = proc_buffered_char
[channel
];
5043 proc_buffered_char
[channel
] = -1;
5044 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
5048 nbytes
= nbytes
+ 1;
5050 #endif /* not VMS */
5052 XSETINT (p
->decoding_carryover
, 0);
5054 /* At this point, NBYTES holds number of bytes just received
5055 (including the one in proc_buffered_char[channel]). */
5058 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5060 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5063 /* Now set NBYTES how many bytes we must decode. */
5064 nbytes
+= carryover
;
5066 /* Read and dispose of the process output. */
5067 outstream
= p
->filter
;
5068 if (!NILP (outstream
))
5070 /* We inhibit quit here instead of just catching it so that
5071 hitting ^G when a filter happens to be running won't screw
5073 int count
= SPECPDL_INDEX ();
5074 Lisp_Object odeactivate
;
5075 Lisp_Object obuffer
, okeymap
;
5077 int outer_running_asynch_code
= running_asynch_code
;
5078 int waiting
= waiting_for_user_input_p
;
5080 /* No need to gcpro these, because all we do with them later
5081 is test them for EQness, and none of them should be a string. */
5082 odeactivate
= Vdeactivate_mark
;
5083 XSETBUFFER (obuffer
, current_buffer
);
5084 okeymap
= current_buffer
->keymap
;
5086 specbind (Qinhibit_quit
, Qt
);
5087 specbind (Qlast_nonmenu_event
, Qt
);
5089 /* In case we get recursively called,
5090 and we already saved the match data nonrecursively,
5091 save the same match data in safely recursive fashion. */
5092 if (outer_running_asynch_code
)
5095 /* Don't clobber the CURRENT match data, either! */
5096 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5097 restore_search_regs ();
5098 record_unwind_save_match_data ();
5099 Fset_match_data (tem
, Qt
);
5102 /* For speed, if a search happens within this code,
5103 save the match data in a special nonrecursive fashion. */
5104 running_asynch_code
= 1;
5106 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5108 Vlast_coding_system_used
= coding
->symbol
;
5109 /* A new coding system might be found. */
5110 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5112 p
->decode_coding_system
= coding
->symbol
;
5114 /* Don't call setup_coding_system for
5115 proc_decode_coding_system[channel] here. It is done in
5116 detect_coding called via decode_coding above. */
5118 /* If a coding system for encoding is not yet decided, we set
5119 it as the same as coding-system for decoding.
5121 But, before doing that we must check if
5122 proc_encode_coding_system[p->outfd] surely points to a
5123 valid memory because p->outfd will be changed once EOF is
5124 sent to the process. */
5125 if (NILP (p
->encode_coding_system
)
5126 && proc_encode_coding_system
[XINT (p
->outfd
)])
5128 p
->encode_coding_system
= coding
->symbol
;
5129 setup_coding_system (coding
->symbol
,
5130 proc_encode_coding_system
[XINT (p
->outfd
)]);
5131 if (proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5132 == CODING_EOL_UNDECIDED
)
5133 proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5138 carryover
= nbytes
- coding
->consumed
;
5139 if (SCHARS (p
->decoding_buf
) < carryover
)
5140 p
->decoding_buf
= make_uninit_string (carryover
);
5141 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5143 XSETINT (p
->decoding_carryover
, carryover
);
5144 /* Adjust the multibyteness of TEXT to that of the filter. */
5145 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
5146 text
= (STRING_MULTIBYTE (text
)
5147 ? Fstring_as_unibyte (text
)
5148 : Fstring_to_multibyte (text
));
5149 if (SBYTES (text
) > 0)
5150 internal_condition_case_1 (read_process_output_call
,
5152 Fcons (proc
, Fcons (text
, Qnil
))),
5153 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5154 read_process_output_error_handler
);
5156 /* If we saved the match data nonrecursively, restore it now. */
5157 restore_search_regs ();
5158 running_asynch_code
= outer_running_asynch_code
;
5160 /* Handling the process output should not deactivate the mark. */
5161 Vdeactivate_mark
= odeactivate
;
5163 /* Restore waiting_for_user_input_p as it was
5164 when we were called, in case the filter clobbered it. */
5165 waiting_for_user_input_p
= waiting
;
5167 #if 0 /* Call record_asynch_buffer_change unconditionally,
5168 because we might have changed minor modes or other things
5169 that affect key bindings. */
5170 if (! EQ (Fcurrent_buffer (), obuffer
)
5171 || ! EQ (current_buffer
->keymap
, okeymap
))
5173 /* But do it only if the caller is actually going to read events.
5174 Otherwise there's no need to make him wake up, and it could
5175 cause trouble (for example it would make sit_for return). */
5176 if (waiting_for_user_input_p
== -1)
5177 record_asynch_buffer_change ();
5180 start_vms_process_read (vs
);
5182 unbind_to (count
, Qnil
);
5186 /* If no filter, write into buffer if it isn't dead. */
5187 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5189 Lisp_Object old_read_only
;
5190 int old_begv
, old_zv
;
5191 int old_begv_byte
, old_zv_byte
;
5192 Lisp_Object odeactivate
;
5193 int before
, before_byte
;
5198 odeactivate
= Vdeactivate_mark
;
5200 Fset_buffer (p
->buffer
);
5202 opoint_byte
= PT_BYTE
;
5203 old_read_only
= current_buffer
->read_only
;
5206 old_begv_byte
= BEGV_BYTE
;
5207 old_zv_byte
= ZV_BYTE
;
5209 current_buffer
->read_only
= Qnil
;
5211 /* Insert new output into buffer
5212 at the current end-of-output marker,
5213 thus preserving logical ordering of input and output. */
5214 if (XMARKER (p
->mark
)->buffer
)
5215 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5216 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5219 SET_PT_BOTH (ZV
, ZV_BYTE
);
5221 before_byte
= PT_BYTE
;
5223 /* If the output marker is outside of the visible region, save
5224 the restriction and widen. */
5225 if (! (BEGV
<= PT
&& PT
<= ZV
))
5228 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5230 Vlast_coding_system_used
= coding
->symbol
;
5231 /* A new coding system might be found. See the comment in the
5232 similar code in the previous `if' block. */
5233 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5235 p
->decode_coding_system
= coding
->symbol
;
5236 if (NILP (p
->encode_coding_system
)
5237 && proc_encode_coding_system
[XINT (p
->outfd
)])
5239 p
->encode_coding_system
= coding
->symbol
;
5240 setup_coding_system (coding
->symbol
,
5241 proc_encode_coding_system
[XINT (p
->outfd
)]);
5242 if (proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5243 == CODING_EOL_UNDECIDED
)
5244 proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5248 carryover
= nbytes
- coding
->consumed
;
5249 if (SCHARS (p
->decoding_buf
) < carryover
)
5250 p
->decoding_buf
= make_uninit_string (carryover
);
5251 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5253 XSETINT (p
->decoding_carryover
, carryover
);
5254 /* Adjust the multibyteness of TEXT to that of the buffer. */
5255 if (NILP (current_buffer
->enable_multibyte_characters
)
5256 != ! STRING_MULTIBYTE (text
))
5257 text
= (STRING_MULTIBYTE (text
)
5258 ? Fstring_as_unibyte (text
)
5259 : Fstring_to_multibyte (text
));
5260 /* Insert before markers in case we are inserting where
5261 the buffer's mark is, and the user's next command is Meta-y. */
5262 insert_from_string_before_markers (text
, 0, 0,
5263 SCHARS (text
), SBYTES (text
), 0);
5265 /* Make sure the process marker's position is valid when the
5266 process buffer is changed in the signal_after_change above.
5267 W3 is known to do that. */
5268 if (BUFFERP (p
->buffer
)
5269 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5270 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5272 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5274 update_mode_lines
++;
5276 /* Make sure opoint and the old restrictions
5277 float ahead of any new text just as point would. */
5278 if (opoint
>= before
)
5280 opoint
+= PT
- before
;
5281 opoint_byte
+= PT_BYTE
- before_byte
;
5283 if (old_begv
> before
)
5285 old_begv
+= PT
- before
;
5286 old_begv_byte
+= PT_BYTE
- before_byte
;
5288 if (old_zv
>= before
)
5290 old_zv
+= PT
- before
;
5291 old_zv_byte
+= PT_BYTE
- before_byte
;
5294 /* If the restriction isn't what it should be, set it. */
5295 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5296 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5298 /* Handling the process output should not deactivate the mark. */
5299 Vdeactivate_mark
= odeactivate
;
5301 current_buffer
->read_only
= old_read_only
;
5302 SET_PT_BOTH (opoint
, opoint_byte
);
5303 set_buffer_internal (old
);
5306 start_vms_process_read (vs
);
5311 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5313 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5314 This is intended for use by asynchronous process output filters and sentinels. */)
5317 return (waiting_for_user_input_p
? Qt
: Qnil
);
5320 /* Sending data to subprocess */
5322 jmp_buf send_process_frame
;
5323 Lisp_Object process_sent_to
;
5326 send_process_trap ()
5328 SIGNAL_THREAD_CHECK (SIGPIPE
);
5333 sigunblock (sigmask (SIGPIPE
));
5334 longjmp (send_process_frame
, 1);
5337 /* Send some data to process PROC.
5338 BUF is the beginning of the data; LEN is the number of characters.
5339 OBJECT is the Lisp object that the data comes from. If OBJECT is
5340 nil or t, it means that the data comes from C string.
5342 If OBJECT is not nil, the data is encoded by PROC's coding-system
5343 for encoding before it is sent.
5345 This function can evaluate Lisp code and can garbage collect. */
5348 send_process (proc
, buf
, len
, object
)
5349 volatile Lisp_Object proc
;
5350 unsigned char *volatile buf
;
5352 volatile Lisp_Object object
;
5354 /* Use volatile to protect variables from being clobbered by longjmp. */
5355 struct Lisp_Process
*p
= XPROCESS (proc
);
5357 struct coding_system
*coding
;
5358 struct gcpro gcpro1
;
5359 SIGTYPE (*volatile old_sigpipe
) ();
5364 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5367 if (p
->raw_status_new
)
5369 if (! EQ (p
->status
, Qrun
))
5370 error ("Process %s not running", SDATA (p
->name
));
5371 if (XINT (p
->outfd
) < 0)
5372 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5374 coding
= proc_encode_coding_system
[XINT (p
->outfd
)];
5375 Vlast_coding_system_used
= coding
->symbol
;
5377 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5378 || (BUFFERP (object
)
5379 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5382 if (!EQ (coding
->symbol
, p
->encode_coding_system
))
5383 /* The coding system for encoding was changed to raw-text
5384 because we sent a unibyte text previously. Now we are
5385 sending a multibyte text, thus we must encode it by the
5386 original coding system specified for the current process. */
5387 setup_coding_system (p
->encode_coding_system
, coding
);
5388 if (coding
->eol_type
== CODING_EOL_UNDECIDED
)
5389 coding
->eol_type
= system_eol_type
;
5390 /* src_multibyte should be set to 1 _after_ a call to
5391 setup_coding_system, since it resets src_multibyte to
5393 coding
->src_multibyte
= 1;
5397 /* For sending a unibyte text, character code conversion should
5398 not take place but EOL conversion should. So, setup raw-text
5399 or one of the subsidiary if we have not yet done it. */
5400 if (coding
->type
!= coding_type_raw_text
)
5402 if (CODING_REQUIRE_FLUSHING (coding
))
5404 /* But, before changing the coding, we must flush out data. */
5405 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5406 send_process (proc
, "", 0, Qt
);
5408 coding
->src_multibyte
= 0;
5409 setup_raw_text_coding_system (coding
);
5412 coding
->dst_multibyte
= 0;
5414 if (CODING_REQUIRE_ENCODING (coding
))
5416 int require
= encoding_buffer_size (coding
, len
);
5417 int from_byte
= -1, from
= -1, to
= -1;
5419 if (BUFFERP (object
))
5421 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5422 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
5423 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
5425 else if (STRINGP (object
))
5427 from_byte
= buf
- SDATA (object
);
5428 from
= string_byte_to_char (object
, from_byte
);
5429 to
= string_byte_to_char (object
, from_byte
+ len
);
5432 if (coding
->composing
!= COMPOSITION_DISABLED
)
5435 coding_save_composition (coding
, from
, to
, object
);
5437 coding
->composing
= COMPOSITION_DISABLED
;
5440 if (SBYTES (p
->encoding_buf
) < require
)
5441 p
->encoding_buf
= make_uninit_string (require
);
5444 buf
= (BUFFERP (object
)
5445 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
5446 : SDATA (object
) + from_byte
);
5448 object
= p
->encoding_buf
;
5449 encode_coding (coding
, (char *) buf
, SDATA (object
),
5450 len
, SBYTES (object
));
5451 coding_free_composition_data (coding
);
5452 len
= coding
->produced
;
5453 buf
= SDATA (object
);
5457 vs
= get_vms_process_pointer (p
->pid
);
5459 error ("Could not find this process: %x", p
->pid
);
5460 else if (write_to_vms_process (vs
, buf
, len
))
5464 if (pty_max_bytes
== 0)
5466 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5467 pty_max_bytes
= fpathconf (XFASTINT (p
->outfd
), _PC_MAX_CANON
);
5468 if (pty_max_bytes
< 0)
5469 pty_max_bytes
= 250;
5471 pty_max_bytes
= 250;
5473 /* Deduct one, to leave space for the eof. */
5477 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5478 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5479 when returning with longjmp despite being declared volatile. */
5480 if (!setjmp (send_process_frame
))
5482 process_sent_to
= proc
;
5487 /* Decide how much data we can send in one batch.
5488 Long lines need to be split into multiple batches. */
5489 if (!NILP (p
->pty_flag
))
5491 /* Starting this at zero is always correct when not the first
5492 iteration because the previous iteration ended by sending C-d.
5493 It may not be correct for the first iteration
5494 if a partial line was sent in a separate send_process call.
5495 If that proves worth handling, we need to save linepos
5496 in the process object. */
5498 unsigned char *ptr
= (unsigned char *) buf
;
5499 unsigned char *end
= (unsigned char *) buf
+ len
;
5501 /* Scan through this text for a line that is too long. */
5502 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5510 /* If we found one, break the line there
5511 and put in a C-d to force the buffer through. */
5515 /* Send this batch, using one or more write calls. */
5518 int outfd
= XINT (p
->outfd
);
5519 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5520 #ifdef DATAGRAM_SOCKETS
5521 if (DATAGRAM_CHAN_P (outfd
))
5523 rv
= sendto (outfd
, (char *) buf
, this,
5524 0, datagram_address
[outfd
].sa
,
5525 datagram_address
[outfd
].len
);
5526 if (rv
< 0 && errno
== EMSGSIZE
)
5528 signal (SIGPIPE
, old_sigpipe
);
5529 report_file_error ("sending datagram",
5530 Fcons (proc
, Qnil
));
5536 rv
= emacs_write (outfd
, (char *) buf
, this);
5537 #ifdef ADAPTIVE_READ_BUFFERING
5538 if (XINT (p
->read_output_delay
) > 0
5539 && EQ (p
->adaptive_read_buffering
, Qt
))
5541 XSETFASTINT (p
->read_output_delay
, 0);
5542 process_output_delay_count
--;
5543 p
->read_output_skip
= Qnil
;
5547 signal (SIGPIPE
, old_sigpipe
);
5553 || errno
== EWOULDBLOCK
5559 /* Buffer is full. Wait, accepting input;
5560 that may allow the program
5561 to finish doing output and read more. */
5565 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5566 /* A gross hack to work around a bug in FreeBSD.
5567 In the following sequence, read(2) returns
5571 write(2) 954 bytes, get EAGAIN
5572 read(2) 1024 bytes in process_read_output
5573 read(2) 11 bytes in process_read_output
5575 That is, read(2) returns more bytes than have
5576 ever been written successfully. The 1033 bytes
5577 read are the 1022 bytes written successfully
5578 after processing (for example with CRs added if
5579 the terminal is set up that way which it is
5580 here). The same bytes will be seen again in a
5581 later read(2), without the CRs. */
5583 if (errno
== EAGAIN
)
5586 ioctl (XINT (p
->outfd
), TIOCFLUSH
, &flags
);
5588 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5590 /* Running filters might relocate buffers or strings.
5591 Arrange to relocate BUF. */
5592 if (BUFFERP (object
))
5593 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5594 else if (STRINGP (object
))
5595 offset
= buf
- SDATA (object
);
5597 #ifdef EMACS_HAS_USECS
5598 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5600 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5603 if (BUFFERP (object
))
5604 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5605 else if (STRINGP (object
))
5606 buf
= offset
+ SDATA (object
);
5611 /* This is a real error. */
5612 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5619 /* If we sent just part of the string, put in an EOF
5620 to force it through, before we send the rest. */
5622 Fprocess_send_eof (proc
);
5625 #endif /* not VMS */
5628 signal (SIGPIPE
, old_sigpipe
);
5630 proc
= process_sent_to
;
5631 p
= XPROCESS (proc
);
5633 p
->raw_status_new
= 0;
5634 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5635 XSETINT (p
->tick
, ++process_tick
);
5636 deactivate_process (proc
);
5638 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5640 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5647 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5649 doc
: /* Send current contents of region as input to PROCESS.
5650 PROCESS may be a process, a buffer, the name of a process or buffer, or
5651 nil, indicating the current buffer's process.
5652 Called from program, takes three arguments, PROCESS, START and END.
5653 If the region is more than 500 characters long,
5654 it is sent in several bunches. This may happen even for shorter regions.
5655 Output from processes can arrive in between bunches. */)
5656 (process
, start
, end
)
5657 Lisp_Object process
, start
, end
;
5662 proc
= get_process (process
);
5663 validate_region (&start
, &end
);
5665 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5666 move_gap (XINT (start
));
5668 start1
= CHAR_TO_BYTE (XINT (start
));
5669 end1
= CHAR_TO_BYTE (XINT (end
));
5670 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5671 Fcurrent_buffer ());
5676 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5678 doc
: /* Send PROCESS the contents of STRING as input.
5679 PROCESS may be a process, a buffer, the name of a process or buffer, or
5680 nil, indicating the current buffer's process.
5681 If STRING is more than 500 characters long,
5682 it is sent in several bunches. This may happen even for shorter strings.
5683 Output from processes can arrive in between bunches. */)
5685 Lisp_Object process
, string
;
5688 CHECK_STRING (string
);
5689 proc
= get_process (process
);
5690 send_process (proc
, SDATA (string
),
5691 SBYTES (string
), string
);
5695 /* Return the foreground process group for the tty/pty that
5696 the process P uses. */
5698 emacs_get_tty_pgrp (p
)
5699 struct Lisp_Process
*p
;
5704 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5707 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5708 master side. Try the slave side. */
5709 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5713 ioctl (fd
, TIOCGPGRP
, &gid
);
5717 #endif /* defined (TIOCGPGRP ) */
5722 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5723 Sprocess_running_child_p
, 0, 1, 0,
5724 doc
: /* Return t if PROCESS has given the terminal to a child.
5725 If the operating system does not make it possible to find out,
5726 return t unconditionally. */)
5728 Lisp_Object process
;
5730 /* Initialize in case ioctl doesn't exist or gives an error,
5731 in a way that will cause returning t. */
5734 struct Lisp_Process
*p
;
5736 proc
= get_process (process
);
5737 p
= XPROCESS (proc
);
5739 if (!EQ (p
->childp
, Qt
))
5740 error ("Process %s is not a subprocess",
5742 if (XINT (p
->infd
) < 0)
5743 error ("Process %s is not active",
5746 gid
= emacs_get_tty_pgrp (p
);
5753 /* send a signal number SIGNO to PROCESS.
5754 If CURRENT_GROUP is t, that means send to the process group
5755 that currently owns the terminal being used to communicate with PROCESS.
5756 This is used for various commands in shell mode.
5757 If CURRENT_GROUP is lambda, that means send to the process group
5758 that currently owns the terminal, but only if it is NOT the shell itself.
5760 If NOMSG is zero, insert signal-announcements into process's buffers
5763 If we can, we try to signal PROCESS by sending control characters
5764 down the pty. This allows us to signal inferiors who have changed
5765 their uid, for which killpg would return an EPERM error. */
5768 process_send_signal (process
, signo
, current_group
, nomsg
)
5769 Lisp_Object process
;
5771 Lisp_Object current_group
;
5775 register struct Lisp_Process
*p
;
5779 proc
= get_process (process
);
5780 p
= XPROCESS (proc
);
5782 if (!EQ (p
->childp
, Qt
))
5783 error ("Process %s is not a subprocess",
5785 if (XINT (p
->infd
) < 0)
5786 error ("Process %s is not active",
5789 if (NILP (p
->pty_flag
))
5790 current_group
= Qnil
;
5792 /* If we are using pgrps, get a pgrp number and make it negative. */
5793 if (NILP (current_group
))
5794 /* Send the signal to the shell's process group. */
5798 #ifdef SIGNALS_VIA_CHARACTERS
5799 /* If possible, send signals to the entire pgrp
5800 by sending an input character to it. */
5802 /* TERMIOS is the latest and bestest, and seems most likely to
5803 work. If the system has it, use it. */
5806 cc_t
*sig_char
= NULL
;
5808 tcgetattr (XINT (p
->infd
), &t
);
5813 sig_char
= &t
.c_cc
[VINTR
];
5817 sig_char
= &t
.c_cc
[VQUIT
];
5821 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5822 sig_char
= &t
.c_cc
[VSWTCH
];
5824 sig_char
= &t
.c_cc
[VSUSP
];
5829 if (sig_char
&& *sig_char
!= CDISABLE
)
5831 send_process (proc
, sig_char
, 1, Qnil
);
5834 /* If we can't send the signal with a character,
5835 fall through and send it another way. */
5836 #else /* ! HAVE_TERMIOS */
5838 /* On Berkeley descendants, the following IOCTL's retrieve the
5839 current control characters. */
5840 #if defined (TIOCGLTC) && defined (TIOCGETC)
5848 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5849 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5852 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5853 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5857 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5858 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5860 #endif /* ! defined (SIGTSTP) */
5863 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5865 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5872 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5873 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5876 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5877 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5881 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5882 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5884 #endif /* ! defined (SIGTSTP) */
5886 #else /* ! defined (TCGETA) */
5887 Your configuration files are messed up
.
5888 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5889 you'd better be using one of the alternatives above! */
5890 #endif /* ! defined (TCGETA) */
5891 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5892 /* In this case, the code above should alway returns. */
5894 #endif /* ! defined HAVE_TERMIOS */
5896 /* The code above may fall through if it can't
5897 handle the signal. */
5898 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5901 /* Get the current pgrp using the tty itself, if we have that.
5902 Otherwise, use the pty to get the pgrp.
5903 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5904 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5905 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5906 His patch indicates that if TIOCGPGRP returns an error, then
5907 we should just assume that p->pid is also the process group id. */
5909 gid
= emacs_get_tty_pgrp (p
);
5912 /* If we can't get the information, assume
5913 the shell owns the tty. */
5916 /* It is not clear whether anything really can set GID to -1.
5917 Perhaps on some system one of those ioctls can or could do so.
5918 Or perhaps this is vestigial. */
5921 #else /* ! defined (TIOCGPGRP ) */
5922 /* Can't select pgrps on this system, so we know that
5923 the child itself heads the pgrp. */
5925 #endif /* ! defined (TIOCGPGRP ) */
5927 /* If current_group is lambda, and the shell owns the terminal,
5928 don't send any signal. */
5929 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
5937 p
->raw_status_new
= 0;
5939 XSETINT (p
->tick
, ++process_tick
);
5941 status_notify (NULL
);
5943 #endif /* ! defined (SIGCONT) */
5946 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5951 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5956 sys$
forcex (&(p
->pid
), 0, 1);
5959 flush_pending_output (XINT (p
->infd
));
5963 /* If we don't have process groups, send the signal to the immediate
5964 subprocess. That isn't really right, but it's better than any
5965 obvious alternative. */
5968 kill (p
->pid
, signo
);
5972 /* gid may be a pid, or minus a pgrp's number */
5974 if (!NILP (current_group
))
5976 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
5977 EMACS_KILLPG (gid
, signo
);
5984 #else /* ! defined (TIOCSIGSEND) */
5985 EMACS_KILLPG (gid
, signo
);
5986 #endif /* ! defined (TIOCSIGSEND) */
5989 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5990 doc
: /* Interrupt process PROCESS.
5991 PROCESS may be a process, a buffer, or the name of a process or buffer.
5992 No arg or nil means current buffer's process.
5993 Second arg CURRENT-GROUP non-nil means send signal to
5994 the current process-group of the process's controlling terminal
5995 rather than to the process's own process group.
5996 If the process is a shell, this means interrupt current subjob
5997 rather than the shell.
5999 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6000 don't send the signal. */)
6001 (process
, current_group
)
6002 Lisp_Object process
, current_group
;
6004 process_send_signal (process
, SIGINT
, current_group
, 0);
6008 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
6009 doc
: /* Kill process PROCESS. May be process or name of one.
6010 See function `interrupt-process' for more details on usage. */)
6011 (process
, current_group
)
6012 Lisp_Object process
, current_group
;
6014 process_send_signal (process
, SIGKILL
, current_group
, 0);
6018 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
6019 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
6020 See function `interrupt-process' for more details on usage. */)
6021 (process
, current_group
)
6022 Lisp_Object process
, current_group
;
6024 process_send_signal (process
, SIGQUIT
, current_group
, 0);
6028 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
6029 doc
: /* Stop process PROCESS. May be process or name of one.
6030 See function `interrupt-process' for more details on usage.
6031 If PROCESS is a network process, inhibit handling of incoming traffic. */)
6032 (process
, current_group
)
6033 Lisp_Object process
, current_group
;
6036 if (PROCESSP (process
) && NETCONN_P (process
))
6038 struct Lisp_Process
*p
;
6040 p
= XPROCESS (process
);
6041 if (NILP (p
->command
)
6042 && XINT (p
->infd
) >= 0)
6044 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6045 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6052 error ("No SIGTSTP support");
6054 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6059 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6060 doc
: /* Continue process PROCESS. May be process or name of one.
6061 See function `interrupt-process' for more details on usage.
6062 If PROCESS is a network process, resume handling of incoming traffic. */)
6063 (process
, current_group
)
6064 Lisp_Object process
, current_group
;
6067 if (PROCESSP (process
) && NETCONN_P (process
))
6069 struct Lisp_Process
*p
;
6071 p
= XPROCESS (process
);
6072 if (EQ (p
->command
, Qt
)
6073 && XINT (p
->infd
) >= 0
6074 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6076 FD_SET (XINT (p
->infd
), &input_wait_mask
);
6077 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
6084 process_send_signal (process
, SIGCONT
, current_group
, 0);
6086 error ("No SIGCONT support");
6091 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6092 2, 2, "sProcess (name or number): \nnSignal code: ",
6093 doc
: /* Send PROCESS the signal with code SIGCODE.
6094 PROCESS may also be an integer specifying the process id of the
6095 process to signal; in this case, the process need not be a child of
6097 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6099 Lisp_Object process
, sigcode
;
6103 if (INTEGERP (process
))
6105 pid
= XINT (process
);
6109 if (FLOATP (process
))
6111 pid
= (pid_t
) XFLOAT (process
);
6115 if (STRINGP (process
))
6118 if (tem
= Fget_process (process
), NILP (tem
))
6120 pid
= XINT (Fstring_to_number (process
, make_number (10)));
6127 process
= get_process (process
);
6132 CHECK_PROCESS (process
);
6133 pid
= XPROCESS (process
)->pid
;
6135 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6139 #define handle_signal(NAME, VALUE) \
6140 else if (!strcmp (name, NAME)) \
6141 XSETINT (sigcode, VALUE)
6143 if (INTEGERP (sigcode
))
6147 unsigned char *name
;
6149 CHECK_SYMBOL (sigcode
);
6150 name
= SDATA (SYMBOL_NAME (sigcode
));
6152 if (!strncmp(name
, "SIG", 3))
6158 handle_signal ("HUP", SIGHUP
);
6161 handle_signal ("INT", SIGINT
);
6164 handle_signal ("QUIT", SIGQUIT
);
6167 handle_signal ("ILL", SIGILL
);
6170 handle_signal ("ABRT", SIGABRT
);
6173 handle_signal ("EMT", SIGEMT
);
6176 handle_signal ("KILL", SIGKILL
);
6179 handle_signal ("FPE", SIGFPE
);
6182 handle_signal ("BUS", SIGBUS
);
6185 handle_signal ("SEGV", SIGSEGV
);
6188 handle_signal ("SYS", SIGSYS
);
6191 handle_signal ("PIPE", SIGPIPE
);
6194 handle_signal ("ALRM", SIGALRM
);
6197 handle_signal ("TERM", SIGTERM
);
6200 handle_signal ("URG", SIGURG
);
6203 handle_signal ("STOP", SIGSTOP
);
6206 handle_signal ("TSTP", SIGTSTP
);
6209 handle_signal ("CONT", SIGCONT
);
6212 handle_signal ("CHLD", SIGCHLD
);
6215 handle_signal ("TTIN", SIGTTIN
);
6218 handle_signal ("TTOU", SIGTTOU
);
6221 handle_signal ("IO", SIGIO
);
6224 handle_signal ("XCPU", SIGXCPU
);
6227 handle_signal ("XFSZ", SIGXFSZ
);
6230 handle_signal ("VTALRM", SIGVTALRM
);
6233 handle_signal ("PROF", SIGPROF
);
6236 handle_signal ("WINCH", SIGWINCH
);
6239 handle_signal ("INFO", SIGINFO
);
6242 handle_signal ("USR1", SIGUSR1
);
6245 handle_signal ("USR2", SIGUSR2
);
6248 error ("Undefined signal name %s", name
);
6251 #undef handle_signal
6253 return make_number (kill (pid
, XINT (sigcode
)));
6256 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6257 doc
: /* Make PROCESS see end-of-file in its input.
6258 EOF comes after any text already sent to it.
6259 PROCESS may be a process, a buffer, the name of a process or buffer, or
6260 nil, indicating the current buffer's process.
6261 If PROCESS is a network connection, or is a process communicating
6262 through a pipe (as opposed to a pty), then you cannot send any more
6263 text to PROCESS after you call this function. */)
6265 Lisp_Object process
;
6268 struct coding_system
*coding
;
6270 if (DATAGRAM_CONN_P (process
))
6273 proc
= get_process (process
);
6274 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
6276 /* Make sure the process is really alive. */
6277 if (XPROCESS (proc
)->raw_status_new
)
6278 update_status (XPROCESS (proc
));
6279 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6280 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6282 if (CODING_REQUIRE_FLUSHING (coding
))
6284 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6285 send_process (proc
, "", 0, Qnil
);
6289 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6291 if (!NILP (XPROCESS (proc
)->pty_flag
))
6292 send_process (proc
, "\004", 1, Qnil
);
6295 int old_outfd
, new_outfd
;
6297 #ifdef HAVE_SHUTDOWN
6298 /* If this is a network connection, or socketpair is used
6299 for communication with the subprocess, call shutdown to cause EOF.
6300 (In some old system, shutdown to socketpair doesn't work.
6301 Then we just can't win.) */
6302 if (XPROCESS (proc
)->pid
== 0
6303 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
6304 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
6305 /* In case of socketpair, outfd == infd, so don't close it. */
6306 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
6307 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6308 #else /* not HAVE_SHUTDOWN */
6309 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6310 #endif /* not HAVE_SHUTDOWN */
6311 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6314 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
6316 if (!proc_encode_coding_system
[new_outfd
])
6317 proc_encode_coding_system
[new_outfd
]
6318 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6319 bcopy (proc_encode_coding_system
[old_outfd
],
6320 proc_encode_coding_system
[new_outfd
],
6321 sizeof (struct coding_system
));
6322 bzero (proc_encode_coding_system
[old_outfd
],
6323 sizeof (struct coding_system
));
6325 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
6331 /* Kill all processes associated with `buffer'.
6332 If `buffer' is nil, kill all processes */
6335 kill_buffer_processes (buffer
)
6338 Lisp_Object tail
, proc
;
6340 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6342 proc
= XCDR (XCAR (tail
));
6343 if (GC_PROCESSP (proc
)
6344 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6346 if (NETCONN_P (proc
))
6347 Fdelete_process (proc
);
6348 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
6349 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6354 /* On receipt of a signal that a child status has changed, loop asking
6355 about children with changed statuses until the system says there
6358 All we do is change the status; we do not run sentinels or print
6359 notifications. That is saved for the next time keyboard input is
6360 done, in order to avoid timing errors.
6362 ** WARNING: this can be called during garbage collection.
6363 Therefore, it must not be fooled by the presence of mark bits in
6366 ** USG WARNING: Although it is not obvious from the documentation
6367 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6368 signal() before executing at least one wait(), otherwise the
6369 handler will be called again, resulting in an infinite loop. The
6370 relevant portion of the documentation reads "SIGCLD signals will be
6371 queued and the signal-catching function will be continually
6372 reentered until the queue is empty". Invoking signal() causes the
6373 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6376 ** Malloc WARNING: This should never call malloc either directly or
6377 indirectly; if it does, that is a bug */
6381 sigchld_handler (signo
)
6384 int old_errno
= errno
;
6386 register struct Lisp_Process
*p
;
6387 extern EMACS_TIME
*input_available_clear_time
;
6389 SIGNAL_THREAD_CHECK (signo
);
6393 sigheld
|= sigbit (SIGCHLD
);
6405 #endif /* no WUNTRACED */
6406 /* Keep trying to get a status until we get a definitive result. */
6410 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6412 while (pid
< 0 && errno
== EINTR
);
6416 /* PID == 0 means no processes found, PID == -1 means a real
6417 failure. We have done all our job, so return. */
6419 /* USG systems forget handlers when they are used;
6420 must reestablish each time */
6421 #if defined (USG) && !defined (POSIX_SIGNALS)
6422 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6425 sigheld
&= ~sigbit (SIGCHLD
);
6433 #endif /* no WNOHANG */
6435 /* Find the process that signaled us, and record its status. */
6437 /* The process can have been deleted by Fdelete_process. */
6438 tail
= Fmember (make_fixnum_or_float (pid
), deleted_pid_list
);
6441 Fsetcar (tail
, Qnil
);
6442 goto sigchld_end_of_loop
;
6445 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6447 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6449 proc
= XCDR (XCAR (tail
));
6450 p
= XPROCESS (proc
);
6451 if (GC_EQ (p
->childp
, Qt
) && p
->pid
== pid
)
6456 /* Look for an asynchronous process whose pid hasn't been filled
6459 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6461 proc
= XCDR (XCAR (tail
));
6462 p
= XPROCESS (proc
);
6468 /* Change the status of the process that was found. */
6471 union { int i
; WAITTYPE wt
; } u
;
6472 int clear_desc_flag
= 0;
6474 XSETINT (p
->tick
, ++process_tick
);
6476 p
->raw_status
= u
.i
;
6477 p
->raw_status_new
= 1;
6479 /* If process has terminated, stop waiting for its output. */
6480 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6481 && XINT (p
->infd
) >= 0)
6482 clear_desc_flag
= 1;
6484 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6485 if (clear_desc_flag
)
6487 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6488 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6491 /* Tell wait_reading_process_output that it needs to wake up and
6493 if (input_available_clear_time
)
6494 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6497 /* There was no asynchronous process found for that pid: we have
6498 a synchronous process. */
6501 synch_process_alive
= 0;
6503 /* Report the status of the synchronous process. */
6505 synch_process_retcode
= WRETCODE (w
);
6506 else if (WIFSIGNALED (w
))
6507 synch_process_termsig
= WTERMSIG (w
);
6509 /* Tell wait_reading_process_output that it needs to wake up and
6511 if (input_available_clear_time
)
6512 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6515 sigchld_end_of_loop
:
6518 /* On some systems, we must return right away.
6519 If any more processes want to signal us, we will
6521 Otherwise (on systems that have WNOHANG), loop around
6522 to use up all the processes that have something to tell us. */
6523 #if (defined WINDOWSNT \
6524 || (defined USG && !defined GNU_LINUX \
6525 && !(defined HPUX && defined WNOHANG)))
6526 #if defined (USG) && ! defined (POSIX_SIGNALS)
6527 signal (signo
, sigchld_handler
);
6531 #endif /* USG, but not HPUX with WNOHANG */
6534 #endif /* SIGCHLD */
6538 exec_sentinel_unwind (data
)
6541 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6546 exec_sentinel_error_handler (error
)
6549 cmd_error_internal (error
, "error in process sentinel: ");
6551 update_echo_area ();
6552 Fsleep_for (make_number (2), Qnil
);
6557 exec_sentinel (proc
, reason
)
6558 Lisp_Object proc
, reason
;
6560 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6561 register struct Lisp_Process
*p
= XPROCESS (proc
);
6562 int count
= SPECPDL_INDEX ();
6563 int outer_running_asynch_code
= running_asynch_code
;
6564 int waiting
= waiting_for_user_input_p
;
6566 if (inhibit_sentinels
)
6569 /* No need to gcpro these, because all we do with them later
6570 is test them for EQness, and none of them should be a string. */
6571 odeactivate
= Vdeactivate_mark
;
6572 XSETBUFFER (obuffer
, current_buffer
);
6573 okeymap
= current_buffer
->keymap
;
6575 sentinel
= p
->sentinel
;
6576 if (NILP (sentinel
))
6579 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6580 assure that it gets restored no matter how the sentinel exits. */
6582 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6583 /* Inhibit quit so that random quits don't screw up a running filter. */
6584 specbind (Qinhibit_quit
, Qt
);
6585 specbind (Qlast_nonmenu_event
, Qt
);
6587 /* In case we get recursively called,
6588 and we already saved the match data nonrecursively,
6589 save the same match data in safely recursive fashion. */
6590 if (outer_running_asynch_code
)
6593 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6594 restore_search_regs ();
6595 record_unwind_save_match_data ();
6596 Fset_match_data (tem
, Qt
);
6599 /* For speed, if a search happens within this code,
6600 save the match data in a special nonrecursive fashion. */
6601 running_asynch_code
= 1;
6603 internal_condition_case_1 (read_process_output_call
,
6605 Fcons (proc
, Fcons (reason
, Qnil
))),
6606 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6607 exec_sentinel_error_handler
);
6609 /* If we saved the match data nonrecursively, restore it now. */
6610 restore_search_regs ();
6611 running_asynch_code
= outer_running_asynch_code
;
6613 Vdeactivate_mark
= odeactivate
;
6615 /* Restore waiting_for_user_input_p as it was
6616 when we were called, in case the filter clobbered it. */
6617 waiting_for_user_input_p
= waiting
;
6620 if (! EQ (Fcurrent_buffer (), obuffer
)
6621 || ! EQ (current_buffer
->keymap
, okeymap
))
6623 /* But do it only if the caller is actually going to read events.
6624 Otherwise there's no need to make him wake up, and it could
6625 cause trouble (for example it would make sit_for return). */
6626 if (waiting_for_user_input_p
== -1)
6627 record_asynch_buffer_change ();
6629 unbind_to (count
, Qnil
);
6632 /* Report all recent events of a change in process status
6633 (either run the sentinel or output a message).
6634 This is usually done while Emacs is waiting for keyboard input
6635 but can be done at other times. */
6638 status_notify (deleting_process
)
6639 struct Lisp_Process
*deleting_process
;
6641 register Lisp_Object proc
, buffer
;
6642 Lisp_Object tail
, msg
;
6643 struct gcpro gcpro1
, gcpro2
;
6647 /* We need to gcpro tail; if read_process_output calls a filter
6648 which deletes a process and removes the cons to which tail points
6649 from Vprocess_alist, and then causes a GC, tail is an unprotected
6653 /* Set this now, so that if new processes are created by sentinels
6654 that we run, we get called again to handle their status changes. */
6655 update_tick
= process_tick
;
6657 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6660 register struct Lisp_Process
*p
;
6662 proc
= Fcdr (Fcar (tail
));
6663 p
= XPROCESS (proc
);
6665 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6667 XSETINT (p
->update_tick
, XINT (p
->tick
));
6669 /* If process is still active, read any output that remains. */
6670 while (! EQ (p
->filter
, Qt
)
6671 && ! EQ (p
->status
, Qconnect
)
6672 && ! EQ (p
->status
, Qlisten
)
6673 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6674 && XINT (p
->infd
) >= 0
6675 && p
!= deleting_process
6676 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6680 /* Get the text to use for the message. */
6681 if (p
->raw_status_new
)
6683 msg
= status_message (p
);
6685 /* If process is terminated, deactivate it or delete it. */
6687 if (CONSP (p
->status
))
6688 symbol
= XCAR (p
->status
);
6690 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6691 || EQ (symbol
, Qclosed
))
6693 if (delete_exited_processes
)
6694 remove_process (proc
);
6696 deactivate_process (proc
);
6699 /* The actions above may have further incremented p->tick.
6700 So set p->update_tick again
6701 so that an error in the sentinel will not cause
6702 this code to be run again. */
6703 XSETINT (p
->update_tick
, XINT (p
->tick
));
6704 /* Now output the message suitably. */
6705 if (!NILP (p
->sentinel
))
6706 exec_sentinel (proc
, msg
);
6707 /* Don't bother with a message in the buffer
6708 when a process becomes runnable. */
6709 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6711 Lisp_Object ro
, tem
;
6712 struct buffer
*old
= current_buffer
;
6713 int opoint
, opoint_byte
;
6714 int before
, before_byte
;
6716 ro
= XBUFFER (buffer
)->read_only
;
6718 /* Avoid error if buffer is deleted
6719 (probably that's why the process is dead, too) */
6720 if (NILP (XBUFFER (buffer
)->name
))
6722 Fset_buffer (buffer
);
6725 opoint_byte
= PT_BYTE
;
6726 /* Insert new output into buffer
6727 at the current end-of-output marker,
6728 thus preserving logical ordering of input and output. */
6729 if (XMARKER (p
->mark
)->buffer
)
6730 Fgoto_char (p
->mark
);
6732 SET_PT_BOTH (ZV
, ZV_BYTE
);
6735 before_byte
= PT_BYTE
;
6737 tem
= current_buffer
->read_only
;
6738 current_buffer
->read_only
= Qnil
;
6739 insert_string ("\nProcess ");
6740 Finsert (1, &p
->name
);
6741 insert_string (" ");
6743 current_buffer
->read_only
= tem
;
6744 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6746 if (opoint
>= before
)
6747 SET_PT_BOTH (opoint
+ (PT
- before
),
6748 opoint_byte
+ (PT_BYTE
- before_byte
));
6750 SET_PT_BOTH (opoint
, opoint_byte
);
6752 set_buffer_internal (old
);
6757 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6758 redisplay_preserve_echo_area (13);
6764 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6765 Sset_process_coding_system
, 1, 3, 0,
6766 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6767 DECODING will be used to decode subprocess output and ENCODING to
6768 encode subprocess input. */)
6769 (process
, decoding
, encoding
)
6770 register Lisp_Object process
, decoding
, encoding
;
6772 register struct Lisp_Process
*p
;
6774 CHECK_PROCESS (process
);
6775 p
= XPROCESS (process
);
6776 if (XINT (p
->infd
) < 0)
6777 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6778 if (XINT (p
->outfd
) < 0)
6779 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6780 Fcheck_coding_system (decoding
);
6781 Fcheck_coding_system (encoding
);
6783 p
->decode_coding_system
= decoding
;
6784 p
->encode_coding_system
= encoding
;
6785 setup_process_coding_systems (process
);
6790 DEFUN ("process-coding-system",
6791 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6792 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6794 register Lisp_Object process
;
6796 CHECK_PROCESS (process
);
6797 return Fcons (XPROCESS (process
)->decode_coding_system
,
6798 XPROCESS (process
)->encode_coding_system
);
6801 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6802 Sset_process_filter_multibyte
, 2, 2, 0,
6803 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6804 If FLAG is non-nil, the filter is given multibyte strings.
6805 If FLAG is nil, the filter is given unibyte strings. In this case,
6806 all character code conversion except for end-of-line conversion is
6809 Lisp_Object process
, flag
;
6811 register struct Lisp_Process
*p
;
6813 CHECK_PROCESS (process
);
6814 p
= XPROCESS (process
);
6815 p
->filter_multibyte
= flag
;
6816 setup_process_coding_systems (process
);
6821 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6822 Sprocess_filter_multibyte_p
, 1, 1, 0,
6823 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6825 Lisp_Object process
;
6827 register struct Lisp_Process
*p
;
6829 CHECK_PROCESS (process
);
6830 p
= XPROCESS (process
);
6832 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6837 /* The first time this is called, assume keyboard input comes from DESC
6838 instead of from where we used to expect it.
6839 Subsequent calls mean assume input keyboard can come from DESC
6840 in addition to other places. */
6842 static int add_keyboard_wait_descriptor_called_flag
;
6845 add_keyboard_wait_descriptor (desc
)
6848 if (! add_keyboard_wait_descriptor_called_flag
)
6849 FD_CLR (0, &input_wait_mask
);
6850 add_keyboard_wait_descriptor_called_flag
= 1;
6851 FD_SET (desc
, &input_wait_mask
);
6852 FD_SET (desc
, &non_process_wait_mask
);
6853 if (desc
> max_keyboard_desc
)
6854 max_keyboard_desc
= desc
;
6857 /* From now on, do not expect DESC to give keyboard input. */
6860 delete_keyboard_wait_descriptor (desc
)
6864 int lim
= max_keyboard_desc
;
6866 FD_CLR (desc
, &input_wait_mask
);
6867 FD_CLR (desc
, &non_process_wait_mask
);
6869 if (desc
== max_keyboard_desc
)
6870 for (fd
= 0; fd
< lim
; fd
++)
6871 if (FD_ISSET (fd
, &input_wait_mask
)
6872 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6873 max_keyboard_desc
= fd
;
6876 /* Return nonzero if *MASK has a bit set
6877 that corresponds to one of the keyboard input descriptors. */
6880 keyboard_bit_set (mask
)
6885 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6886 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6887 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6898 inhibit_sentinels
= 0;
6902 if (! noninteractive
|| initialized
)
6904 signal (SIGCHLD
, sigchld_handler
);
6907 FD_ZERO (&input_wait_mask
);
6908 FD_ZERO (&non_keyboard_wait_mask
);
6909 FD_ZERO (&non_process_wait_mask
);
6910 max_process_desc
= 0;
6912 #ifdef NON_BLOCKING_CONNECT
6913 FD_ZERO (&connect_wait_mask
);
6914 num_pending_connects
= 0;
6917 #ifdef ADAPTIVE_READ_BUFFERING
6918 process_output_delay_count
= 0;
6919 process_output_skip
= 0;
6922 FD_SET (0, &input_wait_mask
);
6924 Vprocess_alist
= Qnil
;
6926 deleted_pid_list
= Qnil
;
6928 for (i
= 0; i
< MAXDESC
; i
++)
6930 chan_process
[i
] = Qnil
;
6931 proc_buffered_char
[i
] = -1;
6933 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6934 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6935 #ifdef DATAGRAM_SOCKETS
6936 bzero (datagram_address
, sizeof datagram_address
);
6941 Lisp_Object subfeatures
= Qnil
;
6942 struct socket_options
*sopt
;
6944 #define ADD_SUBFEATURE(key, val) \
6945 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6947 #ifdef NON_BLOCKING_CONNECT
6948 ADD_SUBFEATURE (QCnowait
, Qt
);
6950 #ifdef DATAGRAM_SOCKETS
6951 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6953 #ifdef HAVE_LOCAL_SOCKETS
6954 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6956 ADD_SUBFEATURE (QCfamily
, Qipv4
);
6958 ADD_SUBFEATURE (QCfamily
, Qipv6
);
6960 #ifdef HAVE_GETSOCKNAME
6961 ADD_SUBFEATURE (QCservice
, Qt
);
6963 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6964 ADD_SUBFEATURE (QCserver
, Qt
);
6967 for (sopt
= socket_options
; sopt
->name
; sopt
++)
6968 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
6970 Fprovide (intern ("make-network-process"), subfeatures
);
6972 #endif /* HAVE_SOCKETS */
6974 #if defined (DARWIN) || defined (MAC_OSX)
6975 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
6976 processes. As such, we only change the default value. */
6979 char *release
= get_operating_system_release();
6980 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
6981 && release
[1] == '.')) {
6982 Vprocess_connection_type
= Qnil
;
6991 Qprocessp
= intern ("processp");
6992 staticpro (&Qprocessp
);
6993 Qrun
= intern ("run");
6995 Qstop
= intern ("stop");
6997 Qsignal
= intern ("signal");
6998 staticpro (&Qsignal
);
7000 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7003 Qexit = intern ("exit");
7004 staticpro (&Qexit); */
7006 Qopen
= intern ("open");
7008 Qclosed
= intern ("closed");
7009 staticpro (&Qclosed
);
7010 Qconnect
= intern ("connect");
7011 staticpro (&Qconnect
);
7012 Qfailed
= intern ("failed");
7013 staticpro (&Qfailed
);
7014 Qlisten
= intern ("listen");
7015 staticpro (&Qlisten
);
7016 Qlocal
= intern ("local");
7017 staticpro (&Qlocal
);
7018 Qipv4
= intern ("ipv4");
7021 Qipv6
= intern ("ipv6");
7024 Qdatagram
= intern ("datagram");
7025 staticpro (&Qdatagram
);
7027 QCname
= intern (":name");
7028 staticpro (&QCname
);
7029 QCbuffer
= intern (":buffer");
7030 staticpro (&QCbuffer
);
7031 QChost
= intern (":host");
7032 staticpro (&QChost
);
7033 QCservice
= intern (":service");
7034 staticpro (&QCservice
);
7035 QCtype
= intern (":type");
7036 staticpro (&QCtype
);
7037 QClocal
= intern (":local");
7038 staticpro (&QClocal
);
7039 QCremote
= intern (":remote");
7040 staticpro (&QCremote
);
7041 QCcoding
= intern (":coding");
7042 staticpro (&QCcoding
);
7043 QCserver
= intern (":server");
7044 staticpro (&QCserver
);
7045 QCnowait
= intern (":nowait");
7046 staticpro (&QCnowait
);
7047 QCsentinel
= intern (":sentinel");
7048 staticpro (&QCsentinel
);
7049 QClog
= intern (":log");
7051 QCnoquery
= intern (":noquery");
7052 staticpro (&QCnoquery
);
7053 QCstop
= intern (":stop");
7054 staticpro (&QCstop
);
7055 QCoptions
= intern (":options");
7056 staticpro (&QCoptions
);
7057 QCplist
= intern (":plist");
7058 staticpro (&QCplist
);
7059 QCfilter_multibyte
= intern (":filter-multibyte");
7060 staticpro (&QCfilter_multibyte
);
7062 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
7063 staticpro (&Qlast_nonmenu_event
);
7065 staticpro (&Vprocess_alist
);
7067 staticpro (&deleted_pid_list
);
7070 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
7071 doc
: /* *Non-nil means delete processes immediately when they exit.
7072 nil means don't delete them until `list-processes' is run. */);
7074 delete_exited_processes
= 1;
7076 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
7077 doc
: /* Control type of device used to communicate with subprocesses.
7078 Values are nil to use a pipe, or t or `pty' to use a pty.
7079 The value has no effect if the system has no ptys or if all ptys are busy:
7080 then a pipe is used in any case.
7081 The value takes effect when `start-process' is called. */);
7082 Vprocess_connection_type
= Qt
;
7084 #ifdef ADAPTIVE_READ_BUFFERING
7085 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
7086 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7087 On some systems, when Emacs reads the output from a subprocess, the output data
7088 is read in very small blocks, potentially resulting in very poor performance.
7089 This behavior can be remedied to some extent by setting this variable to a
7090 non-nil value, as it will automatically delay reading from such processes, to
7091 allow them to produce more output before Emacs tries to read it.
7092 If the value is t, the delay is reset after each write to the process; any other
7093 non-nil value means that the delay is not reset on write.
7094 The variable takes effect when `start-process' is called. */);
7095 Vprocess_adaptive_read_buffering
= Qt
;
7098 defsubr (&Sprocessp
);
7099 defsubr (&Sget_process
);
7100 defsubr (&Sget_buffer_process
);
7101 defsubr (&Sdelete_process
);
7102 defsubr (&Sprocess_status
);
7103 defsubr (&Sprocess_exit_status
);
7104 defsubr (&Sprocess_id
);
7105 defsubr (&Sprocess_name
);
7106 defsubr (&Sprocess_tty_name
);
7107 defsubr (&Sprocess_command
);
7108 defsubr (&Sset_process_buffer
);
7109 defsubr (&Sprocess_buffer
);
7110 defsubr (&Sprocess_mark
);
7111 defsubr (&Sset_process_filter
);
7112 defsubr (&Sprocess_filter
);
7113 defsubr (&Sset_process_sentinel
);
7114 defsubr (&Sprocess_sentinel
);
7115 defsubr (&Sset_process_window_size
);
7116 defsubr (&Sset_process_inherit_coding_system_flag
);
7117 defsubr (&Sprocess_inherit_coding_system_flag
);
7118 defsubr (&Sset_process_query_on_exit_flag
);
7119 defsubr (&Sprocess_query_on_exit_flag
);
7120 defsubr (&Sprocess_contact
);
7121 defsubr (&Sprocess_plist
);
7122 defsubr (&Sset_process_plist
);
7123 defsubr (&Slist_processes
);
7124 defsubr (&Sprocess_list
);
7125 defsubr (&Sstart_process
);
7127 defsubr (&Sset_network_process_option
);
7128 defsubr (&Smake_network_process
);
7129 defsubr (&Sformat_network_address
);
7130 #endif /* HAVE_SOCKETS */
7131 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7133 defsubr (&Snetwork_interface_list
);
7135 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7136 defsubr (&Snetwork_interface_info
);
7138 #endif /* HAVE_SOCKETS ... */
7139 #ifdef DATAGRAM_SOCKETS
7140 defsubr (&Sprocess_datagram_address
);
7141 defsubr (&Sset_process_datagram_address
);
7143 defsubr (&Saccept_process_output
);
7144 defsubr (&Sprocess_send_region
);
7145 defsubr (&Sprocess_send_string
);
7146 defsubr (&Sinterrupt_process
);
7147 defsubr (&Skill_process
);
7148 defsubr (&Squit_process
);
7149 defsubr (&Sstop_process
);
7150 defsubr (&Scontinue_process
);
7151 defsubr (&Sprocess_running_child_p
);
7152 defsubr (&Sprocess_send_eof
);
7153 defsubr (&Ssignal_process
);
7154 defsubr (&Swaiting_for_user_input_p
);
7155 /* defsubr (&Sprocess_connection); */
7156 defsubr (&Sset_process_coding_system
);
7157 defsubr (&Sprocess_coding_system
);
7158 defsubr (&Sset_process_filter_multibyte
);
7159 defsubr (&Sprocess_filter_multibyte_p
);
7163 #else /* not subprocesses */
7165 #include <sys/types.h>
7169 #include "systime.h"
7170 #include "charset.h"
7172 #include "termopts.h"
7173 #include "sysselect.h"
7175 extern int frame_garbaged
;
7177 extern EMACS_TIME
timer_check ();
7178 extern int timers_run
;
7182 /* As described above, except assuming that there are no subprocesses:
7184 Wait for timeout to elapse and/or keyboard input to be available.
7187 timeout in seconds, or
7188 zero for no limit, or
7189 -1 means gobble data immediately available but don't wait for any.
7191 read_kbd is a Lisp_Object:
7192 0 to ignore keyboard input, or
7193 1 to return when input is available, or
7194 -1 means caller will actually read the input, so don't throw to
7197 see full version for other parameters. We know that wait_proc will
7198 always be NULL, since `subprocesses' isn't defined.
7200 do_display != 0 means redisplay should be done to show subprocess
7201 output that arrives.
7203 Return true iff we received input from any process. */
7206 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
7207 wait_for_cell
, wait_proc
, just_wait_proc
)
7208 int time_limit
, microsecs
, read_kbd
, do_display
;
7209 Lisp_Object wait_for_cell
;
7210 struct Lisp_Process
*wait_proc
;
7214 EMACS_TIME end_time
, timeout
;
7215 SELECT_TYPE waitchannels
;
7218 /* What does time_limit really mean? */
7219 if (time_limit
|| microsecs
)
7221 EMACS_GET_TIME (end_time
);
7222 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
7223 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
7226 /* Turn off periodic alarms (in case they are in use)
7227 and then turn off any other atimers,
7228 because the select emulator uses alarms. */
7230 turn_on_atimers (0);
7234 int timeout_reduced_for_timers
= 0;
7236 /* If calling from keyboard input, do not quit
7237 since we want to return C-g as an input character.
7238 Otherwise, do pending quit if requested. */
7242 /* Exit now if the cell we're waiting for became non-nil. */
7243 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7246 /* Compute time from now till when time limit is up */
7247 /* Exit if already run out */
7248 if (time_limit
== -1)
7250 /* -1 specified for timeout means
7251 gobble output available now
7252 but don't wait at all. */
7254 EMACS_SET_SECS_USECS (timeout
, 0, 0);
7256 else if (time_limit
|| microsecs
)
7258 EMACS_GET_TIME (timeout
);
7259 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
7260 if (EMACS_TIME_NEG_P (timeout
))
7265 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
7268 /* If our caller will not immediately handle keyboard events,
7269 run timer events directly.
7270 (Callers that will immediately read keyboard events
7271 call timer_delay on their own.) */
7272 if (NILP (wait_for_cell
))
7274 EMACS_TIME timer_delay
;
7278 int old_timers_run
= timers_run
;
7279 timer_delay
= timer_check (1);
7280 if (timers_run
!= old_timers_run
&& do_display
)
7281 /* We must retry, since a timer may have requeued itself
7282 and that could alter the time delay. */
7283 redisplay_preserve_echo_area (14);
7287 while (!detect_input_pending ());
7289 /* If there is unread keyboard input, also return. */
7291 && requeued_events_pending_p ())
7294 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
7296 EMACS_TIME difference
;
7297 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
7298 if (EMACS_TIME_NEG_P (difference
))
7300 timeout
= timer_delay
;
7301 timeout_reduced_for_timers
= 1;
7306 /* Cause C-g and alarm signals to take immediate action,
7307 and cause input available signals to zero out timeout. */
7309 set_waiting_for_input (&timeout
);
7311 /* Wait till there is something to do. */
7313 if (! read_kbd
&& NILP (wait_for_cell
))
7314 FD_ZERO (&waitchannels
);
7316 FD_SET (0, &waitchannels
);
7318 /* If a frame has been newly mapped and needs updating,
7319 reprocess its display stuff. */
7320 if (frame_garbaged
&& do_display
)
7322 clear_waiting_for_input ();
7323 redisplay_preserve_echo_area (15);
7325 set_waiting_for_input (&timeout
);
7328 if (read_kbd
&& detect_input_pending ())
7331 FD_ZERO (&waitchannels
);
7334 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7339 /* Make C-g and alarm signals set flags again */
7340 clear_waiting_for_input ();
7342 /* If we woke up due to SIGWINCH, actually change size now. */
7343 do_pending_window_change (0);
7345 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7346 /* We waited the full specified time, so return now. */
7351 /* If the system call was interrupted, then go around the
7353 if (xerrno
== EINTR
)
7354 FD_ZERO (&waitchannels
);
7356 error ("select error: %s", emacs_strerror (xerrno
));
7359 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7360 /* System sometimes fails to deliver SIGIO. */
7361 kill (getpid (), SIGIO
);
7364 if (read_kbd
&& interrupt_input
&& (waitchannels
& 1))
7365 kill (getpid (), SIGIO
);
7368 /* Check for keyboard input */
7371 && detect_input_pending_run_timers (do_display
))
7373 swallow_events (do_display
);
7374 if (detect_input_pending_run_timers (do_display
))
7378 /* If there is unread keyboard input, also return. */
7380 && requeued_events_pending_p ())
7383 /* If wait_for_cell. check for keyboard input
7384 but don't run any timers.
7385 ??? (It seems wrong to me to check for keyboard
7386 input at all when wait_for_cell, but the code
7387 has been this way since July 1994.
7388 Try changing this after version 19.31.) */
7389 if (! NILP (wait_for_cell
)
7390 && detect_input_pending ())
7392 swallow_events (do_display
);
7393 if (detect_input_pending ())
7397 /* Exit now if the cell we're waiting for became non-nil. */
7398 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7408 /* Don't confuse make-docfile by having two doc strings for this function.
7409 make-docfile does not pay attention to #if, for good reason! */
7410 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7413 register Lisp_Object name
;
7418 /* Don't confuse make-docfile by having two doc strings for this function.
7419 make-docfile does not pay attention to #if, for good reason! */
7420 DEFUN ("process-inherit-coding-system-flag",
7421 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7425 register Lisp_Object process
;
7427 /* Ignore the argument and return the value of
7428 inherit-process-coding-system. */
7429 return inherit_process_coding_system
? Qt
: Qnil
;
7432 /* Kill all processes associated with `buffer'.
7433 If `buffer' is nil, kill all processes.
7434 Since we have no subprocesses, this does nothing. */
7437 kill_buffer_processes (buffer
)
7450 QCtype
= intern (":type");
7451 staticpro (&QCtype
);
7453 defsubr (&Sget_buffer_process
);
7454 defsubr (&Sprocess_inherit_coding_system_flag
);
7458 #endif /* not subprocesses */
7460 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7461 (do not change this comment) */