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 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 */
47 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
50 #endif /* not WINDOWSNT */
52 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
53 #include <sys/socket.h>
55 #include <netinet/in.h>
56 #include <arpa/inet.h>
57 #ifdef NEED_NET_ERRNO_H
58 #include <net/errno.h>
59 #endif /* NEED_NET_ERRNO_H */
61 /* Are local (unix) sockets supported? */
62 #if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
63 #if !defined (AF_LOCAL) && defined (AF_UNIX)
64 #define AF_LOCAL AF_UNIX
67 #define HAVE_LOCAL_SOCKETS
71 #endif /* HAVE_SOCKETS */
73 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
78 /* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
79 #ifdef HAVE_BROKEN_INET_ADDR
80 #define IN_ADDR struct in_addr
81 #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
83 #define IN_ADDR unsigned long
84 #define NUMERIC_ADDR_ERROR (numeric_addr == -1)
87 #if defined(BSD_SYSTEM) || defined(STRIDE)
88 #include <sys/ioctl.h>
89 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
91 #endif /* HAVE_PTYS and no O_NDELAY */
92 #endif /* BSD_SYSTEM || STRIDE */
94 #ifdef BROKEN_O_NONBLOCK
96 #endif /* BROKEN_O_NONBLOCK */
102 /* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
104 #if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
105 /* sys/ioctl.h may have been included already */
107 #include <sys/ioctl.h>
114 #include <sys/sysmacros.h> /* for "minor" */
115 #endif /* not IRIS */
118 #include <sys/wait.h>
130 #include "termhooks.h"
131 #include "termopts.h"
132 #include "commands.h"
133 #include "keyboard.h"
135 #include "blockinput.h"
136 #include "dispextern.h"
137 #include "composite.h"
140 Lisp_Object Qprocessp
;
141 Lisp_Object Qrun
, Qstop
, Qsignal
;
142 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
143 Lisp_Object Qlocal
, Qipv4
, Qdatagram
;
147 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
148 Lisp_Object QClocal
, QCremote
, QCcoding
;
149 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
150 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
151 Lisp_Object QCfilter_multibyte
;
152 Lisp_Object Qlast_nonmenu_event
;
153 /* QCfamily is declared and initialized in xfaces.c,
154 QCfilter in keyboard.c. */
155 extern Lisp_Object QCfamily
, QCfilter
;
157 /* Qexit is declared and initialized in eval.c. */
159 /* QCfamily is defined in xfaces.c. */
160 extern Lisp_Object QCfamily
;
161 /* QCfilter is defined in keyboard.c. */
162 extern Lisp_Object QCfilter
;
164 /* a process object is a network connection when its childp field is neither
165 Qt nor Qnil but is instead a property list (KEY VAL ...). */
168 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
169 #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
171 #define NETCONN_P(p) 0
172 #define NETCONN1_P(p) 0
173 #endif /* HAVE_SOCKETS */
175 /* Define first descriptor number available for subprocesses. */
177 #define FIRST_PROC_DESC 1
179 #define FIRST_PROC_DESC 3
182 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
185 #if !defined (SIGCHLD) && defined (SIGCLD)
186 #define SIGCHLD SIGCLD
189 #include "syssignal.h"
193 extern char *get_operating_system_release ();
199 extern char *sys_errlist
[];
206 /* t means use pty, nil means use a pipe,
207 maybe other values to come. */
208 static Lisp_Object Vprocess_connection_type
;
212 #include <sys/socket.h>
216 /* These next two vars are non-static since sysdep.c uses them in the
217 emulation of `select'. */
218 /* Number of events of change of status of a process. */
220 /* Number of events for which the user or sentinel has been notified. */
223 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
225 #ifdef BROKEN_NON_BLOCKING_CONNECT
226 #undef NON_BLOCKING_CONNECT
228 #ifndef NON_BLOCKING_CONNECT
231 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
232 #if defined (O_NONBLOCK) || defined (O_NDELAY)
233 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
234 #define NON_BLOCKING_CONNECT
235 #endif /* EWOULDBLOCK || EINPROGRESS */
236 #endif /* O_NONBLOCK || O_NDELAY */
237 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
238 #endif /* HAVE_SELECT */
239 #endif /* HAVE_SOCKETS */
240 #endif /* NON_BLOCKING_CONNECT */
241 #endif /* BROKEN_NON_BLOCKING_CONNECT */
243 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
244 this system. We need to read full packets, so we need a
245 "non-destructive" select. So we require either native select,
246 or emulation of select using FIONREAD. */
248 #ifdef BROKEN_DATAGRAM_SOCKETS
249 #undef DATAGRAM_SOCKETS
251 #ifndef DATAGRAM_SOCKETS
253 #if defined (HAVE_SELECT) || defined (FIONREAD)
254 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
255 #define DATAGRAM_SOCKETS
256 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
257 #endif /* HAVE_SELECT || FIONREAD */
258 #endif /* HAVE_SOCKETS */
259 #endif /* DATAGRAM_SOCKETS */
260 #endif /* BROKEN_DATAGRAM_SOCKETS */
263 #undef NON_BLOCKING_CONNECT
264 #undef DATAGRAM_SOCKETS
267 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
268 #ifdef EMACS_HAS_USECS
269 #define ADAPTIVE_READ_BUFFERING
273 #ifdef ADAPTIVE_READ_BUFFERING
274 #define READ_OUTPUT_DELAY_INCREMENT 10000
275 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
276 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
278 /* Number of processes which have a non-zero read_output_delay,
279 and therefore might be delayed for adaptive read buffering. */
281 static int process_output_delay_count
;
283 /* Non-zero if any process has non-nil read_output_skip. */
285 static int process_output_skip
;
287 /* Non-nil means to delay reading process output to improve buffering.
288 A value of t means that delay is reset after each send, any other
289 non-nil value does not reset the delay. A value of nil disables
290 adaptive read buffering completely. */
291 static Lisp_Object Vprocess_adaptive_read_buffering
;
293 #define process_output_delay_count 0
297 #include "sysselect.h"
299 static int keyboard_bit_set
P_ ((SELECT_TYPE
*));
300 static void deactivate_process
P_ ((Lisp_Object
));
301 static void status_notify
P_ ((struct Lisp_Process
*));
302 static int read_process_output
P_ ((Lisp_Object
, int));
304 /* If we support a window system, turn on the code to poll periodically
305 to detect C-g. It isn't actually used when doing interrupt input. */
306 #ifdef HAVE_WINDOW_SYSTEM
307 #define POLL_FOR_INPUT
310 /* Mask of bits indicating the descriptors that we wait for input on. */
312 static SELECT_TYPE input_wait_mask
;
314 /* Mask that excludes keyboard input descriptor (s). */
316 static SELECT_TYPE non_keyboard_wait_mask
;
318 /* Mask that excludes process input descriptor (s). */
320 static SELECT_TYPE non_process_wait_mask
;
322 #ifdef NON_BLOCKING_CONNECT
323 /* Mask of bits indicating the descriptors that we wait for connect to
324 complete on. Once they complete, they are removed from this mask
325 and added to the input_wait_mask and non_keyboard_wait_mask. */
327 static SELECT_TYPE connect_wait_mask
;
329 /* Number of bits set in connect_wait_mask. */
330 static int num_pending_connects
;
332 #define IF_NON_BLOCKING_CONNECT(s) s
334 #define IF_NON_BLOCKING_CONNECT(s)
337 /* The largest descriptor currently in use for a process object. */
338 static int max_process_desc
;
340 /* The largest descriptor currently in use for keyboard input. */
341 static int max_keyboard_desc
;
343 /* Nonzero means delete a process right away if it exits. */
344 static int delete_exited_processes
;
346 /* Indexed by descriptor, gives the process (if any) for that descriptor */
347 Lisp_Object chan_process
[MAXDESC
];
349 /* Alist of elements (NAME . PROCESS) */
350 Lisp_Object Vprocess_alist
;
352 /* Buffered-ahead input char from process, indexed by channel.
353 -1 means empty (no char is buffered).
354 Used on sys V where the only way to tell if there is any
355 output from the process is to read at least one char.
356 Always -1 on systems that support FIONREAD. */
358 /* Don't make static; need to access externally. */
359 int proc_buffered_char
[MAXDESC
];
361 /* Table of `struct coding-system' for each process. */
362 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
363 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
365 #ifdef DATAGRAM_SOCKETS
366 /* Table of `partner address' for datagram sockets. */
367 struct sockaddr_and_len
{
370 } datagram_address
[MAXDESC
];
371 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
372 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
374 #define DATAGRAM_CHAN_P(chan) (0)
375 #define DATAGRAM_CONN_P(proc) (0)
378 static Lisp_Object
get_process ();
379 static void exec_sentinel ();
381 extern EMACS_TIME
timer_check ();
382 extern int timers_run
;
384 /* Maximum number of bytes to send to a pty without an eof. */
385 static int pty_max_bytes
;
391 /* The file name of the pty opened by allocate_pty. */
393 static char pty_name
[24];
396 /* Compute the Lisp form of the process status, p->status, from
397 the numeric status that was returned by `wait'. */
399 static Lisp_Object
status_convert ();
403 struct Lisp_Process
*p
;
405 union { int i
; WAITTYPE wt
; } u
;
406 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
407 p
->status
= status_convert (u
.wt
);
408 p
->raw_status_low
= Qnil
;
409 p
->raw_status_high
= Qnil
;
412 /* Convert a process status word in Unix format to
413 the list that we use internally. */
420 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
421 else if (WIFEXITED (w
))
422 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
423 WCOREDUMP (w
) ? Qt
: Qnil
));
424 else if (WIFSIGNALED (w
))
425 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
426 WCOREDUMP (w
) ? Qt
: Qnil
));
431 /* Given a status-list, extract the three pieces of information
432 and store them individually through the three pointers. */
435 decode_status (l
, symbol
, code
, coredump
)
453 *code
= XFASTINT (XCAR (tem
));
455 *coredump
= !NILP (tem
);
459 /* Return a string describing a process status list. */
463 struct Lisp_Process
*p
;
465 Lisp_Object status
= p
->status
;
468 Lisp_Object string
, string2
;
470 decode_status (status
, &symbol
, &code
, &coredump
);
472 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
475 synchronize_system_messages_locale ();
476 signame
= strsignal (code
);
479 string
= build_string (signame
);
480 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
481 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
482 return concat2 (string
, string2
);
484 else if (EQ (symbol
, Qexit
))
487 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
489 return build_string ("finished\n");
490 string
= Fnumber_to_string (make_number (code
));
491 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
492 return concat3 (build_string ("exited abnormally with code "),
495 else if (EQ (symbol
, Qfailed
))
497 string
= Fnumber_to_string (make_number (code
));
498 string2
= build_string ("\n");
499 return concat3 (build_string ("failed with code "),
503 return Fcopy_sequence (Fsymbol_name (symbol
));
508 /* Open an available pty, returning a file descriptor.
509 Return -1 on failure.
510 The file name of the terminal corresponding to the pty
511 is left in the variable pty_name. */
522 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
523 for (i
= 0; i
< 16; i
++)
526 struct stat stb
; /* Used in some PTY_OPEN. */
527 #ifdef PTY_NAME_SPRINTF
530 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
531 #endif /* no PTY_NAME_SPRINTF */
535 #else /* no PTY_OPEN */
538 /* Unusual IRIS code */
539 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
542 if (fstat (fd
, &stb
) < 0)
544 # else /* not IRIS */
545 { /* Some systems name their pseudoterminals so that there are gaps in
546 the usual sequence - for example, on HP9000/S700 systems, there
547 are no pseudoterminals with names ending in 'f'. So we wait for
548 three failures in a row before deciding that we've reached the
550 int failed_count
= 0;
552 if (stat (pty_name
, &stb
) < 0)
555 if (failed_count
>= 3)
562 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
564 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
566 # endif /* not IRIS */
568 #endif /* no PTY_OPEN */
572 /* check to make certain that both sides are available
573 this avoids a nasty yet stupid bug in rlogins */
574 #ifdef PTY_TTY_NAME_SPRINTF
577 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
578 #endif /* no PTY_TTY_NAME_SPRINTF */
580 if (access (pty_name
, 6) != 0)
583 # if !defined(IRIS) && !defined(__sgi)
589 #endif /* not UNIPLUS */
596 #endif /* HAVE_PTYS */
602 register Lisp_Object val
, tem
, name1
;
603 register struct Lisp_Process
*p
;
607 p
= allocate_process ();
609 XSETINT (p
->infd
, -1);
610 XSETINT (p
->outfd
, -1);
611 XSETFASTINT (p
->pid
, 0);
612 XSETFASTINT (p
->tick
, 0);
613 XSETFASTINT (p
->update_tick
, 0);
614 p
->raw_status_low
= Qnil
;
615 p
->raw_status_high
= Qnil
;
617 p
->mark
= Fmake_marker ();
619 #ifdef ADAPTIVE_READ_BUFFERING
620 p
->adaptive_read_buffering
= Qnil
;
621 XSETFASTINT (p
->read_output_delay
, 0);
622 p
->read_output_skip
= Qnil
;
625 /* If name is already in use, modify it until it is unused. */
630 tem
= Fget_process (name1
);
631 if (NILP (tem
)) break;
632 sprintf (suffix
, "<%d>", i
);
633 name1
= concat2 (name
, build_string (suffix
));
637 XSETPROCESS (val
, p
);
638 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
643 remove_process (proc
)
644 register Lisp_Object proc
;
646 register Lisp_Object pair
;
648 pair
= Frassq (proc
, Vprocess_alist
);
649 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
651 deactivate_process (proc
);
654 /* Setup coding systems of PROCESS. */
657 setup_process_coding_systems (process
)
660 struct Lisp_Process
*p
= XPROCESS (process
);
661 int inch
= XINT (p
->infd
);
662 int outch
= XINT (p
->outfd
);
664 if (inch
< 0 || outch
< 0)
667 if (!proc_decode_coding_system
[inch
])
668 proc_decode_coding_system
[inch
]
669 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
670 setup_coding_system (p
->decode_coding_system
,
671 proc_decode_coding_system
[inch
]);
672 if (! NILP (p
->filter
))
674 if (NILP (p
->filter_multibyte
))
675 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
677 else if (BUFFERP (p
->buffer
))
679 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
680 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
683 if (!proc_encode_coding_system
[outch
])
684 proc_encode_coding_system
[outch
]
685 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
686 setup_coding_system (p
->encode_coding_system
,
687 proc_encode_coding_system
[outch
]);
690 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
691 doc
: /* Return t if OBJECT is a process. */)
695 return PROCESSP (object
) ? Qt
: Qnil
;
698 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
699 doc
: /* Return the process named NAME, or nil if there is none. */)
701 register Lisp_Object name
;
706 return Fcdr (Fassoc (name
, Vprocess_alist
));
709 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
710 doc
: /* Return the (or a) process associated with BUFFER.
711 BUFFER may be a buffer or the name of one. */)
713 register Lisp_Object buffer
;
715 register Lisp_Object buf
, tail
, proc
;
717 if (NILP (buffer
)) return Qnil
;
718 buf
= Fget_buffer (buffer
);
719 if (NILP (buf
)) return Qnil
;
721 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
723 proc
= Fcdr (Fcar (tail
));
724 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
730 /* This is how commands for the user decode process arguments. It
731 accepts a process, a process name, a buffer, a buffer name, or nil.
732 Buffers denote the first process in the buffer, and nil denotes the
737 register Lisp_Object name
;
739 register Lisp_Object proc
, obj
;
742 obj
= Fget_process (name
);
744 obj
= Fget_buffer (name
);
746 error ("Process %s does not exist", SDATA (name
));
748 else if (NILP (name
))
749 obj
= Fcurrent_buffer ();
753 /* Now obj should be either a buffer object or a process object.
757 proc
= Fget_buffer_process (obj
);
759 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
769 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
770 doc
: /* Delete PROCESS: kill it and forget about it immediately.
771 PROCESS may be a process, a buffer, the name of a process or buffer, or
772 nil, indicating the current buffer's process. */)
774 register Lisp_Object process
;
776 register struct Lisp_Process
*p
;
778 process
= get_process (process
);
779 p
= XPROCESS (process
);
781 p
->raw_status_low
= Qnil
;
782 p
->raw_status_high
= Qnil
;
785 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
786 XSETINT (p
->tick
, ++process_tick
);
789 else if (XINT (p
->infd
) >= 0)
791 Fkill_process (process
, Qnil
);
792 /* Do this now, since remove_process will make sigchld_handler do nothing. */
794 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
795 XSETINT (p
->tick
, ++process_tick
);
798 remove_process (process
);
802 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
803 doc
: /* Return the status of PROCESS.
804 The returned value is one of the following symbols:
805 run -- for a process that is running.
806 stop -- for a process stopped but continuable.
807 exit -- for a process that has exited.
808 signal -- for a process that has got a fatal signal.
809 open -- for a network stream connection that is open.
810 listen -- for a network stream server that is listening.
811 closed -- for a network stream connection that is closed.
812 connect -- when waiting for a non-blocking connection to complete.
813 failed -- when a non-blocking connection has failed.
814 nil -- if arg is a process name and no such process exists.
815 PROCESS may be a process, a buffer, the name of a process, or
816 nil, indicating the current buffer's process. */)
818 register Lisp_Object process
;
820 register struct Lisp_Process
*p
;
821 register Lisp_Object status
;
823 if (STRINGP (process
))
824 process
= Fget_process (process
);
826 process
= get_process (process
);
831 p
= XPROCESS (process
);
832 if (!NILP (p
->raw_status_low
))
836 status
= XCAR (status
);
839 if (EQ (status
, Qexit
))
841 else if (EQ (p
->command
, Qt
))
843 else if (EQ (status
, Qrun
))
849 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
851 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
852 If PROCESS has not yet exited or died, return 0. */)
854 register Lisp_Object process
;
856 CHECK_PROCESS (process
);
857 if (!NILP (XPROCESS (process
)->raw_status_low
))
858 update_status (XPROCESS (process
));
859 if (CONSP (XPROCESS (process
)->status
))
860 return XCAR (XCDR (XPROCESS (process
)->status
));
861 return make_number (0);
864 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
865 doc
: /* Return the process id of PROCESS.
866 This is the pid of the external process which PROCESS uses or talks to.
867 For a network connection, this value is nil. */)
869 register Lisp_Object process
;
871 CHECK_PROCESS (process
);
872 return XPROCESS (process
)->pid
;
875 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
876 doc
: /* Return the name of PROCESS, as a string.
877 This is the name of the program invoked in PROCESS,
878 possibly modified to make it unique among process names. */)
880 register Lisp_Object process
;
882 CHECK_PROCESS (process
);
883 return XPROCESS (process
)->name
;
886 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
887 doc
: /* Return the command that was executed to start PROCESS.
888 This is a list of strings, the first string being the program executed
889 and the rest of the strings being the arguments given to it.
890 For a non-child channel, this is nil. */)
892 register Lisp_Object process
;
894 CHECK_PROCESS (process
);
895 return XPROCESS (process
)->command
;
898 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
899 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
900 This is the terminal that the process itself reads and writes on,
901 not the name of the pty that Emacs uses to talk with that terminal. */)
903 register Lisp_Object process
;
905 CHECK_PROCESS (process
);
906 return XPROCESS (process
)->tty_name
;
909 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
911 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
913 register Lisp_Object process
, buffer
;
915 struct Lisp_Process
*p
;
917 CHECK_PROCESS (process
);
919 CHECK_BUFFER (buffer
);
920 p
= XPROCESS (process
);
923 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
924 setup_process_coding_systems (process
);
928 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
930 doc
: /* Return the buffer PROCESS is associated with.
931 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
933 register Lisp_Object process
;
935 CHECK_PROCESS (process
);
936 return XPROCESS (process
)->buffer
;
939 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
941 doc
: /* Return the marker for the end of the last output from PROCESS. */)
943 register Lisp_Object process
;
945 CHECK_PROCESS (process
);
946 return XPROCESS (process
)->mark
;
949 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
951 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
952 t means stop accepting output from the process.
954 When a process has a filter, its buffer is not used for output.
955 Instead, each time it does output, the entire string of output is
956 passed to the filter.
958 The filter gets two arguments: the process and the string of output.
959 The string argument is normally a multibyte string, except:
960 - if the process' input coding system is no-conversion or raw-text,
961 it is a unibyte string (the non-converted input), or else
962 - if `default-enable-multibyte-characters' is nil, it is a unibyte
963 string (the result of converting the decoded input multibyte
964 string to unibyte with `string-make-unibyte'). */)
966 register Lisp_Object process
, filter
;
968 struct Lisp_Process
*p
;
970 CHECK_PROCESS (process
);
971 p
= XPROCESS (process
);
973 /* Don't signal an error if the process' input file descriptor
974 is closed. This could make debugging Lisp more difficult,
975 for example when doing something like
977 (setq process (start-process ...))
979 (set-process-filter process ...) */
981 if (XINT (p
->infd
) >= 0)
983 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
985 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
986 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
988 else if (EQ (p
->filter
, Qt
)
989 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
991 FD_SET (XINT (p
->infd
), &input_wait_mask
);
992 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
998 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
999 setup_process_coding_systems (process
);
1003 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1005 doc
: /* Returns the filter function of PROCESS; nil if none.
1006 See `set-process-filter' for more info on filter functions. */)
1008 register Lisp_Object process
;
1010 CHECK_PROCESS (process
);
1011 return XPROCESS (process
)->filter
;
1014 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1016 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1017 The sentinel is called as a function when the process changes state.
1018 It gets two arguments: the process, and a string describing the change. */)
1020 register Lisp_Object process
, sentinel
;
1022 struct Lisp_Process
*p
;
1024 CHECK_PROCESS (process
);
1025 p
= XPROCESS (process
);
1027 p
->sentinel
= sentinel
;
1029 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1033 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1035 doc
: /* Return the sentinel of PROCESS; nil if none.
1036 See `set-process-sentinel' for more info on sentinels. */)
1038 register Lisp_Object process
;
1040 CHECK_PROCESS (process
);
1041 return XPROCESS (process
)->sentinel
;
1044 DEFUN ("set-process-window-size", Fset_process_window_size
,
1045 Sset_process_window_size
, 3, 3, 0,
1046 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1047 (process
, height
, width
)
1048 register Lisp_Object process
, height
, width
;
1050 CHECK_PROCESS (process
);
1051 CHECK_NATNUM (height
);
1052 CHECK_NATNUM (width
);
1054 if (XINT (XPROCESS (process
)->infd
) < 0
1055 || set_window_size (XINT (XPROCESS (process
)->infd
),
1056 XINT (height
), XINT (width
)) <= 0)
1062 DEFUN ("set-process-inherit-coding-system-flag",
1063 Fset_process_inherit_coding_system_flag
,
1064 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1065 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1066 If the second argument FLAG is non-nil, then the variable
1067 `buffer-file-coding-system' of the buffer associated with PROCESS
1068 will be bound to the value of the coding system used to decode
1071 This is useful when the coding system specified for the process buffer
1072 leaves either the character code conversion or the end-of-line conversion
1073 unspecified, or if the coding system used to decode the process output
1074 is more appropriate for saving the process buffer.
1076 Binding the variable `inherit-process-coding-system' to non-nil before
1077 starting the process is an alternative way of setting the inherit flag
1078 for the process which will run. */)
1080 register Lisp_Object process
, flag
;
1082 CHECK_PROCESS (process
);
1083 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
1087 DEFUN ("process-inherit-coding-system-flag",
1088 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1090 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1091 If this flag is t, `buffer-file-coding-system' of the buffer
1092 associated with PROCESS will inherit the coding system used to decode
1093 the process output. */)
1095 register Lisp_Object process
;
1097 CHECK_PROCESS (process
);
1098 return XPROCESS (process
)->inherit_coding_system_flag
;
1101 DEFUN ("set-process-query-on-exit-flag",
1102 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1104 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1105 If the second argument FLAG is non-nil, Emacs will query the user before
1106 exiting if PROCESS is running. */)
1108 register Lisp_Object process
, flag
;
1110 CHECK_PROCESS (process
);
1111 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
1115 DEFUN ("process-query-on-exit-flag",
1116 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1118 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1120 register Lisp_Object process
;
1122 CHECK_PROCESS (process
);
1123 return Fnull (XPROCESS (process
)->kill_without_query
);
1126 #ifdef DATAGRAM_SOCKETS
1127 Lisp_Object
Fprocess_datagram_address ();
1130 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1132 doc
: /* Return the contact info of PROCESS; t for a real child.
1133 For a net connection, the value depends on the optional KEY arg.
1134 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1135 if KEY is t, the complete contact information for the connection is
1136 returned, else the specific value for the keyword KEY is returned.
1137 See `make-network-process' for a list of keywords. */)
1139 register Lisp_Object process
, key
;
1141 Lisp_Object contact
;
1143 CHECK_PROCESS (process
);
1144 contact
= XPROCESS (process
)->childp
;
1146 #ifdef DATAGRAM_SOCKETS
1147 if (DATAGRAM_CONN_P (process
)
1148 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1149 contact
= Fplist_put (contact
, QCremote
,
1150 Fprocess_datagram_address (process
));
1153 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1156 return Fcons (Fplist_get (contact
, QChost
),
1157 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1158 return Fplist_get (contact
, key
);
1161 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1163 doc
: /* Return the plist of PROCESS. */)
1165 register Lisp_Object process
;
1167 CHECK_PROCESS (process
);
1168 return XPROCESS (process
)->plist
;
1171 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1173 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1175 register Lisp_Object process
, plist
;
1177 CHECK_PROCESS (process
);
1180 XPROCESS (process
)->plist
= plist
;
1184 #if 0 /* Turned off because we don't currently record this info
1185 in the process. Perhaps add it. */
1186 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1187 doc
: /* Return the connection type of PROCESS.
1188 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1189 a socket connection. */)
1191 Lisp_Object process
;
1193 return XPROCESS (process
)->type
;
1198 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1200 doc
: /* Convert network ADDRESS from internal format to a string.
1201 A 4 or 5 element vector represents an IPv4 address (with port number).
1202 An 8 or 9 element vector represents an IPv6 address (with port number).
1203 If optional second argument OMIT-PORT is non-nil, don't include a port
1204 number in the string, even when present in ADDRESS.
1205 Returns nil if format of ADDRESS is invalid. */)
1206 (address
, omit_port
)
1207 Lisp_Object address
, omit_port
;
1212 if (STRINGP (address
)) /* AF_LOCAL */
1215 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1217 register struct Lisp_Vector
*p
= XVECTOR (address
);
1218 Lisp_Object args
[6];
1221 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1223 args
[0] = build_string ("%d.%d.%d.%d");
1226 else if (p
->size
== 5)
1228 args
[0] = build_string ("%d.%d.%d.%d:%d");
1231 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1233 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1236 else if (p
->size
== 9)
1238 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1244 for (i
= 0; i
< nargs
; i
++)
1245 args
[i
+1] = p
->contents
[i
];
1246 return Fformat (nargs
+1, args
);
1249 if (CONSP (address
))
1251 Lisp_Object args
[2];
1252 args
[0] = build_string ("<Family %d>");
1253 args
[1] = Fcar (address
);
1254 return Fformat (2, args
);
1263 list_processes_1 (query_only
)
1264 Lisp_Object query_only
;
1266 register Lisp_Object tail
, tem
;
1267 Lisp_Object proc
, minspace
, tem1
;
1268 register struct Lisp_Process
*p
;
1270 int w_proc
, w_buffer
, w_tty
;
1271 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1273 w_proc
= 4; /* Proc */
1274 w_buffer
= 6; /* Buffer */
1275 w_tty
= 0; /* Omit if no ttys */
1277 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1281 proc
= Fcdr (Fcar (tail
));
1282 p
= XPROCESS (proc
);
1283 if (NILP (p
->childp
))
1285 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1287 if (STRINGP (p
->name
)
1288 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1290 if (!NILP (p
->buffer
))
1292 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1293 w_buffer
= 8; /* (Killed) */
1294 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1297 if (STRINGP (p
->tty_name
)
1298 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1302 XSETFASTINT (i_status
, w_proc
+ 1);
1303 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1306 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1307 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1310 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1313 XSETFASTINT (minspace
, 1);
1315 set_buffer_internal (XBUFFER (Vstandard_output
));
1316 current_buffer
->undo_list
= Qt
;
1318 current_buffer
->truncate_lines
= Qt
;
1320 write_string ("Proc", -1);
1321 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1322 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1325 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1327 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1328 write_string ("\n", -1);
1330 write_string ("----", -1);
1331 Findent_to (i_status
, minspace
); write_string ("------", -1);
1332 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1335 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1337 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1338 write_string ("\n", -1);
1340 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1344 proc
= Fcdr (Fcar (tail
));
1345 p
= XPROCESS (proc
);
1346 if (NILP (p
->childp
))
1348 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1351 Finsert (1, &p
->name
);
1352 Findent_to (i_status
, minspace
);
1354 if (!NILP (p
->raw_status_low
))
1357 if (CONSP (p
->status
))
1358 symbol
= XCAR (p
->status
);
1361 if (EQ (symbol
, Qsignal
))
1364 tem
= Fcar (Fcdr (p
->status
));
1366 if (XINT (tem
) < NSIG
)
1367 write_string (sys_errlist
[XINT (tem
)], -1);
1370 Fprinc (symbol
, Qnil
);
1372 else if (NETCONN1_P (p
))
1374 if (EQ (symbol
, Qexit
))
1375 write_string ("closed", -1);
1376 else if (EQ (p
->command
, Qt
))
1377 write_string ("stopped", -1);
1378 else if (EQ (symbol
, Qrun
))
1379 write_string ("open", -1);
1381 Fprinc (symbol
, Qnil
);
1384 Fprinc (symbol
, Qnil
);
1386 if (EQ (symbol
, Qexit
))
1389 tem
= Fcar (Fcdr (p
->status
));
1392 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1393 write_string (tembuf
, -1);
1397 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
1398 remove_process (proc
);
1400 Findent_to (i_buffer
, minspace
);
1401 if (NILP (p
->buffer
))
1402 insert_string ("(none)");
1403 else if (NILP (XBUFFER (p
->buffer
)->name
))
1404 insert_string ("(Killed)");
1406 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1410 Findent_to (i_tty
, minspace
);
1411 if (STRINGP (p
->tty_name
))
1412 Finsert (1, &p
->tty_name
);
1415 Findent_to (i_command
, minspace
);
1417 if (EQ (p
->status
, Qlisten
))
1419 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1420 if (INTEGERP (port
))
1421 port
= Fnumber_to_string (port
);
1423 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1424 sprintf (tembuf
, "(network %s server on %s)\n",
1425 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1426 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1427 insert_string (tembuf
);
1429 else if (NETCONN1_P (p
))
1431 /* For a local socket, there is no host name,
1432 so display service instead. */
1433 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1434 if (!STRINGP (host
))
1436 host
= Fplist_get (p
->childp
, QCservice
);
1437 if (INTEGERP (host
))
1438 host
= Fnumber_to_string (host
);
1441 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1442 sprintf (tembuf
, "(network %s connection to %s)\n",
1443 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1444 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1445 insert_string (tembuf
);
1457 insert_string (" ");
1459 insert_string ("\n");
1465 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1466 doc
: /* Display a list of all processes.
1467 If optional argument QUERY-ONLY is non-nil, only processes with
1468 the query-on-exit flag set will be listed.
1469 Any process listed as exited or signaled is actually eliminated
1470 after the listing is made. */)
1472 Lisp_Object query_only
;
1474 internal_with_output_to_temp_buffer ("*Process List*",
1475 list_processes_1
, query_only
);
1479 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1480 doc
: /* Return a list of all processes. */)
1483 return Fmapcar (Qcdr
, Vprocess_alist
);
1486 /* Starting asynchronous inferior processes. */
1488 static Lisp_Object
start_process_unwind ();
1490 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1491 doc
: /* Start a program in a subprocess. Return the process object for it.
1492 NAME is name for process. It is modified if necessary to make it unique.
1493 BUFFER is the buffer (or buffer name) to associate with the process.
1494 Process output goes at end of that buffer, unless you specify
1495 an output stream or filter function to handle the output.
1496 BUFFER may be also nil, meaning that this process is not associated
1498 PROGRAM is the program file name. It is searched for in PATH.
1499 Remaining arguments are strings to give program as arguments.
1501 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1504 register Lisp_Object
*args
;
1506 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1508 register unsigned char *new_argv
;
1511 register unsigned char **new_argv
;
1514 int count
= SPECPDL_INDEX ();
1518 buffer
= Fget_buffer_create (buffer
);
1520 /* Make sure that the child will be able to chdir to the current
1521 buffer's current directory, or its unhandled equivalent. We
1522 can't just have the child check for an error when it does the
1523 chdir, since it's in a vfork.
1525 We have to GCPRO around this because Fexpand_file_name and
1526 Funhandled_file_name_directory might call a file name handling
1527 function. The argument list is protected by the caller, so all
1528 we really have to worry about is buffer. */
1530 struct gcpro gcpro1
, gcpro2
;
1532 current_dir
= current_buffer
->directory
;
1534 GCPRO2 (buffer
, current_dir
);
1537 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1539 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1540 report_file_error ("Setting current directory",
1541 Fcons (current_buffer
->directory
, Qnil
));
1547 CHECK_STRING (name
);
1551 CHECK_STRING (program
);
1553 proc
= make_process (name
);
1554 /* If an error occurs and we can't start the process, we want to
1555 remove it from the process list. This means that each error
1556 check in create_process doesn't need to call remove_process
1557 itself; it's all taken care of here. */
1558 record_unwind_protect (start_process_unwind
, proc
);
1560 XPROCESS (proc
)->childp
= Qt
;
1561 XPROCESS (proc
)->plist
= Qnil
;
1562 XPROCESS (proc
)->buffer
= buffer
;
1563 XPROCESS (proc
)->sentinel
= Qnil
;
1564 XPROCESS (proc
)->filter
= Qnil
;
1565 XPROCESS (proc
)->filter_multibyte
1566 = buffer_defaults
.enable_multibyte_characters
;
1567 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1569 #ifdef ADAPTIVE_READ_BUFFERING
1570 XPROCESS (proc
)->adaptive_read_buffering
= Vprocess_adaptive_read_buffering
;
1573 /* Make the process marker point into the process buffer (if any). */
1575 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1576 BUF_ZV (XBUFFER (buffer
)),
1577 BUF_ZV_BYTE (XBUFFER (buffer
)));
1580 /* Decide coding systems for communicating with the process. Here
1581 we don't setup the structure coding_system nor pay attention to
1582 unibyte mode. They are done in create_process. */
1584 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1585 Lisp_Object coding_systems
= Qt
;
1586 Lisp_Object val
, *args2
;
1587 struct gcpro gcpro1
, gcpro2
;
1589 val
= Vcoding_system_for_read
;
1592 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1593 args2
[0] = Qstart_process
;
1594 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1595 GCPRO2 (proc
, current_dir
);
1596 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1598 if (CONSP (coding_systems
))
1599 val
= XCAR (coding_systems
);
1600 else if (CONSP (Vdefault_process_coding_system
))
1601 val
= XCAR (Vdefault_process_coding_system
);
1603 XPROCESS (proc
)->decode_coding_system
= val
;
1605 val
= Vcoding_system_for_write
;
1608 if (EQ (coding_systems
, Qt
))
1610 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1611 args2
[0] = Qstart_process
;
1612 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1613 GCPRO2 (proc
, current_dir
);
1614 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1617 if (CONSP (coding_systems
))
1618 val
= XCDR (coding_systems
);
1619 else if (CONSP (Vdefault_process_coding_system
))
1620 val
= XCDR (Vdefault_process_coding_system
);
1622 XPROCESS (proc
)->encode_coding_system
= val
;
1626 /* Make a one member argv with all args concatenated
1627 together separated by a blank. */
1628 len
= SBYTES (program
) + 2;
1629 for (i
= 3; i
< nargs
; i
++)
1633 len
+= SBYTES (tem
) + 1; /* count the blank */
1635 new_argv
= (unsigned char *) alloca (len
);
1636 strcpy (new_argv
, SDATA (program
));
1637 for (i
= 3; i
< nargs
; i
++)
1641 strcat (new_argv
, " ");
1642 strcat (new_argv
, SDATA (tem
));
1644 /* Need to add code here to check for program existence on VMS */
1647 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1649 /* If program file name is not absolute, search our path for it.
1650 Put the name we will really use in TEM. */
1651 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1652 && !(SCHARS (program
) > 1
1653 && IS_DEVICE_SEP (SREF (program
, 1))))
1655 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1658 GCPRO4 (name
, program
, buffer
, current_dir
);
1659 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1662 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1663 tem
= Fexpand_file_name (tem
, Qnil
);
1667 if (!NILP (Ffile_directory_p (program
)))
1668 error ("Specified program for new process is a directory");
1672 /* If program file name starts with /: for quoting a magic name,
1674 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1675 && SREF (tem
, 1) == ':')
1676 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1678 /* Encode the file name and put it in NEW_ARGV.
1679 That's where the child will use it to execute the program. */
1680 tem
= ENCODE_FILE (tem
);
1681 new_argv
[0] = SDATA (tem
);
1683 /* Here we encode arguments by the coding system used for sending
1684 data to the process. We don't support using different coding
1685 systems for encoding arguments and for encoding data sent to the
1688 for (i
= 3; i
< nargs
; i
++)
1692 if (STRING_MULTIBYTE (tem
))
1693 tem
= (code_convert_string_norecord
1694 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1695 new_argv
[i
- 2] = SDATA (tem
);
1697 new_argv
[i
- 2] = 0;
1698 #endif /* not VMS */
1700 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1701 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1702 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1703 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1705 XPROCESS (proc
)->inherit_coding_system_flag
1706 = (NILP (buffer
) || !inherit_process_coding_system
1709 create_process (proc
, (char **) new_argv
, current_dir
);
1711 return unbind_to (count
, proc
);
1714 /* This function is the unwind_protect form for Fstart_process. If
1715 PROC doesn't have its pid set, then we know someone has signaled
1716 an error and the process wasn't started successfully, so we should
1717 remove it from the process list. */
1719 start_process_unwind (proc
)
1722 if (!PROCESSP (proc
))
1725 /* Was PROC started successfully? */
1726 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1727 remove_process (proc
);
1733 create_process_1 (timer
)
1734 struct atimer
*timer
;
1736 /* Nothing to do. */
1740 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1743 /* Mimic blocking of signals on system V, which doesn't really have it. */
1745 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1746 int sigchld_deferred
;
1749 create_process_sigchld ()
1751 signal (SIGCHLD
, create_process_sigchld
);
1753 sigchld_deferred
= 1;
1759 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1761 create_process (process
, new_argv
, current_dir
)
1762 Lisp_Object process
;
1764 Lisp_Object current_dir
;
1766 int pid
, inchannel
, outchannel
;
1768 #ifdef POSIX_SIGNALS
1771 struct sigaction sigint_action
;
1772 struct sigaction sigquit_action
;
1774 struct sigaction sighup_action
;
1776 #else /* !POSIX_SIGNALS */
1779 SIGTYPE (*sigchld
)();
1782 #endif /* !POSIX_SIGNALS */
1783 /* Use volatile to protect variables from being clobbered by longjmp. */
1784 volatile int forkin
, forkout
;
1785 volatile int pty_flag
= 0;
1787 extern char **environ
;
1790 inchannel
= outchannel
= -1;
1793 if (!NILP (Vprocess_connection_type
))
1794 outchannel
= inchannel
= allocate_pty ();
1798 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1799 /* On most USG systems it does not work to open the pty's tty here,
1800 then close it and reopen it in the child. */
1802 /* Don't let this terminal become our controlling terminal
1803 (in case we don't have one). */
1804 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1806 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1809 report_file_error ("Opening pty", Qnil
);
1810 #if defined (RTU) || defined (UNIPLUS) || defined (DONT_REOPEN_PTY)
1811 /* In the case that vfork is defined as fork, the parent process
1812 (Emacs) may send some data before the child process completes
1813 tty options setup. So we setup tty before forking. */
1814 child_setup_tty (forkout
);
1815 #endif /* RTU or UNIPLUS or DONT_REOPEN_PTY */
1817 forkin
= forkout
= -1;
1818 #endif /* not USG, or USG_SUBTTY_WORKS */
1822 #endif /* HAVE_PTYS */
1825 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1826 report_file_error ("Opening socketpair", Qnil
);
1827 outchannel
= inchannel
= sv
[0];
1828 forkout
= forkin
= sv
[1];
1830 #else /* not SKTPAIR */
1835 report_file_error ("Creating pipe", Qnil
);
1841 emacs_close (inchannel
);
1842 emacs_close (forkout
);
1843 report_file_error ("Creating pipe", Qnil
);
1848 #endif /* not SKTPAIR */
1851 /* Replaced by close_process_descs */
1852 set_exclusive_use (inchannel
);
1853 set_exclusive_use (outchannel
);
1856 /* Stride people say it's a mystery why this is needed
1857 as well as the O_NDELAY, but that it fails without this. */
1858 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1861 ioctl (inchannel
, FIONBIO
, &one
);
1866 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1867 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1870 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1871 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1875 /* Record this as an active process, with its channels.
1876 As a result, child_setup will close Emacs's side of the pipes. */
1877 chan_process
[inchannel
] = process
;
1878 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1879 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1881 /* Previously we recorded the tty descriptor used in the subprocess.
1882 It was only used for getting the foreground tty process, so now
1883 we just reopen the device (see emacs_get_tty_pgrp) as this is
1884 more portable (see USG_SUBTTY_WORKS above). */
1886 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1887 XPROCESS (process
)->status
= Qrun
;
1888 setup_process_coding_systems (process
);
1890 /* Delay interrupts until we have a chance to store
1891 the new fork's pid in its process structure */
1892 #ifdef POSIX_SIGNALS
1893 sigemptyset (&blocked
);
1895 sigaddset (&blocked
, SIGCHLD
);
1897 #ifdef HAVE_WORKING_VFORK
1898 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1899 this sets the parent's signal handlers as well as the child's.
1900 So delay all interrupts whose handlers the child might munge,
1901 and record the current handlers so they can be restored later. */
1902 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1903 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1905 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1907 #endif /* HAVE_WORKING_VFORK */
1908 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1909 #else /* !POSIX_SIGNALS */
1913 #else /* not BSD4_1 */
1914 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1915 sigsetmask (sigmask (SIGCHLD
));
1916 #else /* ordinary USG */
1918 sigchld_deferred
= 0;
1919 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1921 #endif /* ordinary USG */
1922 #endif /* not BSD4_1 */
1923 #endif /* SIGCHLD */
1924 #endif /* !POSIX_SIGNALS */
1926 FD_SET (inchannel
, &input_wait_mask
);
1927 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1928 if (inchannel
> max_process_desc
)
1929 max_process_desc
= inchannel
;
1931 /* Until we store the proper pid, enable sigchld_handler
1932 to recognize an unknown pid as standing for this process.
1933 It is very important not to let this `marker' value stay
1934 in the table after this function has returned; if it does
1935 it might cause call-process to hang and subsequent asynchronous
1936 processes to get their return values scrambled. */
1937 XSETINT (XPROCESS (process
)->pid
, -1);
1942 /* child_setup must clobber environ on systems with true vfork.
1943 Protect it from permanent change. */
1944 char **save_environ
= environ
;
1946 current_dir
= ENCODE_FILE (current_dir
);
1951 #endif /* not WINDOWSNT */
1953 int xforkin
= forkin
;
1954 int xforkout
= forkout
;
1956 #if 0 /* This was probably a mistake--it duplicates code later on,
1957 but fails to handle all the cases. */
1958 /* Make sure SIGCHLD is not blocked in the child. */
1959 sigsetmask (SIGEMPTYMASK
);
1962 /* Make the pty be the controlling terminal of the process. */
1964 /* First, disconnect its current controlling terminal. */
1966 /* We tried doing setsid only if pty_flag, but it caused
1967 process_set_signal to fail on SGI when using a pipe. */
1969 /* Make the pty's terminal the controlling terminal. */
1973 /* We ignore the return value
1974 because faith@cs.unc.edu says that is necessary on Linux. */
1975 ioctl (xforkin
, TIOCSCTTY
, 0);
1978 #else /* not HAVE_SETSID */
1980 /* It's very important to call setpgrp here and no time
1981 afterwards. Otherwise, we lose our controlling tty which
1982 is set when we open the pty. */
1985 #endif /* not HAVE_SETSID */
1986 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1987 if (pty_flag
&& xforkin
>= 0)
1990 tcgetattr (xforkin
, &t
);
1992 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
1993 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1996 #if defined (NTTYDISC) && defined (TIOCSETD)
1997 if (pty_flag
&& xforkin
>= 0)
1999 /* Use new line discipline. */
2000 int ldisc
= NTTYDISC
;
2001 ioctl (xforkin
, TIOCSETD
, &ldisc
);
2006 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2007 can do TIOCSPGRP only to the process's controlling tty. */
2010 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2011 I can't test it since I don't have 4.3. */
2012 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
2013 ioctl (j
, TIOCNOTTY
, 0);
2016 /* In order to get a controlling terminal on some versions
2017 of BSD, it is necessary to put the process in pgrp 0
2018 before it opens the terminal. */
2026 #endif /* TIOCNOTTY */
2028 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2029 /*** There is a suggestion that this ought to be a
2030 conditional on TIOCSPGRP,
2031 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2032 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2033 that system does seem to need this code, even though
2034 both HAVE_SETSID and TIOCSCTTY are defined. */
2035 /* Now close the pty (if we had it open) and reopen it.
2036 This makes the pty the controlling terminal of the subprocess. */
2039 #ifdef SET_CHILD_PTY_PGRP
2040 int pgrp
= getpid ();
2043 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2046 emacs_close (xforkin
);
2047 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2051 emacs_write (1, "Couldn't open the pty terminal ", 31);
2052 emacs_write (1, pty_name
, strlen (pty_name
));
2053 emacs_write (1, "\n", 1);
2057 #ifdef SET_CHILD_PTY_PGRP
2058 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
2059 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
2062 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
2064 #ifdef SETUP_SLAVE_PTY
2069 #endif /* SETUP_SLAVE_PTY */
2071 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2072 Now reenable it in the child, so it will die when we want it to. */
2074 signal (SIGHUP
, SIG_DFL
);
2076 #endif /* HAVE_PTYS */
2078 signal (SIGINT
, SIG_DFL
);
2079 signal (SIGQUIT
, SIG_DFL
);
2081 /* Stop blocking signals in the child. */
2082 #ifdef POSIX_SIGNALS
2083 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2084 #else /* !POSIX_SIGNALS */
2088 #else /* not BSD4_1 */
2089 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2090 sigsetmask (SIGEMPTYMASK
);
2091 #else /* ordinary USG */
2093 signal (SIGCHLD
, sigchld
);
2095 #endif /* ordinary USG */
2096 #endif /* not BSD4_1 */
2097 #endif /* SIGCHLD */
2098 #endif /* !POSIX_SIGNALS */
2100 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2102 child_setup_tty (xforkout
);
2103 #endif /* not RTU and not UNIPLUS and not DONT_REOPEN_PTY */
2105 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2106 new_argv
, 1, current_dir
);
2107 #else /* not WINDOWSNT */
2108 child_setup (xforkin
, xforkout
, xforkout
,
2109 new_argv
, 1, current_dir
);
2110 #endif /* not WINDOWSNT */
2112 environ
= save_environ
;
2117 /* This runs in the Emacs process. */
2121 emacs_close (forkin
);
2122 if (forkin
!= forkout
&& forkout
>= 0)
2123 emacs_close (forkout
);
2127 /* vfork succeeded. */
2128 XSETFASTINT (XPROCESS (process
)->pid
, pid
);
2131 register_child (pid
, inchannel
);
2132 #endif /* WINDOWSNT */
2134 /* If the subfork execv fails, and it exits,
2135 this close hangs. I don't know why.
2136 So have an interrupt jar it loose. */
2138 struct atimer
*timer
;
2142 EMACS_SET_SECS_USECS (offset
, 1, 0);
2143 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2146 emacs_close (forkin
);
2148 cancel_atimer (timer
);
2152 if (forkin
!= forkout
&& forkout
>= 0)
2153 emacs_close (forkout
);
2157 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2160 XPROCESS (process
)->tty_name
= Qnil
;
2163 /* Restore the signal state whether vfork succeeded or not.
2164 (We will signal an error, below, if it failed.) */
2165 #ifdef POSIX_SIGNALS
2166 #ifdef HAVE_WORKING_VFORK
2167 /* Restore the parent's signal handlers. */
2168 sigaction (SIGINT
, &sigint_action
, 0);
2169 sigaction (SIGQUIT
, &sigquit_action
, 0);
2171 sigaction (SIGHUP
, &sighup_action
, 0);
2173 #endif /* HAVE_WORKING_VFORK */
2174 /* Stop blocking signals in the parent. */
2175 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2176 #else /* !POSIX_SIGNALS */
2180 #else /* not BSD4_1 */
2181 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2182 sigsetmask (SIGEMPTYMASK
);
2183 #else /* ordinary USG */
2185 signal (SIGCHLD
, sigchld
);
2186 /* Now really handle any of these signals
2187 that came in during this function. */
2188 if (sigchld_deferred
)
2189 kill (getpid (), SIGCHLD
);
2191 #endif /* ordinary USG */
2192 #endif /* not BSD4_1 */
2193 #endif /* SIGCHLD */
2194 #endif /* !POSIX_SIGNALS */
2196 /* Now generate the error if vfork failed. */
2198 report_file_error ("Doing vfork", Qnil
);
2200 #endif /* not VMS */
2205 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2206 The address family of sa is not included in the result. */
2209 conv_sockaddr_to_lisp (sa
, len
)
2210 struct sockaddr
*sa
;
2213 Lisp_Object address
;
2216 register struct Lisp_Vector
*p
;
2218 switch (sa
->sa_family
)
2222 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2223 len
= sizeof (sin
->sin_addr
) + 1;
2224 address
= Fmake_vector (make_number (len
), Qnil
);
2225 p
= XVECTOR (address
);
2226 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2227 cp
= (unsigned char *)&sin
->sin_addr
;
2233 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2234 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2235 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2236 address
= Fmake_vector (make_number (len
), Qnil
);
2237 p
= XVECTOR (address
);
2238 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2239 for (i
= 0; i
< len
; i
++)
2240 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2244 #ifdef HAVE_LOCAL_SOCKETS
2247 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2248 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2249 if (sockun
->sun_path
[i
] == 0)
2251 return make_unibyte_string (sockun
->sun_path
, i
);
2255 len
-= sizeof (sa
->sa_family
);
2256 address
= Fcons (make_number (sa
->sa_family
),
2257 Fmake_vector (make_number (len
), Qnil
));
2258 p
= XVECTOR (XCDR (address
));
2259 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2265 p
->contents
[i
++] = make_number (*cp
++);
2271 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2274 get_lisp_to_sockaddr_size (address
, familyp
)
2275 Lisp_Object address
;
2278 register struct Lisp_Vector
*p
;
2280 if (VECTORP (address
))
2282 p
= XVECTOR (address
);
2286 return sizeof (struct sockaddr_in
);
2289 else if (p
->size
== 9)
2291 *familyp
= AF_INET6
;
2292 return sizeof (struct sockaddr_in6
);
2296 #ifdef HAVE_LOCAL_SOCKETS
2297 else if (STRINGP (address
))
2299 *familyp
= AF_LOCAL
;
2300 return sizeof (struct sockaddr_un
);
2303 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2305 struct sockaddr
*sa
;
2306 *familyp
= XINT (XCAR (address
));
2307 p
= XVECTOR (XCDR (address
));
2308 return p
->size
+ sizeof (sa
->sa_family
);
2313 /* Convert an address object (vector or string) to an internal sockaddr.
2314 Format of address has already been validated by size_lisp_to_sockaddr. */
2317 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2319 Lisp_Object address
;
2320 struct sockaddr
*sa
;
2323 register struct Lisp_Vector
*p
;
2324 register unsigned char *cp
= NULL
;
2328 sa
->sa_family
= family
;
2330 if (VECTORP (address
))
2332 p
= XVECTOR (address
);
2333 if (family
== AF_INET
)
2335 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2336 len
= sizeof (sin
->sin_addr
) + 1;
2337 i
= XINT (p
->contents
[--len
]);
2338 sin
->sin_port
= htons (i
);
2339 cp
= (unsigned char *)&sin
->sin_addr
;
2342 else if (family
== AF_INET6
)
2344 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2345 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2346 len
= sizeof (sin6
->sin6_addr
) + 1;
2347 i
= XINT (p
->contents
[--len
]);
2348 sin6
->sin6_port
= htons (i
);
2349 for (i
= 0; i
< len
; i
++)
2350 if (INTEGERP (p
->contents
[i
]))
2352 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2359 else if (STRINGP (address
))
2361 #ifdef HAVE_LOCAL_SOCKETS
2362 if (family
== AF_LOCAL
)
2364 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2365 cp
= SDATA (address
);
2366 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2367 sockun
->sun_path
[i
] = *cp
++;
2374 p
= XVECTOR (XCDR (address
));
2375 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2378 for (i
= 0; i
< len
; i
++)
2379 if (INTEGERP (p
->contents
[i
]))
2380 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2383 #ifdef DATAGRAM_SOCKETS
2384 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2386 doc
: /* Get the current datagram address associated with PROCESS. */)
2388 Lisp_Object process
;
2392 CHECK_PROCESS (process
);
2394 if (!DATAGRAM_CONN_P (process
))
2397 channel
= XINT (XPROCESS (process
)->infd
);
2398 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2399 datagram_address
[channel
].len
);
2402 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2404 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2405 Returns nil upon error setting address, ADDRESS otherwise. */)
2407 Lisp_Object process
, address
;
2412 CHECK_PROCESS (process
);
2414 if (!DATAGRAM_CONN_P (process
))
2417 channel
= XINT (XPROCESS (process
)->infd
);
2419 len
= get_lisp_to_sockaddr_size (address
, &family
);
2420 if (datagram_address
[channel
].len
!= len
)
2422 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2428 static struct socket_options
{
2429 /* The name of this option. Should be lowercase version of option
2430 name without SO_ prefix. */
2432 /* Option level SOL_... */
2434 /* Option number SO_... */
2436 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2437 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2438 } socket_options
[] =
2440 #ifdef SO_BINDTODEVICE
2441 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2444 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2447 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2450 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2453 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2456 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2459 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2462 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2464 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2467 /* Set option OPT to value VAL on socket S.
2469 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2470 Signals an error if setting a known option fails.
2474 set_socket_option (s
, opt
, val
)
2476 Lisp_Object opt
, val
;
2479 struct socket_options
*sopt
;
2484 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2485 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2486 if (strcmp (name
, sopt
->name
) == 0)
2489 switch (sopt
->opttype
)
2494 optval
= NILP (val
) ? 0 : 1;
2495 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2496 &optval
, sizeof (optval
));
2504 optval
= XINT (val
);
2506 error ("Bad option value for %s", name
);
2507 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2508 &optval
, sizeof (optval
));
2512 #ifdef SO_BINDTODEVICE
2515 char devname
[IFNAMSIZ
+1];
2517 /* This is broken, at least in the Linux 2.4 kernel.
2518 To unbind, the arg must be a zero integer, not the empty string.
2519 This should work on all systems. KFS. 2003-09-23. */
2520 bzero (devname
, sizeof devname
);
2523 char *arg
= (char *) SDATA (val
);
2524 int len
= min (strlen (arg
), IFNAMSIZ
);
2525 bcopy (arg
, devname
, len
);
2527 else if (!NILP (val
))
2528 error ("Bad option value for %s", name
);
2529 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2538 struct linger linger
;
2541 linger
.l_linger
= 0;
2543 linger
.l_linger
= XINT (val
);
2545 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2546 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2547 &linger
, sizeof (linger
));
2557 report_file_error ("Cannot set network option",
2558 Fcons (opt
, Fcons (val
, Qnil
)));
2559 return (1 << sopt
->optbit
);
2563 DEFUN ("set-network-process-option",
2564 Fset_network_process_option
, Sset_network_process_option
,
2566 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2567 See `make-network-process' for a list of options and values.
2568 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2569 OPTION is not a supported option, return nil instead; otherwise return t. */)
2570 (process
, option
, value
, no_error
)
2571 Lisp_Object process
, option
, value
;
2572 Lisp_Object no_error
;
2575 struct Lisp_Process
*p
;
2577 CHECK_PROCESS (process
);
2578 p
= XPROCESS (process
);
2579 if (!NETCONN1_P (p
))
2580 error ("Process is not a network process");
2584 error ("Process is not running");
2586 if (set_socket_option (s
, option
, value
))
2588 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2592 if (NILP (no_error
))
2593 error ("Unknown or unsupported option");
2599 /* A version of request_sigio suitable for a record_unwind_protect. */
2602 unwind_request_sigio (dummy
)
2605 if (interrupt_input
)
2610 /* Create a network stream/datagram client/server process. Treated
2611 exactly like a normal process when reading and writing. Primary
2612 differences are in status display and process deletion. A network
2613 connection has no PID; you cannot signal it. All you can do is
2614 stop/continue it and deactivate/close it via delete-process */
2616 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2618 doc
: /* Create and return a network server or client process.
2620 In Emacs, network connections are represented by process objects, so
2621 input and output work as for subprocesses and `delete-process' closes
2622 a network connection. However, a network process has no process id,
2623 it cannot be signaled, and the status codes are different from normal
2626 Arguments are specified as keyword/argument pairs. The following
2627 arguments are defined:
2629 :name NAME -- NAME is name for process. It is modified if necessary
2632 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2633 with the process. Process output goes at end of that buffer, unless
2634 you specify an output stream or filter function to handle the output.
2635 BUFFER may be also nil, meaning that this process is not associated
2638 :host HOST -- HOST is name of the host to connect to, or its IP
2639 address. The symbol `local' specifies the local host. If specified
2640 for a server process, it must be a valid name or address for the local
2641 host, and only clients connecting to that address will be accepted.
2643 :service SERVICE -- SERVICE is name of the service desired, or an
2644 integer specifying a port number to connect to. If SERVICE is t,
2645 a random port number is selected for the server.
2647 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2648 stream type connection, `datagram' creates a datagram type connection.
2650 :family FAMILY -- FAMILY is the address (and protocol) family for the
2651 service specified by HOST and SERVICE. The default (nil) is to use
2652 whatever address family (IPv4 or IPv6) that is defined for the host
2653 and port number specified by HOST and SERVICE. Other address families
2655 local -- for a local (i.e. UNIX) address specified by SERVICE.
2656 ipv4 -- use IPv4 address family only.
2657 ipv6 -- use IPv6 address family only.
2659 :local ADDRESS -- ADDRESS is the local address used for the connection.
2660 This parameter is ignored when opening a client process. When specified
2661 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2663 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2664 connection. This parameter is ignored when opening a stream server
2665 process. For a datagram server process, it specifies the initial
2666 setting of the remote datagram address. When specified for a client
2667 process, the FAMILY, HOST, and SERVICE args are ignored.
2669 The format of ADDRESS depends on the address family:
2670 - An IPv4 address is represented as an vector of integers [A B C D P]
2671 corresponding to numeric IP address A.B.C.D and port number P.
2672 - A local address is represented as a string with the address in the
2673 local address space.
2674 - An "unsupported family" address is represented by a cons (F . AV)
2675 where F is the family number and AV is a vector containing the socket
2676 address data with one element per address data byte. Do not rely on
2677 this format in portable code, as it may depend on implementation
2678 defined constants, data sizes, and data structure alignment.
2680 :coding CODING -- If CODING is a symbol, it specifies the coding
2681 system used for both reading and writing for this process. If CODING
2682 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2683 ENCODING is used for writing.
2685 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2686 return without waiting for the connection to complete; instead, the
2687 sentinel function will be called with second arg matching "open" (if
2688 successful) or "failed" when the connect completes. Default is to use
2689 a blocking connect (i.e. wait) for stream type connections.
2691 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2692 running when Emacs is exited.
2694 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2695 In the stopped state, a server process does not accept new
2696 connections, and a client process does not handle incoming traffic.
2697 The stopped state is cleared by `continue-process' and set by
2700 :filter FILTER -- Install FILTER as the process filter.
2702 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2703 process filter are multibyte, otherwise they are unibyte.
2704 If this keyword is not specified, the strings are multibyte iff
2705 `default-enable-multibyte-characters' is non-nil.
2707 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2709 :log LOG -- Install LOG as the server process log function. This
2710 function is called when the server accepts a network connection from a
2711 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2712 is the server process, CLIENT is the new process for the connection,
2713 and MESSAGE is a string.
2715 :plist PLIST -- Install PLIST as the new process' initial plist.
2717 :server QLEN -- if QLEN is non-nil, create a server process for the
2718 specified FAMILY, SERVICE, and connection type (stream or datagram).
2719 If QLEN is an integer, it is used as the max. length of the server's
2720 pending connection queue (also known as the backlog); the default
2721 queue length is 5. Default is to create a client process.
2723 The following network options can be specified for this connection:
2725 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2726 :dontroute BOOL -- Only send to directly connected hosts.
2727 :keepalive BOOL -- Send keep-alive messages on network stream.
2728 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2729 :oobinline BOOL -- Place out-of-band data in receive data stream.
2730 :priority INT -- Set protocol defined priority for sent packets.
2731 :reuseaddr BOOL -- Allow reusing a recently used local address
2732 (this is allowed by default for a server process).
2733 :bindtodevice NAME -- bind to interface NAME. Using this may require
2734 special privileges on some systems.
2736 Consult the relevant system programmer's manual pages for more
2737 information on using these options.
2740 A server process will listen for and accept connections from clients.
2741 When a client connection is accepted, a new network process is created
2742 for the connection with the following parameters:
2744 - The client's process name is constructed by concatenating the server
2745 process' NAME and a client identification string.
2746 - If the FILTER argument is non-nil, the client process will not get a
2747 separate process buffer; otherwise, the client's process buffer is a newly
2748 created buffer named after the server process' BUFFER name or process
2749 NAME concatenated with the client identification string.
2750 - The connection type and the process filter and sentinel parameters are
2751 inherited from the server process' TYPE, FILTER and SENTINEL.
2752 - The client process' contact info is set according to the client's
2753 addressing information (typically an IP address and a port number).
2754 - The client process' plist is initialized from the server's plist.
2756 Notice that the FILTER and SENTINEL args are never used directly by
2757 the server process. Also, the BUFFER argument is not used directly by
2758 the server process, but via the optional :log function, accepted (and
2759 failed) connections may be logged in the server process' buffer.
2761 The original argument list, modified with the actual connection
2762 information, is available via the `process-contact' function.
2764 usage: (make-network-process &rest ARGS) */)
2770 Lisp_Object contact
;
2771 struct Lisp_Process
*p
;
2772 #ifdef HAVE_GETADDRINFO
2773 struct addrinfo ai
, *res
, *lres
;
2774 struct addrinfo hints
;
2775 char *portstring
, portbuf
[128];
2776 #else /* HAVE_GETADDRINFO */
2777 struct _emacs_addrinfo
2783 struct sockaddr
*ai_addr
;
2784 struct _emacs_addrinfo
*ai_next
;
2786 #endif /* HAVE_GETADDRINFO */
2787 struct sockaddr_in address_in
;
2788 #ifdef HAVE_LOCAL_SOCKETS
2789 struct sockaddr_un address_un
;
2794 int s
= -1, outch
, inch
;
2795 struct gcpro gcpro1
;
2796 int count
= SPECPDL_INDEX ();
2798 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2800 Lisp_Object name
, buffer
, host
, service
, address
;
2801 Lisp_Object filter
, sentinel
;
2802 int is_non_blocking_client
= 0;
2803 int is_server
= 0, backlog
= 5;
2810 /* Save arguments for process-contact and clone-process. */
2811 contact
= Flist (nargs
, args
);
2815 /* Ensure socket support is loaded if available. */
2816 init_winsock (TRUE
);
2819 /* :type TYPE (nil: stream, datagram */
2820 tem
= Fplist_get (contact
, QCtype
);
2822 socktype
= SOCK_STREAM
;
2823 #ifdef DATAGRAM_SOCKETS
2824 else if (EQ (tem
, Qdatagram
))
2825 socktype
= SOCK_DGRAM
;
2828 error ("Unsupported connection type");
2831 tem
= Fplist_get (contact
, QCserver
);
2834 /* Don't support network sockets when non-blocking mode is
2835 not available, since a blocked Emacs is not useful. */
2836 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2837 error ("Network servers not supported");
2841 backlog
= XINT (tem
);
2845 /* Make QCaddress an alias for :local (server) or :remote (client). */
2846 QCaddress
= is_server
? QClocal
: QCremote
;
2849 if (!is_server
&& socktype
== SOCK_STREAM
2850 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2852 #ifndef NON_BLOCKING_CONNECT
2853 error ("Non-blocking connect not supported");
2855 is_non_blocking_client
= 1;
2859 name
= Fplist_get (contact
, QCname
);
2860 buffer
= Fplist_get (contact
, QCbuffer
);
2861 filter
= Fplist_get (contact
, QCfilter
);
2862 sentinel
= Fplist_get (contact
, QCsentinel
);
2864 CHECK_STRING (name
);
2867 /* Let's handle TERM before things get complicated ... */
2868 host
= Fplist_get (contact
, QChost
);
2869 CHECK_STRING (host
);
2871 service
= Fplist_get (contact
, QCservice
);
2872 if (INTEGERP (service
))
2873 port
= htons ((unsigned short) XINT (service
));
2876 struct servent
*svc_info
;
2877 CHECK_STRING (service
);
2878 svc_info
= getservbyname (SDATA (service
), "tcp");
2880 error ("Unknown service: %s", SDATA (service
));
2881 port
= svc_info
->s_port
;
2884 s
= connect_server (0);
2886 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2887 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2888 send_command (s
, C_DUMB
, 1, 0);
2890 #else /* not TERM */
2892 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2893 ai
.ai_socktype
= socktype
;
2898 /* :local ADDRESS or :remote ADDRESS */
2899 address
= Fplist_get (contact
, QCaddress
);
2900 if (!NILP (address
))
2902 host
= service
= Qnil
;
2904 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2905 error ("Malformed :address");
2906 ai
.ai_family
= family
;
2907 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2908 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2912 /* :family FAMILY -- nil (for Inet), local, or integer. */
2913 tem
= Fplist_get (contact
, QCfamily
);
2916 #ifdef HAVE_GETADDRINFO
2922 #ifdef HAVE_LOCAL_SOCKETS
2923 else if (EQ (tem
, Qlocal
))
2927 else if (EQ (tem
, Qipv6
))
2930 else if (EQ (tem
, Qipv4
))
2932 else if (INTEGERP (tem
))
2933 family
= XINT (tem
);
2935 error ("Unknown address family");
2937 ai
.ai_family
= family
;
2939 /* :service SERVICE -- string, integer (port number), or t (random port). */
2940 service
= Fplist_get (contact
, QCservice
);
2942 #ifdef HAVE_LOCAL_SOCKETS
2943 if (family
== AF_LOCAL
)
2945 /* Host is not used. */
2947 CHECK_STRING (service
);
2948 bzero (&address_un
, sizeof address_un
);
2949 address_un
.sun_family
= AF_LOCAL
;
2950 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
2951 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
2952 ai
.ai_addrlen
= sizeof address_un
;
2957 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2958 host
= Fplist_get (contact
, QChost
);
2961 if (EQ (host
, Qlocal
))
2962 host
= build_string ("localhost");
2963 CHECK_STRING (host
);
2966 /* Slow down polling to every ten seconds.
2967 Some kernels have a bug which causes retrying connect to fail
2968 after a connect. Polling can interfere with gethostbyname too. */
2969 #ifdef POLL_FOR_INPUT
2970 if (socktype
== SOCK_STREAM
)
2972 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
2973 bind_polling_period (10);
2977 #ifdef HAVE_GETADDRINFO
2978 /* If we have a host, use getaddrinfo to resolve both host and service.
2979 Otherwise, use getservbyname to lookup the service. */
2983 /* SERVICE can either be a string or int.
2984 Convert to a C string for later use by getaddrinfo. */
2985 if (EQ (service
, Qt
))
2987 else if (INTEGERP (service
))
2989 sprintf (portbuf
, "%ld", (long) XINT (service
));
2990 portstring
= portbuf
;
2994 CHECK_STRING (service
);
2995 portstring
= SDATA (service
);
3000 memset (&hints
, 0, sizeof (hints
));
3002 hints
.ai_family
= family
;
3003 hints
.ai_socktype
= socktype
;
3004 hints
.ai_protocol
= 0;
3005 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3007 #ifdef HAVE_GAI_STRERROR
3008 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
3010 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3016 #endif /* HAVE_GETADDRINFO */
3018 /* We end up here if getaddrinfo is not defined, or in case no hostname
3019 has been specified (e.g. for a local server process). */
3021 if (EQ (service
, Qt
))
3023 else if (INTEGERP (service
))
3024 port
= htons ((unsigned short) XINT (service
));
3027 struct servent
*svc_info
;
3028 CHECK_STRING (service
);
3029 svc_info
= getservbyname (SDATA (service
),
3030 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3032 error ("Unknown service: %s", SDATA (service
));
3033 port
= svc_info
->s_port
;
3036 bzero (&address_in
, sizeof address_in
);
3037 address_in
.sin_family
= family
;
3038 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3039 address_in
.sin_port
= port
;
3041 #ifndef HAVE_GETADDRINFO
3044 struct hostent
*host_info_ptr
;
3046 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3047 as it may `hang' Emacs for a very long time. */
3050 host_info_ptr
= gethostbyname (SDATA (host
));
3055 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
3056 host_info_ptr
->h_length
);
3057 family
= host_info_ptr
->h_addrtype
;
3058 address_in
.sin_family
= family
;
3061 /* Attempt to interpret host as numeric inet address */
3063 IN_ADDR numeric_addr
;
3064 numeric_addr
= inet_addr ((char *) SDATA (host
));
3065 if (NUMERIC_ADDR_ERROR
)
3066 error ("Unknown host \"%s\"", SDATA (host
));
3068 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
3069 sizeof (address_in
.sin_addr
));
3073 #endif /* not HAVE_GETADDRINFO */
3075 ai
.ai_family
= family
;
3076 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3077 ai
.ai_addrlen
= sizeof address_in
;
3081 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
3082 when connect is interrupted. So let's not let it get interrupted.
3083 Note we do not turn off polling, because polling is only used
3084 when not interrupt_input, and thus not normally used on the systems
3085 which have this bug. On systems which use polling, there's no way
3086 to quit if polling is turned off. */
3088 && !is_server
&& socktype
== SOCK_STREAM
)
3090 /* Comment from KFS: The original open-network-stream code
3091 didn't unwind protect this, but it seems like the proper
3092 thing to do. In any case, I don't see how it could harm to
3093 do this -- and it makes cleanup (using unbind_to) easier. */
3094 record_unwind_protect (unwind_request_sigio
, Qnil
);
3098 /* Do this in case we never enter the for-loop below. */
3099 count1
= SPECPDL_INDEX ();
3102 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3108 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3115 #ifdef DATAGRAM_SOCKETS
3116 if (!is_server
&& socktype
== SOCK_DGRAM
)
3118 #endif /* DATAGRAM_SOCKETS */
3120 #ifdef NON_BLOCKING_CONNECT
3121 if (is_non_blocking_client
)
3124 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3126 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3138 /* Make us close S if quit. */
3139 record_unwind_protect (close_file_unwind
, make_number (s
));
3141 /* Parse network options in the arg list.
3142 We simply ignore anything which isn't a known option (including other keywords).
3143 An error is signalled if setting a known option fails. */
3144 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3145 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3149 /* Configure as a server socket. */
3151 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3152 explicit :reuseaddr key to override this. */
3153 #ifdef HAVE_LOCAL_SOCKETS
3154 if (family
!= AF_LOCAL
)
3156 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3159 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3160 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3163 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3164 report_file_error ("Cannot bind server socket", Qnil
);
3166 #ifdef HAVE_GETSOCKNAME
3167 if (EQ (service
, Qt
))
3169 struct sockaddr_in sa1
;
3170 int len1
= sizeof (sa1
);
3171 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3173 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3174 service
= make_number (ntohs (sa1
.sin_port
));
3175 contact
= Fplist_put (contact
, QCservice
, service
);
3180 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3181 report_file_error ("Cannot listen on server socket", Qnil
);
3189 /* This turns off all alarm-based interrupts; the
3190 bind_polling_period call above doesn't always turn all the
3191 short-interval ones off, especially if interrupt_input is
3194 It'd be nice to be able to control the connect timeout
3195 though. Would non-blocking connect calls be portable?
3197 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3199 turn_on_atimers (0);
3201 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3204 turn_on_atimers (1);
3206 if (ret
== 0 || xerrno
== EISCONN
)
3208 /* The unwind-protect will be discarded afterwards.
3209 Likewise for immediate_quit. */
3213 #ifdef NON_BLOCKING_CONNECT
3215 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3219 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3227 /* Discard the unwind protect closing S. */
3228 specpdl_ptr
= specpdl
+ count1
;
3232 if (xerrno
== EINTR
)
3238 #ifdef DATAGRAM_SOCKETS
3239 if (socktype
== SOCK_DGRAM
)
3241 if (datagram_address
[s
].sa
)
3243 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3244 datagram_address
[s
].len
= lres
->ai_addrlen
;
3248 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3249 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3252 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3253 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3254 conv_lisp_to_sockaddr (rfamily
, remote
,
3255 datagram_address
[s
].sa
, rlen
);
3259 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3262 contact
= Fplist_put (contact
, QCaddress
,
3263 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3264 #ifdef HAVE_GETSOCKNAME
3267 struct sockaddr_in sa1
;
3268 int len1
= sizeof (sa1
);
3269 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3270 contact
= Fplist_put (contact
, QClocal
,
3271 conv_sockaddr_to_lisp (&sa1
, len1
));
3276 #ifdef HAVE_GETADDRINFO
3283 /* Discard the unwind protect for closing S, if any. */
3284 specpdl_ptr
= specpdl
+ count1
;
3286 /* Unwind bind_polling_period and request_sigio. */
3287 unbind_to (count
, Qnil
);
3291 /* If non-blocking got this far - and failed - assume non-blocking is
3292 not supported after all. This is probably a wrong assumption, but
3293 the normal blocking calls to open-network-stream handles this error
3295 if (is_non_blocking_client
)
3300 report_file_error ("make server process failed", contact
);
3302 report_file_error ("make client process failed", contact
);
3305 #endif /* not TERM */
3311 buffer
= Fget_buffer_create (buffer
);
3312 proc
= make_process (name
);
3314 chan_process
[inch
] = proc
;
3317 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3320 fcntl (inch
, F_SETFL
, O_NDELAY
);
3324 p
= XPROCESS (proc
);
3326 p
->childp
= contact
;
3327 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3330 p
->sentinel
= sentinel
;
3332 p
->filter_multibyte
= buffer_defaults
.enable_multibyte_characters
;
3333 /* Override the above only if :filter-multibyte is specified. */
3334 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3335 p
->filter_multibyte
= Fplist_get (contact
, QCfilter_multibyte
);
3336 p
->log
= Fplist_get (contact
, QClog
);
3337 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3338 p
->kill_without_query
= Qt
;
3339 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3342 XSETINT (p
->infd
, inch
);
3343 XSETINT (p
->outfd
, outch
);
3344 if (is_server
&& socktype
== SOCK_STREAM
)
3345 p
->status
= Qlisten
;
3347 #ifdef NON_BLOCKING_CONNECT
3348 if (is_non_blocking_client
)
3350 /* We may get here if connect did succeed immediately. However,
3351 in that case, we still need to signal this like a non-blocking
3353 p
->status
= Qconnect
;
3354 if (!FD_ISSET (inch
, &connect_wait_mask
))
3356 FD_SET (inch
, &connect_wait_mask
);
3357 num_pending_connects
++;
3362 /* A server may have a client filter setting of Qt, but it must
3363 still listen for incoming connects unless it is stopped. */
3364 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3365 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3367 FD_SET (inch
, &input_wait_mask
);
3368 FD_SET (inch
, &non_keyboard_wait_mask
);
3371 if (inch
> max_process_desc
)
3372 max_process_desc
= inch
;
3374 tem
= Fplist_member (contact
, QCcoding
);
3375 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3376 tem
= Qnil
; /* No error message (too late!). */
3379 /* Setup coding systems for communicating with the network stream. */
3380 struct gcpro gcpro1
;
3381 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3382 Lisp_Object coding_systems
= Qt
;
3383 Lisp_Object args
[5], val
;
3387 val
= XCAR (XCDR (tem
));
3391 else if (!NILP (Vcoding_system_for_read
))
3392 val
= Vcoding_system_for_read
;
3393 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3394 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3395 /* We dare not decode end-of-line format by setting VAL to
3396 Qraw_text, because the existing Emacs Lisp libraries
3397 assume that they receive bare code including a sequene of
3402 if (NILP (host
) || NILP (service
))
3403 coding_systems
= Qnil
;
3406 args
[0] = Qopen_network_stream
, args
[1] = name
,
3407 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3409 coding_systems
= Ffind_operation_coding_system (5, args
);
3412 if (CONSP (coding_systems
))
3413 val
= XCAR (coding_systems
);
3414 else if (CONSP (Vdefault_process_coding_system
))
3415 val
= XCAR (Vdefault_process_coding_system
);
3419 p
->decode_coding_system
= val
;
3423 val
= XCAR (XCDR (tem
));
3427 else if (!NILP (Vcoding_system_for_write
))
3428 val
= Vcoding_system_for_write
;
3429 else if (NILP (current_buffer
->enable_multibyte_characters
))
3433 if (EQ (coding_systems
, Qt
))
3435 if (NILP (host
) || NILP (service
))
3436 coding_systems
= Qnil
;
3439 args
[0] = Qopen_network_stream
, args
[1] = name
,
3440 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3442 coding_systems
= Ffind_operation_coding_system (5, args
);
3446 if (CONSP (coding_systems
))
3447 val
= XCDR (coding_systems
);
3448 else if (CONSP (Vdefault_process_coding_system
))
3449 val
= XCDR (Vdefault_process_coding_system
);
3453 p
->encode_coding_system
= val
;
3455 setup_process_coding_systems (proc
);
3457 p
->decoding_buf
= make_uninit_string (0);
3458 p
->decoding_carryover
= make_number (0);
3459 p
->encoding_buf
= make_uninit_string (0);
3460 p
->encoding_carryover
= make_number (0);
3462 p
->inherit_coding_system_flag
3463 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3469 #endif /* HAVE_SOCKETS */
3472 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3475 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3476 doc
: /* Return an alist of all network interfaces and their network address.
3477 Each element is a cons, the car of which is a string containing the
3478 interface name, and the cdr is the network address in internal
3479 format; see the description of ADDRESS in `make-network-process'. */)
3482 struct ifconf ifconf
;
3483 struct ifreq
*ifreqs
= NULL
;
3488 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3494 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3495 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3502 ifconf
.ifc_len
= buf_size
;
3503 ifconf
.ifc_req
= ifreqs
;
3504 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3510 if (ifconf
.ifc_len
== buf_size
)
3514 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3517 while (--ifaces
>= 0)
3519 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3520 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3521 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3523 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3524 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3525 res
= Fcons (Fcons (build_string (namebuf
),
3526 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3527 sizeof (struct sockaddr
))),
3533 #endif /* SIOCGIFCONF */
3535 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3542 static struct ifflag_def ifflag_table
[] = {
3546 #ifdef IFF_BROADCAST
3547 { IFF_BROADCAST
, "broadcast" },
3550 { IFF_DEBUG
, "debug" },
3553 { IFF_LOOPBACK
, "loopback" },
3555 #ifdef IFF_POINTOPOINT
3556 { IFF_POINTOPOINT
, "pointopoint" },
3559 { IFF_RUNNING
, "running" },
3562 { IFF_NOARP
, "noarp" },
3565 { IFF_PROMISC
, "promisc" },
3567 #ifdef IFF_NOTRAILERS
3568 { IFF_NOTRAILERS
, "notrailers" },
3571 { IFF_ALLMULTI
, "allmulti" },
3574 { IFF_MASTER
, "master" },
3577 { IFF_SLAVE
, "slave" },
3579 #ifdef IFF_MULTICAST
3580 { IFF_MULTICAST
, "multicast" },
3583 { IFF_PORTSEL
, "portsel" },
3585 #ifdef IFF_AUTOMEDIA
3586 { IFF_AUTOMEDIA
, "automedia" },
3589 { IFF_DYNAMIC
, "dynamic" },
3592 { IFF_OACTIV
, "oactiv" }, /* OpenBSD: transmission in progress */
3595 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3598 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3601 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3604 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3609 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3610 doc
: /* Return information about network interface named IFNAME.
3611 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3612 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3613 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3614 FLAGS is the current flags of the interface. */)
3619 Lisp_Object res
= Qnil
;
3624 CHECK_STRING (ifname
);
3626 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3627 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3629 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3634 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3635 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3637 int flags
= rq
.ifr_flags
;
3638 struct ifflag_def
*fp
;
3642 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3644 if (flags
& fp
->flag_bit
)
3646 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3647 flags
-= fp
->flag_bit
;
3650 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3652 if (flags
& (1 << fnum
))
3654 elt
= Fcons (make_number (fnum
), elt
);
3659 res
= Fcons (elt
, res
);
3662 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3663 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3665 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3666 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3670 for (n
= 0; n
< 6; n
++)
3671 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3672 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3675 res
= Fcons (elt
, res
);
3678 #if defined(SIOCGIFNETMASK) && defined(ifr_netmask)
3679 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3682 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3685 res
= Fcons (elt
, res
);
3688 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3689 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3692 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3695 res
= Fcons (elt
, res
);
3698 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3699 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3702 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3705 res
= Fcons (elt
, res
);
3709 return any
? res
: Qnil
;
3712 #endif /* HAVE_SOCKETS */
3714 /* Turn off input and output for process PROC. */
3717 deactivate_process (proc
)
3720 register int inchannel
, outchannel
;
3721 register struct Lisp_Process
*p
= XPROCESS (proc
);
3723 inchannel
= XINT (p
->infd
);
3724 outchannel
= XINT (p
->outfd
);
3726 #ifdef ADAPTIVE_READ_BUFFERING
3727 if (XINT (p
->read_output_delay
) > 0)
3729 if (--process_output_delay_count
< 0)
3730 process_output_delay_count
= 0;
3731 XSETINT (p
->read_output_delay
, 0);
3732 p
->read_output_skip
= Qnil
;
3738 /* Beware SIGCHLD hereabouts. */
3739 flush_pending_output (inchannel
);
3742 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3743 sys$
dassgn (outchannel
);
3744 vs
= get_vms_process_pointer (p
->pid
);
3746 give_back_vms_process_stuff (vs
);
3749 emacs_close (inchannel
);
3750 if (outchannel
>= 0 && outchannel
!= inchannel
)
3751 emacs_close (outchannel
);
3754 XSETINT (p
->infd
, -1);
3755 XSETINT (p
->outfd
, -1);
3756 #ifdef DATAGRAM_SOCKETS
3757 if (DATAGRAM_CHAN_P (inchannel
))
3759 xfree (datagram_address
[inchannel
].sa
);
3760 datagram_address
[inchannel
].sa
= 0;
3761 datagram_address
[inchannel
].len
= 0;
3764 chan_process
[inchannel
] = Qnil
;
3765 FD_CLR (inchannel
, &input_wait_mask
);
3766 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3767 #ifdef NON_BLOCKING_CONNECT
3768 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3770 FD_CLR (inchannel
, &connect_wait_mask
);
3771 if (--num_pending_connects
< 0)
3775 if (inchannel
== max_process_desc
)
3778 /* We just closed the highest-numbered process input descriptor,
3779 so recompute the highest-numbered one now. */
3780 max_process_desc
= 0;
3781 for (i
= 0; i
< MAXDESC
; i
++)
3782 if (!NILP (chan_process
[i
]))
3783 max_process_desc
= i
;
3788 /* Close all descriptors currently in use for communication
3789 with subprocess. This is used in a newly-forked subprocess
3790 to get rid of irrelevant descriptors. */
3793 close_process_descs ()
3797 for (i
= 0; i
< MAXDESC
; i
++)
3799 Lisp_Object process
;
3800 process
= chan_process
[i
];
3801 if (!NILP (process
))
3803 int in
= XINT (XPROCESS (process
)->infd
);
3804 int out
= XINT (XPROCESS (process
)->outfd
);
3807 if (out
>= 0 && in
!= out
)
3814 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3816 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3817 It is read into the process' buffers or given to their filter functions.
3818 Non-nil arg PROCESS means do not return until some output has been received
3820 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of
3821 seconds and microseconds to wait; return after that much time whether
3822 or not there is input.
3823 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3824 from PROCESS, suspending reading output from other processes.
3825 If JUST-THIS-ONE is an integer, don't run any timers either.
3826 Return non-nil iff we received any output before the timeout expired. */)
3827 (process
, timeout
, timeout_msecs
, just_this_one
)
3828 register Lisp_Object process
, timeout
, timeout_msecs
, just_this_one
;
3833 if (! NILP (process
))
3834 CHECK_PROCESS (process
);
3836 just_this_one
= Qnil
;
3838 if (! NILP (timeout_msecs
))
3840 CHECK_NUMBER (timeout_msecs
);
3841 useconds
= XINT (timeout_msecs
);
3842 if (!INTEGERP (timeout
))
3843 XSETINT (timeout
, 0);
3846 int carry
= useconds
/ 1000000;
3848 XSETINT (timeout
, XINT (timeout
) + carry
);
3849 useconds
-= carry
* 1000000;
3851 /* I think this clause is necessary because C doesn't
3852 guarantee a particular rounding direction for negative
3856 XSETINT (timeout
, XINT (timeout
) - 1);
3857 useconds
+= 1000000;
3864 if (! NILP (timeout
))
3866 CHECK_NUMBER (timeout
);
3867 seconds
= XINT (timeout
);
3868 if (seconds
< 0 || (seconds
== 0 && useconds
== 0))
3872 seconds
= NILP (process
) ? -1 : 0;
3875 (wait_reading_process_output (seconds
, useconds
, 0, 0,
3877 !NILP (process
) ? XPROCESS (process
) : NULL
,
3878 NILP (just_this_one
) ? 0 :
3879 !INTEGERP (just_this_one
) ? 1 : -1)
3883 /* Accept a connection for server process SERVER on CHANNEL. */
3885 static int connect_counter
= 0;
3888 server_accept_connection (server
, channel
)
3892 Lisp_Object proc
, caller
, name
, buffer
;
3893 Lisp_Object contact
, host
, service
;
3894 struct Lisp_Process
*ps
= XPROCESS (server
);
3895 struct Lisp_Process
*p
;
3899 struct sockaddr_in in
;
3901 struct sockaddr_in6 in6
;
3903 #ifdef HAVE_LOCAL_SOCKETS
3904 struct sockaddr_un un
;
3907 int len
= sizeof saddr
;
3909 s
= accept (channel
, &saddr
.sa
, &len
);
3918 if (code
== EWOULDBLOCK
)
3922 if (!NILP (ps
->log
))
3923 call3 (ps
->log
, server
, Qnil
,
3924 concat3 (build_string ("accept failed with code"),
3925 Fnumber_to_string (make_number (code
)),
3926 build_string ("\n")));
3932 /* Setup a new process to handle the connection. */
3934 /* Generate a unique identification of the caller, and build contact
3935 information for this process. */
3938 switch (saddr
.sa
.sa_family
)
3942 Lisp_Object args
[5];
3943 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
3944 args
[0] = build_string ("%d.%d.%d.%d");
3945 args
[1] = make_number (*ip
++);
3946 args
[2] = make_number (*ip
++);
3947 args
[3] = make_number (*ip
++);
3948 args
[4] = make_number (*ip
++);
3949 host
= Fformat (5, args
);
3950 service
= make_number (ntohs (saddr
.in
.sin_port
));
3952 args
[0] = build_string (" <%s:%d>");
3955 caller
= Fformat (3, args
);
3962 Lisp_Object args
[9];
3963 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
3965 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
3966 for (i
= 0; i
< 8; i
++)
3967 args
[i
+1] = make_number (ntohs(ip6
[i
]));
3968 host
= Fformat (9, args
);
3969 service
= make_number (ntohs (saddr
.in
.sin_port
));
3971 args
[0] = build_string (" <[%s]:%d>");
3974 caller
= Fformat (3, args
);
3979 #ifdef HAVE_LOCAL_SOCKETS
3983 caller
= Fnumber_to_string (make_number (connect_counter
));
3984 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
3988 /* Create a new buffer name for this process if it doesn't have a
3989 filter. The new buffer name is based on the buffer name or
3990 process name of the server process concatenated with the caller
3993 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
3997 buffer
= ps
->buffer
;
3999 buffer
= Fbuffer_name (buffer
);
4004 buffer
= concat2 (buffer
, caller
);
4005 buffer
= Fget_buffer_create (buffer
);
4009 /* Generate a unique name for the new server process. Combine the
4010 server process name with the caller identification. */
4012 name
= concat2 (ps
->name
, caller
);
4013 proc
= make_process (name
);
4015 chan_process
[s
] = proc
;
4018 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4021 fcntl (s
, F_SETFL
, O_NDELAY
);
4025 p
= XPROCESS (proc
);
4027 /* Build new contact information for this setup. */
4028 contact
= Fcopy_sequence (ps
->childp
);
4029 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4030 contact
= Fplist_put (contact
, QChost
, host
);
4031 if (!NILP (service
))
4032 contact
= Fplist_put (contact
, QCservice
, service
);
4033 contact
= Fplist_put (contact
, QCremote
,
4034 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4035 #ifdef HAVE_GETSOCKNAME
4037 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4038 contact
= Fplist_put (contact
, QClocal
,
4039 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4042 p
->childp
= contact
;
4043 p
->plist
= Fcopy_sequence (ps
->plist
);
4046 p
->sentinel
= ps
->sentinel
;
4047 p
->filter
= ps
->filter
;
4050 XSETINT (p
->infd
, s
);
4051 XSETINT (p
->outfd
, s
);
4054 /* Client processes for accepted connections are not stopped initially. */
4055 if (!EQ (p
->filter
, Qt
))
4057 FD_SET (s
, &input_wait_mask
);
4058 FD_SET (s
, &non_keyboard_wait_mask
);
4061 if (s
> max_process_desc
)
4062 max_process_desc
= s
;
4064 /* Setup coding system for new process based on server process.
4065 This seems to be the proper thing to do, as the coding system
4066 of the new process should reflect the settings at the time the
4067 server socket was opened; not the current settings. */
4069 p
->decode_coding_system
= ps
->decode_coding_system
;
4070 p
->encode_coding_system
= ps
->encode_coding_system
;
4071 setup_process_coding_systems (proc
);
4073 p
->decoding_buf
= make_uninit_string (0);
4074 p
->decoding_carryover
= make_number (0);
4075 p
->encoding_buf
= make_uninit_string (0);
4076 p
->encoding_carryover
= make_number (0);
4078 p
->inherit_coding_system_flag
4079 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
4081 if (!NILP (ps
->log
))
4082 call3 (ps
->log
, server
, proc
,
4083 concat3 (build_string ("accept from "),
4084 (STRINGP (host
) ? host
: build_string ("-")),
4085 build_string ("\n")));
4087 if (!NILP (p
->sentinel
))
4088 exec_sentinel (proc
,
4089 concat3 (build_string ("open from "),
4090 (STRINGP (host
) ? host
: build_string ("-")),
4091 build_string ("\n")));
4094 /* This variable is different from waiting_for_input in keyboard.c.
4095 It is used to communicate to a lisp process-filter/sentinel (via the
4096 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4097 for user-input when that process-filter was called.
4098 waiting_for_input cannot be used as that is by definition 0 when
4099 lisp code is being evalled.
4100 This is also used in record_asynch_buffer_change.
4101 For that purpose, this must be 0
4102 when not inside wait_reading_process_output. */
4103 static int waiting_for_user_input_p
;
4105 /* This is here so breakpoints can be put on it. */
4107 wait_reading_process_output_1 ()
4111 /* Read and dispose of subprocess output while waiting for timeout to
4112 elapse and/or keyboard input to be available.
4115 timeout in seconds, or
4116 zero for no limit, or
4117 -1 means gobble data immediately available but don't wait for any.
4120 an additional duration to wait, measured in microseconds.
4121 If this is nonzero and time_limit is 0, then the timeout
4122 consists of MICROSECS only.
4124 READ_KBD is a lisp value:
4125 0 to ignore keyboard input, or
4126 1 to return when input is available, or
4127 -1 meaning caller will actually read the input, so don't throw to
4128 the quit handler, or
4130 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4131 output that arrives.
4133 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4134 (and gobble terminal input into the buffer if any arrives).
4136 If WAIT_PROC is specified, wait until something arrives from that
4137 process. The return value is true iff we read some input from
4140 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4141 (suspending output from other processes). A negative value
4142 means don't run any timers either.
4144 If WAIT_PROC is specified, then the function returns true iff we
4145 received input from that process before the timeout elapsed.
4146 Otherwise, return true iff we received input from any process. */
4149 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
4150 wait_for_cell
, wait_proc
, just_wait_proc
)
4151 int time_limit
, microsecs
, read_kbd
, do_display
;
4152 Lisp_Object wait_for_cell
;
4153 struct Lisp_Process
*wait_proc
;
4156 register int channel
, nfds
;
4157 SELECT_TYPE Available
;
4158 #ifdef NON_BLOCKING_CONNECT
4159 SELECT_TYPE Connecting
;
4162 int check_delay
, no_avail
;
4165 EMACS_TIME timeout
, end_time
;
4166 int wait_channel
= -1;
4167 int got_some_input
= 0;
4168 /* Either nil or a cons cell, the car of which is of interest and
4169 may be changed outside of this routine. */
4170 int saved_waiting_for_user_input_p
= waiting_for_user_input_p
;
4172 FD_ZERO (&Available
);
4173 #ifdef NON_BLOCKING_CONNECT
4174 FD_ZERO (&Connecting
);
4177 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4178 if (wait_proc
!= NULL
)
4179 wait_channel
= XINT (wait_proc
->infd
);
4181 waiting_for_user_input_p
= read_kbd
;
4183 /* Since we may need to wait several times,
4184 compute the absolute time to return at. */
4185 if (time_limit
|| microsecs
)
4187 EMACS_GET_TIME (end_time
);
4188 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4189 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4191 #ifdef POLL_INTERRUPTED_SYS_CALL
4192 /* AlainF 5-Jul-1996
4193 HP-UX 10.10 seem to have problems with signals coming in
4194 Causes "poll: interrupted system call" messages when Emacs is run
4196 Turn off periodic alarms (in case they are in use),
4197 and then turn off any other atimers. */
4199 turn_on_atimers (0);
4200 #endif /* POLL_INTERRUPTED_SYS_CALL */
4204 int timeout_reduced_for_timers
= 0;
4206 /* If calling from keyboard input, do not quit
4207 since we want to return C-g as an input character.
4208 Otherwise, do pending quit if requested. */
4212 else if (interrupt_input_pending
)
4213 handle_async_input ();
4216 /* Exit now if the cell we're waiting for became non-nil. */
4217 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4220 /* Compute time from now till when time limit is up */
4221 /* Exit if already run out */
4222 if (time_limit
== -1)
4224 /* -1 specified for timeout means
4225 gobble output available now
4226 but don't wait at all. */
4228 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4230 else if (time_limit
|| microsecs
)
4232 EMACS_GET_TIME (timeout
);
4233 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4234 if (EMACS_TIME_NEG_P (timeout
))
4239 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4242 /* Normally we run timers here.
4243 But not if wait_for_cell; in those cases,
4244 the wait is supposed to be short,
4245 and those callers cannot handle running arbitrary Lisp code here. */
4246 if (NILP (wait_for_cell
)
4247 && just_wait_proc
>= 0)
4249 EMACS_TIME timer_delay
;
4253 int old_timers_run
= timers_run
;
4254 struct buffer
*old_buffer
= current_buffer
;
4256 timer_delay
= timer_check (1);
4258 /* If a timer has run, this might have changed buffers
4259 an alike. Make read_key_sequence aware of that. */
4260 if (timers_run
!= old_timers_run
4261 && old_buffer
!= current_buffer
4262 && waiting_for_user_input_p
== -1)
4263 record_asynch_buffer_change ();
4265 if (timers_run
!= old_timers_run
&& do_display
)
4266 /* We must retry, since a timer may have requeued itself
4267 and that could alter the time_delay. */
4268 redisplay_preserve_echo_area (9);
4272 while (!detect_input_pending ());
4274 /* If there is unread keyboard input, also return. */
4276 && requeued_events_pending_p ())
4279 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4281 EMACS_TIME difference
;
4282 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4283 if (EMACS_TIME_NEG_P (difference
))
4285 timeout
= timer_delay
;
4286 timeout_reduced_for_timers
= 1;
4289 /* If time_limit is -1, we are not going to wait at all. */
4290 else if (time_limit
!= -1)
4292 /* This is so a breakpoint can be put here. */
4293 wait_reading_process_output_1 ();
4297 /* Cause C-g and alarm signals to take immediate action,
4298 and cause input available signals to zero out timeout.
4300 It is important that we do this before checking for process
4301 activity. If we get a SIGCHLD after the explicit checks for
4302 process activity, timeout is the only way we will know. */
4304 set_waiting_for_input (&timeout
);
4306 /* If status of something has changed, and no input is
4307 available, notify the user of the change right away. After
4308 this explicit check, we'll let the SIGCHLD handler zap
4309 timeout to get our attention. */
4310 if (update_tick
!= process_tick
&& do_display
)
4313 #ifdef NON_BLOCKING_CONNECT
4317 Atemp
= input_wait_mask
;
4319 /* On Mac OS X 10.0, the SELECT system call always says input is
4320 present (for reading) at stdin, even when none is. This
4321 causes the call to SELECT below to return 1 and
4322 status_notify not to be called. As a result output of
4323 subprocesses are incorrectly discarded.
4327 IF_NON_BLOCKING_CONNECT (Ctemp
= connect_wait_mask
);
4329 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4330 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
4332 #ifdef NON_BLOCKING_CONNECT
4333 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4337 (SELECT_TYPE
*)0, &timeout
)
4340 /* It's okay for us to do this and then continue with
4341 the loop, since timeout has already been zeroed out. */
4342 clear_waiting_for_input ();
4343 status_notify (NULL
);
4347 /* Don't wait for output from a non-running process. Just
4348 read whatever data has already been received. */
4349 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
4350 update_status (wait_proc
);
4352 && ! EQ (wait_proc
->status
, Qrun
)
4353 && ! EQ (wait_proc
->status
, Qconnect
))
4355 int nread
, total_nread
= 0;
4357 clear_waiting_for_input ();
4358 XSETPROCESS (proc
, wait_proc
);
4360 /* Read data from the process, until we exhaust it. */
4361 while (XINT (wait_proc
->infd
) >= 0)
4363 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
4369 total_nread
+= nread
;
4371 else if (nread
== -1 && EIO
== errno
)
4375 else if (nread
== -1 && EAGAIN
== errno
)
4379 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4383 if (total_nread
> 0 && do_display
)
4384 redisplay_preserve_echo_area (10);
4389 /* Wait till there is something to do */
4391 if (wait_proc
&& just_wait_proc
)
4393 if (XINT (wait_proc
->infd
) < 0) /* Terminated */
4395 FD_SET (XINT (wait_proc
->infd
), &Available
);
4397 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4399 else if (!NILP (wait_for_cell
))
4401 Available
= non_process_wait_mask
;
4403 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4408 Available
= non_keyboard_wait_mask
;
4410 Available
= input_wait_mask
;
4411 IF_NON_BLOCKING_CONNECT (check_connect
= (num_pending_connects
> 0));
4412 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4415 /* If frame size has changed or the window is newly mapped,
4416 redisplay now, before we start to wait. There is a race
4417 condition here; if a SIGIO arrives between now and the select
4418 and indicates that a frame is trashed, the select may block
4419 displaying a trashed screen. */
4420 if (frame_garbaged
&& do_display
)
4422 clear_waiting_for_input ();
4423 redisplay_preserve_echo_area (11);
4425 set_waiting_for_input (&timeout
);
4429 if (read_kbd
&& detect_input_pending ())
4436 #ifdef NON_BLOCKING_CONNECT
4438 Connecting
= connect_wait_mask
;
4441 #ifdef ADAPTIVE_READ_BUFFERING
4442 /* Set the timeout for adaptive read buffering if any
4443 process has non-nil read_output_skip and non-zero
4444 read_output_delay, and we are not reading output for a
4445 specific wait_channel. It is not executed if
4446 Vprocess_adaptive_read_buffering is nil. */
4447 if (process_output_skip
&& check_delay
> 0)
4449 int usecs
= EMACS_USECS (timeout
);
4450 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4451 usecs
= READ_OUTPUT_DELAY_MAX
;
4452 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4454 proc
= chan_process
[channel
];
4457 /* Find minimum non-zero read_output_delay among the
4458 processes with non-nil read_output_skip. */
4459 if (XINT (XPROCESS (proc
)->read_output_delay
) > 0)
4462 if (NILP (XPROCESS (proc
)->read_output_skip
))
4464 FD_CLR (channel
, &Available
);
4465 XPROCESS (proc
)->read_output_skip
= Qnil
;
4466 if (XINT (XPROCESS (proc
)->read_output_delay
) < usecs
)
4467 usecs
= XINT (XPROCESS (proc
)->read_output_delay
);
4470 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4471 process_output_skip
= 0;
4475 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4477 #ifdef NON_BLOCKING_CONNECT
4478 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4482 (SELECT_TYPE
*)0, &timeout
);
4487 /* Make C-g and alarm signals set flags again */
4488 clear_waiting_for_input ();
4490 /* If we woke up due to SIGWINCH, actually change size now. */
4491 do_pending_window_change (0);
4493 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4494 /* We wanted the full specified time, so return now. */
4498 if (xerrno
== EINTR
)
4501 /* Ultrix select seems to return ENOMEM when it is
4502 interrupted. Treat it just like EINTR. Bleah. Note
4503 that we want to test for the "ultrix" CPP symbol, not
4504 "__ultrix__"; the latter is only defined under GCC, but
4505 not by DEC's bundled CC. -JimB */
4506 else if (xerrno
== ENOMEM
)
4510 /* This happens for no known reason on ALLIANT.
4511 I am guessing that this is the right response. -- RMS. */
4512 else if (xerrno
== EFAULT
)
4515 else if (xerrno
== EBADF
)
4518 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4519 the child's closure of the pts gives the parent a SIGHUP, and
4520 the ptc file descriptor is automatically closed,
4521 yielding EBADF here or at select() call above.
4522 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4523 in m/ibmrt-aix.h), and here we just ignore the select error.
4524 Cleanup occurs c/o status_notify after SIGCLD. */
4525 no_avail
= 1; /* Cannot depend on values returned */
4531 error ("select error: %s", emacs_strerror (xerrno
));
4536 FD_ZERO (&Available
);
4537 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4540 #if defined(sun) && !defined(USG5_4)
4541 if (nfds
> 0 && keyboard_bit_set (&Available
)
4543 /* System sometimes fails to deliver SIGIO.
4545 David J. Mackenzie says that Emacs doesn't compile under
4546 Solaris if this code is enabled, thus the USG5_4 in the CPP
4547 conditional. "I haven't noticed any ill effects so far.
4548 If you find a Solaris expert somewhere, they might know
4550 kill (getpid (), SIGIO
);
4553 #if 0 /* When polling is used, interrupt_input is 0,
4554 so get_input_pending should read the input.
4555 So this should not be needed. */
4556 /* If we are using polling for input,
4557 and we see input available, make it get read now.
4558 Otherwise it might not actually get read for a second.
4559 And on hpux, since we turn off polling in wait_reading_process_output,
4560 it might never get read at all if we don't spend much time
4561 outside of wait_reading_process_output. */
4562 if (read_kbd
&& interrupt_input
4563 && keyboard_bit_set (&Available
)
4564 && input_polling_used ())
4565 kill (getpid (), SIGALRM
);
4568 /* Check for keyboard input */
4569 /* If there is any, return immediately
4570 to give it higher priority than subprocesses */
4574 int old_timers_run
= timers_run
;
4575 struct buffer
*old_buffer
= current_buffer
;
4578 if (detect_input_pending_run_timers (do_display
))
4580 swallow_events (do_display
);
4581 if (detect_input_pending_run_timers (do_display
))
4585 /* If a timer has run, this might have changed buffers
4586 an alike. Make read_key_sequence aware of that. */
4587 if (timers_run
!= old_timers_run
4588 && waiting_for_user_input_p
== -1
4589 && old_buffer
!= current_buffer
)
4590 record_asynch_buffer_change ();
4596 /* If there is unread keyboard input, also return. */
4598 && requeued_events_pending_p ())
4601 /* If we are not checking for keyboard input now,
4602 do process events (but don't run any timers).
4603 This is so that X events will be processed.
4604 Otherwise they may have to wait until polling takes place.
4605 That would causes delays in pasting selections, for example.
4607 (We used to do this only if wait_for_cell.) */
4608 if (read_kbd
== 0 && detect_input_pending ())
4610 swallow_events (do_display
);
4611 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4612 if (detect_input_pending ())
4617 /* Exit now if the cell we're waiting for became non-nil. */
4618 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4622 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4623 go read it. This can happen with X on BSD after logging out.
4624 In that case, there really is no input and no SIGIO,
4625 but select says there is input. */
4627 if (read_kbd
&& interrupt_input
4628 && keyboard_bit_set (&Available
) && ! noninteractive
)
4629 kill (getpid (), SIGIO
);
4633 got_some_input
|= nfds
> 0;
4635 /* If checking input just got us a size-change event from X,
4636 obey it now if we should. */
4637 if (read_kbd
|| ! NILP (wait_for_cell
))
4638 do_pending_window_change (0);
4640 /* Check for data from a process. */
4641 if (no_avail
|| nfds
== 0)
4644 /* Really FIRST_PROC_DESC should be 0 on Unix,
4645 but this is safer in the short run. */
4646 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4648 if (FD_ISSET (channel
, &Available
)
4649 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4653 /* If waiting for this channel, arrange to return as
4654 soon as no more input to be processed. No more
4656 if (wait_channel
== channel
)
4662 proc
= chan_process
[channel
];
4666 /* If this is a server stream socket, accept connection. */
4667 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4669 server_accept_connection (proc
, channel
);
4673 /* Read data from the process, starting with our
4674 buffered-ahead character if we have one. */
4676 nread
= read_process_output (proc
, channel
);
4679 /* Since read_process_output can run a filter,
4680 which can call accept-process-output,
4681 don't try to read from any other processes
4682 before doing the select again. */
4683 FD_ZERO (&Available
);
4686 redisplay_preserve_echo_area (12);
4689 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4692 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4693 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4695 else if (nread
== -1 && errno
== EAGAIN
)
4699 else if (nread
== -1 && errno
== EAGAIN
)
4701 /* Note that we cannot distinguish between no input
4702 available now and a closed pipe.
4703 With luck, a closed pipe will be accompanied by
4704 subprocess termination and SIGCHLD. */
4705 else if (nread
== 0 && !NETCONN_P (proc
))
4707 #endif /* O_NDELAY */
4708 #endif /* O_NONBLOCK */
4710 /* On some OSs with ptys, when the process on one end of
4711 a pty exits, the other end gets an error reading with
4712 errno = EIO instead of getting an EOF (0 bytes read).
4713 Therefore, if we get an error reading and errno =
4714 EIO, just continue, because the child process has
4715 exited and should clean itself up soon (e.g. when we
4718 However, it has been known to happen that the SIGCHLD
4719 got lost. So raise the signl again just in case.
4721 else if (nread
== -1 && errno
== EIO
)
4722 kill (getpid (), SIGCHLD
);
4723 #endif /* HAVE_PTYS */
4724 /* If we can detect process termination, don't consider the process
4725 gone just because its pipe is closed. */
4727 else if (nread
== 0 && !NETCONN_P (proc
))
4732 /* Preserve status of processes already terminated. */
4733 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4734 deactivate_process (proc
);
4735 if (!NILP (XPROCESS (proc
)->raw_status_low
))
4736 update_status (XPROCESS (proc
));
4737 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4738 XPROCESS (proc
)->status
4739 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4742 #ifdef NON_BLOCKING_CONNECT
4743 if (check_connect
&& FD_ISSET (channel
, &Connecting
)
4744 && FD_ISSET (channel
, &connect_wait_mask
))
4746 struct Lisp_Process
*p
;
4748 FD_CLR (channel
, &connect_wait_mask
);
4749 if (--num_pending_connects
< 0)
4752 proc
= chan_process
[channel
];
4756 p
= XPROCESS (proc
);
4759 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4760 So only use it on systems where it is known to work. */
4762 int xlen
= sizeof(xerrno
);
4763 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4768 struct sockaddr pname
;
4769 int pnamelen
= sizeof(pname
);
4771 /* If connection failed, getpeername will fail. */
4773 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4775 /* Obtain connect failure code through error slippage. */
4778 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4785 XSETINT (p
->tick
, ++process_tick
);
4786 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4787 deactivate_process (proc
);
4792 /* Execute the sentinel here. If we had relied on
4793 status_notify to do it later, it will read input
4794 from the process before calling the sentinel. */
4795 exec_sentinel (proc
, build_string ("open\n"));
4796 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4798 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4799 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4803 #endif /* NON_BLOCKING_CONNECT */
4804 } /* end for each file descriptor */
4805 } /* end while exit conditions not met */
4807 waiting_for_user_input_p
= saved_waiting_for_user_input_p
;
4809 /* If calling from keyboard input, do not quit
4810 since we want to return C-g as an input character.
4811 Otherwise, do pending quit if requested. */
4814 /* Prevent input_pending from remaining set if we quit. */
4815 clear_input_pending ();
4818 #ifdef POLL_INTERRUPTED_SYS_CALL
4819 /* AlainF 5-Jul-1996
4820 HP-UX 10.10 seems to have problems with signals coming in
4821 Causes "poll: interrupted system call" messages when Emacs is run
4823 Turn periodic alarms back on */
4825 #endif /* POLL_INTERRUPTED_SYS_CALL */
4827 return got_some_input
;
4830 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4833 read_process_output_call (fun_and_args
)
4834 Lisp_Object fun_and_args
;
4836 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4840 read_process_output_error_handler (error
)
4843 cmd_error_internal (error
, "error in process filter: ");
4845 update_echo_area ();
4846 Fsleep_for (make_number (2), Qnil
);
4850 /* Read pending output from the process channel,
4851 starting with our buffered-ahead character if we have one.
4852 Yield number of decoded characters read.
4854 This function reads at most 4096 characters.
4855 If you want to read all available subprocess output,
4856 you must call it repeatedly until it returns zero.
4858 The characters read are decoded according to PROC's coding-system
4862 read_process_output (proc
, channel
)
4864 register int channel
;
4866 register int nbytes
;
4868 register Lisp_Object outstream
;
4869 register struct buffer
*old
= current_buffer
;
4870 register struct Lisp_Process
*p
= XPROCESS (proc
);
4871 register int opoint
;
4872 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4873 int carryover
= XINT (p
->decoding_carryover
);
4877 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4879 vs
= get_vms_process_pointer (p
->pid
);
4883 return (0); /* Really weird if it does this */
4884 if (!(vs
->iosb
[0] & 1))
4885 return -1; /* I/O error */
4888 error ("Could not get VMS process pointer");
4889 chars
= vs
->inputBuffer
;
4890 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4893 start_vms_process_read (vs
); /* Crank up the next read on the process */
4894 return 1; /* Nothing worth printing, say we got 1 */
4898 /* The data carried over in the previous decoding (which are at
4899 the tail of decoding buffer) should be prepended to the new
4900 data read to decode all together. */
4901 chars
= (char *) alloca (nbytes
+ carryover
);
4902 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4903 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4907 chars
= (char *) alloca (carryover
+ readmax
);
4909 /* See the comment above. */
4910 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
4912 #ifdef DATAGRAM_SOCKETS
4913 /* We have a working select, so proc_buffered_char is always -1. */
4914 if (DATAGRAM_CHAN_P (channel
))
4916 int len
= datagram_address
[channel
].len
;
4917 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
4918 0, datagram_address
[channel
].sa
, &len
);
4922 if (proc_buffered_char
[channel
] < 0)
4924 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
4925 #ifdef ADAPTIVE_READ_BUFFERING
4926 if (nbytes
> 0 && !NILP (p
->adaptive_read_buffering
))
4928 int delay
= XINT (p
->read_output_delay
);
4931 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
4934 process_output_delay_count
++;
4935 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
4938 else if (delay
> 0 && (nbytes
== readmax
))
4940 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
4942 process_output_delay_count
--;
4944 XSETINT (p
->read_output_delay
, delay
);
4947 p
->read_output_skip
= Qt
;
4948 process_output_skip
= 1;
4955 chars
[carryover
] = proc_buffered_char
[channel
];
4956 proc_buffered_char
[channel
] = -1;
4957 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
4961 nbytes
= nbytes
+ 1;
4963 #endif /* not VMS */
4965 XSETINT (p
->decoding_carryover
, 0);
4967 /* At this point, NBYTES holds number of bytes just received
4968 (including the one in proc_buffered_char[channel]). */
4971 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
4973 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4976 /* Now set NBYTES how many bytes we must decode. */
4977 nbytes
+= carryover
;
4979 /* Read and dispose of the process output. */
4980 outstream
= p
->filter
;
4981 if (!NILP (outstream
))
4983 /* We inhibit quit here instead of just catching it so that
4984 hitting ^G when a filter happens to be running won't screw
4986 int count
= SPECPDL_INDEX ();
4987 Lisp_Object odeactivate
;
4988 Lisp_Object obuffer
, okeymap
;
4990 int outer_running_asynch_code
= running_asynch_code
;
4991 int waiting
= waiting_for_user_input_p
;
4993 /* No need to gcpro these, because all we do with them later
4994 is test them for EQness, and none of them should be a string. */
4995 odeactivate
= Vdeactivate_mark
;
4996 XSETBUFFER (obuffer
, current_buffer
);
4997 okeymap
= current_buffer
->keymap
;
4999 specbind (Qinhibit_quit
, Qt
);
5000 specbind (Qlast_nonmenu_event
, Qt
);
5002 /* In case we get recursively called,
5003 and we already saved the match data nonrecursively,
5004 save the same match data in safely recursive fashion. */
5005 if (outer_running_asynch_code
)
5008 /* Don't clobber the CURRENT match data, either! */
5009 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5010 restore_search_regs ();
5011 record_unwind_save_match_data ();
5012 Fset_match_data (tem
, Qt
);
5015 /* For speed, if a search happens within this code,
5016 save the match data in a special nonrecursive fashion. */
5017 running_asynch_code
= 1;
5019 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5021 Vlast_coding_system_used
= coding
->symbol
;
5022 /* A new coding system might be found. */
5023 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5025 p
->decode_coding_system
= coding
->symbol
;
5027 /* Don't call setup_coding_system for
5028 proc_decode_coding_system[channel] here. It is done in
5029 detect_coding called via decode_coding above. */
5031 /* If a coding system for encoding is not yet decided, we set
5032 it as the same as coding-system for decoding.
5034 But, before doing that we must check if
5035 proc_encode_coding_system[p->outfd] surely points to a
5036 valid memory because p->outfd will be changed once EOF is
5037 sent to the process. */
5038 if (NILP (p
->encode_coding_system
)
5039 && proc_encode_coding_system
[XINT (p
->outfd
)])
5041 p
->encode_coding_system
= coding
->symbol
;
5042 setup_coding_system (coding
->symbol
,
5043 proc_encode_coding_system
[XINT (p
->outfd
)]);
5047 carryover
= nbytes
- coding
->consumed
;
5048 if (SCHARS (p
->decoding_buf
) < carryover
)
5049 p
->decoding_buf
= make_uninit_string (carryover
);
5050 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5052 XSETINT (p
->decoding_carryover
, carryover
);
5053 /* Adjust the multibyteness of TEXT to that of the filter. */
5054 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
5055 text
= (STRING_MULTIBYTE (text
)
5056 ? Fstring_as_unibyte (text
)
5057 : Fstring_to_multibyte (text
));
5058 if (SBYTES (text
) > 0)
5059 internal_condition_case_1 (read_process_output_call
,
5061 Fcons (proc
, Fcons (text
, Qnil
))),
5062 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5063 read_process_output_error_handler
);
5065 /* If we saved the match data nonrecursively, restore it now. */
5066 restore_search_regs ();
5067 running_asynch_code
= outer_running_asynch_code
;
5069 /* Handling the process output should not deactivate the mark. */
5070 Vdeactivate_mark
= odeactivate
;
5072 /* Restore waiting_for_user_input_p as it was
5073 when we were called, in case the filter clobbered it. */
5074 waiting_for_user_input_p
= waiting
;
5076 #if 0 /* Call record_asynch_buffer_change unconditionally,
5077 because we might have changed minor modes or other things
5078 that affect key bindings. */
5079 if (! EQ (Fcurrent_buffer (), obuffer
)
5080 || ! EQ (current_buffer
->keymap
, okeymap
))
5082 /* But do it only if the caller is actually going to read events.
5083 Otherwise there's no need to make him wake up, and it could
5084 cause trouble (for example it would make Fsit_for return). */
5085 if (waiting_for_user_input_p
== -1)
5086 record_asynch_buffer_change ();
5089 start_vms_process_read (vs
);
5091 unbind_to (count
, Qnil
);
5095 /* If no filter, write into buffer if it isn't dead. */
5096 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5098 Lisp_Object old_read_only
;
5099 int old_begv
, old_zv
;
5100 int old_begv_byte
, old_zv_byte
;
5101 Lisp_Object odeactivate
;
5102 int before
, before_byte
;
5107 odeactivate
= Vdeactivate_mark
;
5109 Fset_buffer (p
->buffer
);
5111 opoint_byte
= PT_BYTE
;
5112 old_read_only
= current_buffer
->read_only
;
5115 old_begv_byte
= BEGV_BYTE
;
5116 old_zv_byte
= ZV_BYTE
;
5118 current_buffer
->read_only
= Qnil
;
5120 /* Insert new output into buffer
5121 at the current end-of-output marker,
5122 thus preserving logical ordering of input and output. */
5123 if (XMARKER (p
->mark
)->buffer
)
5124 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5125 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5128 SET_PT_BOTH (ZV
, ZV_BYTE
);
5130 before_byte
= PT_BYTE
;
5132 /* If the output marker is outside of the visible region, save
5133 the restriction and widen. */
5134 if (! (BEGV
<= PT
&& PT
<= ZV
))
5137 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5139 Vlast_coding_system_used
= coding
->symbol
;
5140 /* A new coding system might be found. See the comment in the
5141 similar code in the previous `if' block. */
5142 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5144 p
->decode_coding_system
= coding
->symbol
;
5145 if (NILP (p
->encode_coding_system
)
5146 && proc_encode_coding_system
[XINT (p
->outfd
)])
5148 p
->encode_coding_system
= coding
->symbol
;
5149 setup_coding_system (coding
->symbol
,
5150 proc_encode_coding_system
[XINT (p
->outfd
)]);
5153 carryover
= nbytes
- coding
->consumed
;
5154 if (SCHARS (p
->decoding_buf
) < carryover
)
5155 p
->decoding_buf
= make_uninit_string (carryover
);
5156 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5158 XSETINT (p
->decoding_carryover
, carryover
);
5159 /* Adjust the multibyteness of TEXT to that of the buffer. */
5160 if (NILP (current_buffer
->enable_multibyte_characters
)
5161 != ! STRING_MULTIBYTE (text
))
5162 text
= (STRING_MULTIBYTE (text
)
5163 ? Fstring_as_unibyte (text
)
5164 : Fstring_to_multibyte (text
));
5165 /* Insert before markers in case we are inserting where
5166 the buffer's mark is, and the user's next command is Meta-y. */
5167 insert_from_string_before_markers (text
, 0, 0,
5168 SCHARS (text
), SBYTES (text
), 0);
5170 /* Make sure the process marker's position is valid when the
5171 process buffer is changed in the signal_after_change above.
5172 W3 is known to do that. */
5173 if (BUFFERP (p
->buffer
)
5174 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5175 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5177 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5179 update_mode_lines
++;
5181 /* Make sure opoint and the old restrictions
5182 float ahead of any new text just as point would. */
5183 if (opoint
>= before
)
5185 opoint
+= PT
- before
;
5186 opoint_byte
+= PT_BYTE
- before_byte
;
5188 if (old_begv
> before
)
5190 old_begv
+= PT
- before
;
5191 old_begv_byte
+= PT_BYTE
- before_byte
;
5193 if (old_zv
>= before
)
5195 old_zv
+= PT
- before
;
5196 old_zv_byte
+= PT_BYTE
- before_byte
;
5199 /* If the restriction isn't what it should be, set it. */
5200 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5201 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5203 /* Handling the process output should not deactivate the mark. */
5204 Vdeactivate_mark
= odeactivate
;
5206 current_buffer
->read_only
= old_read_only
;
5207 SET_PT_BOTH (opoint
, opoint_byte
);
5208 set_buffer_internal (old
);
5211 start_vms_process_read (vs
);
5216 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5218 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5219 This is intended for use by asynchronous process output filters and sentinels. */)
5222 return (waiting_for_user_input_p
? Qt
: Qnil
);
5225 /* Sending data to subprocess */
5227 jmp_buf send_process_frame
;
5228 Lisp_Object process_sent_to
;
5231 send_process_trap ()
5233 SIGNAL_THREAD_CHECK (SIGPIPE
);
5238 sigunblock (sigmask (SIGPIPE
));
5239 longjmp (send_process_frame
, 1);
5242 /* Send some data to process PROC.
5243 BUF is the beginning of the data; LEN is the number of characters.
5244 OBJECT is the Lisp object that the data comes from. If OBJECT is
5245 nil or t, it means that the data comes from C string.
5247 If OBJECT is not nil, the data is encoded by PROC's coding-system
5248 for encoding before it is sent.
5250 This function can evaluate Lisp code and can garbage collect. */
5253 send_process (proc
, buf
, len
, object
)
5254 volatile Lisp_Object proc
;
5255 unsigned char *volatile buf
;
5257 volatile Lisp_Object object
;
5259 /* Use volatile to protect variables from being clobbered by longjmp. */
5260 struct Lisp_Process
*p
= XPROCESS (proc
);
5262 struct coding_system
*coding
;
5263 struct gcpro gcpro1
;
5264 SIGTYPE (*volatile old_sigpipe
) ();
5269 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5272 if (! NILP (p
->raw_status_low
))
5274 if (! EQ (p
->status
, Qrun
))
5275 error ("Process %s not running", SDATA (p
->name
));
5276 if (XINT (p
->outfd
) < 0)
5277 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5279 coding
= proc_encode_coding_system
[XINT (p
->outfd
)];
5280 Vlast_coding_system_used
= coding
->symbol
;
5282 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5283 || (BUFFERP (object
)
5284 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5287 if (!EQ (coding
->symbol
, p
->encode_coding_system
))
5288 /* The coding system for encoding was changed to raw-text
5289 because we sent a unibyte text previously. Now we are
5290 sending a multibyte text, thus we must encode it by the
5291 original coding system specified for the current process. */
5292 setup_coding_system (p
->encode_coding_system
, coding
);
5293 /* src_multibyte should be set to 1 _after_ a call to
5294 setup_coding_system, since it resets src_multibyte to
5296 coding
->src_multibyte
= 1;
5300 /* For sending a unibyte text, character code conversion should
5301 not take place but EOL conversion should. So, setup raw-text
5302 or one of the subsidiary if we have not yet done it. */
5303 if (coding
->type
!= coding_type_raw_text
)
5305 if (CODING_REQUIRE_FLUSHING (coding
))
5307 /* But, before changing the coding, we must flush out data. */
5308 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5309 send_process (proc
, "", 0, Qt
);
5311 coding
->src_multibyte
= 0;
5312 setup_raw_text_coding_system (coding
);
5315 coding
->dst_multibyte
= 0;
5317 if (CODING_REQUIRE_ENCODING (coding
))
5319 int require
= encoding_buffer_size (coding
, len
);
5320 int from_byte
= -1, from
= -1, to
= -1;
5322 if (BUFFERP (object
))
5324 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5325 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
5326 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
5328 else if (STRINGP (object
))
5330 from_byte
= buf
- SDATA (object
);
5331 from
= string_byte_to_char (object
, from_byte
);
5332 to
= string_byte_to_char (object
, from_byte
+ len
);
5335 if (coding
->composing
!= COMPOSITION_DISABLED
)
5338 coding_save_composition (coding
, from
, to
, object
);
5340 coding
->composing
= COMPOSITION_DISABLED
;
5343 if (SBYTES (p
->encoding_buf
) < require
)
5344 p
->encoding_buf
= make_uninit_string (require
);
5347 buf
= (BUFFERP (object
)
5348 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
5349 : SDATA (object
) + from_byte
);
5351 object
= p
->encoding_buf
;
5352 encode_coding (coding
, (char *) buf
, SDATA (object
),
5353 len
, SBYTES (object
));
5354 coding_free_composition_data (coding
);
5355 len
= coding
->produced
;
5356 buf
= SDATA (object
);
5360 vs
= get_vms_process_pointer (p
->pid
);
5362 error ("Could not find this process: %x", p
->pid
);
5363 else if (write_to_vms_process (vs
, buf
, len
))
5367 if (pty_max_bytes
== 0)
5369 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5370 pty_max_bytes
= fpathconf (XFASTINT (p
->outfd
), _PC_MAX_CANON
);
5371 if (pty_max_bytes
< 0)
5372 pty_max_bytes
= 250;
5374 pty_max_bytes
= 250;
5376 /* Deduct one, to leave space for the eof. */
5380 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5381 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5382 when returning with longjmp despite being declared volatile. */
5383 if (!setjmp (send_process_frame
))
5385 process_sent_to
= proc
;
5390 /* Decide how much data we can send in one batch.
5391 Long lines need to be split into multiple batches. */
5392 if (!NILP (p
->pty_flag
))
5394 /* Starting this at zero is always correct when not the first
5395 iteration because the previous iteration ended by sending C-d.
5396 It may not be correct for the first iteration
5397 if a partial line was sent in a separate send_process call.
5398 If that proves worth handling, we need to save linepos
5399 in the process object. */
5401 unsigned char *ptr
= (unsigned char *) buf
;
5402 unsigned char *end
= (unsigned char *) buf
+ len
;
5404 /* Scan through this text for a line that is too long. */
5405 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5413 /* If we found one, break the line there
5414 and put in a C-d to force the buffer through. */
5418 /* Send this batch, using one or more write calls. */
5421 int outfd
= XINT (p
->outfd
);
5422 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5423 #ifdef DATAGRAM_SOCKETS
5424 if (DATAGRAM_CHAN_P (outfd
))
5426 rv
= sendto (outfd
, (char *) buf
, this,
5427 0, datagram_address
[outfd
].sa
,
5428 datagram_address
[outfd
].len
);
5429 if (rv
< 0 && errno
== EMSGSIZE
)
5431 signal (SIGPIPE
, old_sigpipe
);
5432 report_file_error ("sending datagram",
5433 Fcons (proc
, Qnil
));
5439 rv
= emacs_write (outfd
, (char *) buf
, this);
5440 #ifdef ADAPTIVE_READ_BUFFERING
5441 if (XINT (p
->read_output_delay
) > 0
5442 && EQ (p
->adaptive_read_buffering
, Qt
))
5444 XSETFASTINT (p
->read_output_delay
, 0);
5445 process_output_delay_count
--;
5446 p
->read_output_skip
= Qnil
;
5450 signal (SIGPIPE
, old_sigpipe
);
5456 || errno
== EWOULDBLOCK
5462 /* Buffer is full. Wait, accepting input;
5463 that may allow the program
5464 to finish doing output and read more. */
5468 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5469 /* A gross hack to work around a bug in FreeBSD.
5470 In the following sequence, read(2) returns
5474 write(2) 954 bytes, get EAGAIN
5475 read(2) 1024 bytes in process_read_output
5476 read(2) 11 bytes in process_read_output
5478 That is, read(2) returns more bytes than have
5479 ever been written successfully. The 1033 bytes
5480 read are the 1022 bytes written successfully
5481 after processing (for example with CRs added if
5482 the terminal is set up that way which it is
5483 here). The same bytes will be seen again in a
5484 later read(2), without the CRs. */
5486 if (errno
== EAGAIN
)
5489 ioctl (XINT (p
->outfd
), TIOCFLUSH
, &flags
);
5491 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5493 /* Running filters might relocate buffers or strings.
5494 Arrange to relocate BUF. */
5495 if (BUFFERP (object
))
5496 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5497 else if (STRINGP (object
))
5498 offset
= buf
- SDATA (object
);
5500 #ifdef EMACS_HAS_USECS
5501 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5503 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5506 if (BUFFERP (object
))
5507 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5508 else if (STRINGP (object
))
5509 buf
= offset
+ SDATA (object
);
5514 /* This is a real error. */
5515 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5522 /* If we sent just part of the string, put in an EOF
5523 to force it through, before we send the rest. */
5525 Fprocess_send_eof (proc
);
5528 #endif /* not VMS */
5531 signal (SIGPIPE
, old_sigpipe
);
5533 proc
= process_sent_to
;
5534 p
= XPROCESS (proc
);
5536 p
->raw_status_low
= Qnil
;
5537 p
->raw_status_high
= Qnil
;
5538 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5539 XSETINT (p
->tick
, ++process_tick
);
5540 deactivate_process (proc
);
5542 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5544 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5551 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5553 doc
: /* Send current contents of region as input to PROCESS.
5554 PROCESS may be a process, a buffer, the name of a process or buffer, or
5555 nil, indicating the current buffer's process.
5556 Called from program, takes three arguments, PROCESS, START and END.
5557 If the region is more than 500 characters long,
5558 it is sent in several bunches. This may happen even for shorter regions.
5559 Output from processes can arrive in between bunches. */)
5560 (process
, start
, end
)
5561 Lisp_Object process
, start
, end
;
5566 proc
= get_process (process
);
5567 validate_region (&start
, &end
);
5569 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5570 move_gap (XINT (start
));
5572 start1
= CHAR_TO_BYTE (XINT (start
));
5573 end1
= CHAR_TO_BYTE (XINT (end
));
5574 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5575 Fcurrent_buffer ());
5580 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5582 doc
: /* Send PROCESS the contents of STRING as input.
5583 PROCESS may be a process, a buffer, the name of a process or buffer, or
5584 nil, indicating the current buffer's process.
5585 If STRING is more than 500 characters long,
5586 it is sent in several bunches. This may happen even for shorter strings.
5587 Output from processes can arrive in between bunches. */)
5589 Lisp_Object process
, string
;
5592 CHECK_STRING (string
);
5593 proc
= get_process (process
);
5594 send_process (proc
, SDATA (string
),
5595 SBYTES (string
), string
);
5599 /* Return the foreground process group for the tty/pty that
5600 the process P uses. */
5602 emacs_get_tty_pgrp (p
)
5603 struct Lisp_Process
*p
;
5608 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5611 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5612 master side. Try the slave side. */
5613 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5617 ioctl (fd
, TIOCGPGRP
, &gid
);
5621 #endif /* defined (TIOCGPGRP ) */
5626 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5627 Sprocess_running_child_p
, 0, 1, 0,
5628 doc
: /* Return t if PROCESS has given the terminal to a child.
5629 If the operating system does not make it possible to find out,
5630 return t unconditionally. */)
5632 Lisp_Object process
;
5634 /* Initialize in case ioctl doesn't exist or gives an error,
5635 in a way that will cause returning t. */
5638 struct Lisp_Process
*p
;
5640 proc
= get_process (process
);
5641 p
= XPROCESS (proc
);
5643 if (!EQ (p
->childp
, Qt
))
5644 error ("Process %s is not a subprocess",
5646 if (XINT (p
->infd
) < 0)
5647 error ("Process %s is not active",
5650 gid
= emacs_get_tty_pgrp (p
);
5652 if (gid
== XFASTINT (p
->pid
))
5657 /* send a signal number SIGNO to PROCESS.
5658 If CURRENT_GROUP is t, that means send to the process group
5659 that currently owns the terminal being used to communicate with PROCESS.
5660 This is used for various commands in shell mode.
5661 If CURRENT_GROUP is lambda, that means send to the process group
5662 that currently owns the terminal, but only if it is NOT the shell itself.
5664 If NOMSG is zero, insert signal-announcements into process's buffers
5667 If we can, we try to signal PROCESS by sending control characters
5668 down the pty. This allows us to signal inferiors who have changed
5669 their uid, for which killpg would return an EPERM error. */
5672 process_send_signal (process
, signo
, current_group
, nomsg
)
5673 Lisp_Object process
;
5675 Lisp_Object current_group
;
5679 register struct Lisp_Process
*p
;
5683 proc
= get_process (process
);
5684 p
= XPROCESS (proc
);
5686 if (!EQ (p
->childp
, Qt
))
5687 error ("Process %s is not a subprocess",
5689 if (XINT (p
->infd
) < 0)
5690 error ("Process %s is not active",
5693 if (NILP (p
->pty_flag
))
5694 current_group
= Qnil
;
5696 /* If we are using pgrps, get a pgrp number and make it negative. */
5697 if (NILP (current_group
))
5698 /* Send the signal to the shell's process group. */
5699 gid
= XFASTINT (p
->pid
);
5702 #ifdef SIGNALS_VIA_CHARACTERS
5703 /* If possible, send signals to the entire pgrp
5704 by sending an input character to it. */
5706 /* TERMIOS is the latest and bestest, and seems most likely to
5707 work. If the system has it, use it. */
5710 cc_t
*sig_char
= NULL
;
5712 tcgetattr (XINT (p
->infd
), &t
);
5717 sig_char
= &t
.c_cc
[VINTR
];
5721 sig_char
= &t
.c_cc
[VQUIT
];
5725 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5726 sig_char
= &t
.c_cc
[VSWTCH
];
5728 sig_char
= &t
.c_cc
[VSUSP
];
5733 if (sig_char
&& *sig_char
!= CDISABLE
)
5735 send_process (proc
, sig_char
, 1, Qnil
);
5738 /* If we can't send the signal with a character,
5739 fall through and send it another way. */
5740 #else /* ! HAVE_TERMIOS */
5742 /* On Berkeley descendants, the following IOCTL's retrieve the
5743 current control characters. */
5744 #if defined (TIOCGLTC) && defined (TIOCGETC)
5752 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5753 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5756 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5757 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5761 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5762 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5764 #endif /* ! defined (SIGTSTP) */
5767 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5769 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5776 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5777 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5780 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5781 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5785 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5786 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5788 #endif /* ! defined (SIGTSTP) */
5790 #else /* ! defined (TCGETA) */
5791 Your configuration files are messed up
.
5792 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5793 you'd better be using one of the alternatives above! */
5794 #endif /* ! defined (TCGETA) */
5795 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5796 /* In this case, the code above should alway returns. */
5798 #endif /* ! defined HAVE_TERMIOS */
5800 /* The code above may fall through if it can't
5801 handle the signal. */
5802 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5805 /* Get the current pgrp using the tty itself, if we have that.
5806 Otherwise, use the pty to get the pgrp.
5807 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5808 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5809 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5810 His patch indicates that if TIOCGPGRP returns an error, then
5811 we should just assume that p->pid is also the process group id. */
5813 gid
= emacs_get_tty_pgrp (p
);
5816 /* If we can't get the information, assume
5817 the shell owns the tty. */
5818 gid
= XFASTINT (p
->pid
);
5820 /* It is not clear whether anything really can set GID to -1.
5821 Perhaps on some system one of those ioctls can or could do so.
5822 Or perhaps this is vestigial. */
5825 #else /* ! defined (TIOCGPGRP ) */
5826 /* Can't select pgrps on this system, so we know that
5827 the child itself heads the pgrp. */
5828 gid
= XFASTINT (p
->pid
);
5829 #endif /* ! defined (TIOCGPGRP ) */
5831 /* If current_group is lambda, and the shell owns the terminal,
5832 don't send any signal. */
5833 if (EQ (current_group
, Qlambda
) && gid
== XFASTINT (p
->pid
))
5841 p
->raw_status_low
= Qnil
;
5842 p
->raw_status_high
= Qnil
;
5844 XSETINT (p
->tick
, ++process_tick
);
5846 status_notify (NULL
);
5848 #endif /* ! defined (SIGCONT) */
5851 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5856 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5861 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
5864 flush_pending_output (XINT (p
->infd
));
5868 /* If we don't have process groups, send the signal to the immediate
5869 subprocess. That isn't really right, but it's better than any
5870 obvious alternative. */
5873 kill (XFASTINT (p
->pid
), signo
);
5877 /* gid may be a pid, or minus a pgrp's number */
5879 if (!NILP (current_group
))
5881 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
5882 EMACS_KILLPG (gid
, signo
);
5886 gid
= - XFASTINT (p
->pid
);
5889 #else /* ! defined (TIOCSIGSEND) */
5890 EMACS_KILLPG (gid
, signo
);
5891 #endif /* ! defined (TIOCSIGSEND) */
5894 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5895 doc
: /* Interrupt process PROCESS.
5896 PROCESS may be a process, a buffer, or the name of a process or buffer.
5897 No arg or nil means current buffer's process.
5898 Second arg CURRENT-GROUP non-nil means send signal to
5899 the current process-group of the process's controlling terminal
5900 rather than to the process's own process group.
5901 If the process is a shell, this means interrupt current subjob
5902 rather than the shell.
5904 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5905 don't send the signal. */)
5906 (process
, current_group
)
5907 Lisp_Object process
, current_group
;
5909 process_send_signal (process
, SIGINT
, current_group
, 0);
5913 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5914 doc
: /* Kill process PROCESS. May be process or name of one.
5915 See function `interrupt-process' for more details on usage. */)
5916 (process
, current_group
)
5917 Lisp_Object process
, current_group
;
5919 process_send_signal (process
, SIGKILL
, current_group
, 0);
5923 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5924 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5925 See function `interrupt-process' for more details on usage. */)
5926 (process
, current_group
)
5927 Lisp_Object process
, current_group
;
5929 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5933 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5934 doc
: /* Stop process PROCESS. May be process or name of one.
5935 See function `interrupt-process' for more details on usage.
5936 If PROCESS is a network process, inhibit handling of incoming traffic. */)
5937 (process
, current_group
)
5938 Lisp_Object process
, current_group
;
5941 if (PROCESSP (process
) && NETCONN_P (process
))
5943 struct Lisp_Process
*p
;
5945 p
= XPROCESS (process
);
5946 if (NILP (p
->command
)
5947 && XINT (p
->infd
) >= 0)
5949 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5950 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5957 error ("No SIGTSTP support");
5959 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5964 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5965 doc
: /* Continue process PROCESS. May be process or name of one.
5966 See function `interrupt-process' for more details on usage.
5967 If PROCESS is a network process, resume handling of incoming traffic. */)
5968 (process
, current_group
)
5969 Lisp_Object process
, current_group
;
5972 if (PROCESSP (process
) && NETCONN_P (process
))
5974 struct Lisp_Process
*p
;
5976 p
= XPROCESS (process
);
5977 if (EQ (p
->command
, Qt
)
5978 && XINT (p
->infd
) >= 0
5979 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
5981 FD_SET (XINT (p
->infd
), &input_wait_mask
);
5982 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
5989 process_send_signal (process
, SIGCONT
, current_group
, 0);
5991 error ("No SIGCONT support");
5996 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
5997 2, 2, "sProcess (name or number): \nnSignal code: ",
5998 doc
: /* Send PROCESS the signal with code SIGCODE.
5999 PROCESS may also be an integer specifying the process id of the
6000 process to signal; in this case, the process need not be a child of
6002 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6004 Lisp_Object process
, sigcode
;
6008 if (INTEGERP (process
))
6014 if (STRINGP (process
))
6017 if (tem
= Fget_process (process
), NILP (tem
))
6019 pid
= Fstring_to_number (process
, make_number (10));
6020 if (XINT (pid
) != 0)
6026 process
= get_process (process
);
6031 CHECK_PROCESS (process
);
6032 pid
= XPROCESS (process
)->pid
;
6033 if (!INTEGERP (pid
) || XINT (pid
) <= 0)
6034 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6038 #define handle_signal(NAME, VALUE) \
6039 else if (!strcmp (name, NAME)) \
6040 XSETINT (sigcode, VALUE)
6042 if (INTEGERP (sigcode
))
6046 unsigned char *name
;
6048 CHECK_SYMBOL (sigcode
);
6049 name
= SDATA (SYMBOL_NAME (sigcode
));
6051 if (!strncmp(name
, "SIG", 3))
6057 handle_signal ("HUP", SIGHUP
);
6060 handle_signal ("INT", SIGINT
);
6063 handle_signal ("QUIT", SIGQUIT
);
6066 handle_signal ("ILL", SIGILL
);
6069 handle_signal ("ABRT", SIGABRT
);
6072 handle_signal ("EMT", SIGEMT
);
6075 handle_signal ("KILL", SIGKILL
);
6078 handle_signal ("FPE", SIGFPE
);
6081 handle_signal ("BUS", SIGBUS
);
6084 handle_signal ("SEGV", SIGSEGV
);
6087 handle_signal ("SYS", SIGSYS
);
6090 handle_signal ("PIPE", SIGPIPE
);
6093 handle_signal ("ALRM", SIGALRM
);
6096 handle_signal ("TERM", SIGTERM
);
6099 handle_signal ("URG", SIGURG
);
6102 handle_signal ("STOP", SIGSTOP
);
6105 handle_signal ("TSTP", SIGTSTP
);
6108 handle_signal ("CONT", SIGCONT
);
6111 handle_signal ("CHLD", SIGCHLD
);
6114 handle_signal ("TTIN", SIGTTIN
);
6117 handle_signal ("TTOU", SIGTTOU
);
6120 handle_signal ("IO", SIGIO
);
6123 handle_signal ("XCPU", SIGXCPU
);
6126 handle_signal ("XFSZ", SIGXFSZ
);
6129 handle_signal ("VTALRM", SIGVTALRM
);
6132 handle_signal ("PROF", SIGPROF
);
6135 handle_signal ("WINCH", SIGWINCH
);
6138 handle_signal ("INFO", SIGINFO
);
6141 handle_signal ("USR1", SIGUSR1
);
6144 handle_signal ("USR2", SIGUSR2
);
6147 error ("Undefined signal name %s", name
);
6150 #undef handle_signal
6152 return make_number (kill (XINT (pid
), XINT (sigcode
)));
6155 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6156 doc
: /* Make PROCESS see end-of-file in its input.
6157 EOF comes after any text already sent to it.
6158 PROCESS may be a process, a buffer, the name of a process or buffer, or
6159 nil, indicating the current buffer's process.
6160 If PROCESS is a network connection, or is a process communicating
6161 through a pipe (as opposed to a pty), then you cannot send any more
6162 text to PROCESS after you call this function. */)
6164 Lisp_Object process
;
6167 struct coding_system
*coding
;
6169 if (DATAGRAM_CONN_P (process
))
6172 proc
= get_process (process
);
6173 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
6175 /* Make sure the process is really alive. */
6176 if (! NILP (XPROCESS (proc
)->raw_status_low
))
6177 update_status (XPROCESS (proc
));
6178 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6179 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6181 if (CODING_REQUIRE_FLUSHING (coding
))
6183 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6184 send_process (proc
, "", 0, Qnil
);
6188 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6190 if (!NILP (XPROCESS (proc
)->pty_flag
))
6191 send_process (proc
, "\004", 1, Qnil
);
6194 int old_outfd
, new_outfd
;
6196 #ifdef HAVE_SHUTDOWN
6197 /* If this is a network connection, or socketpair is used
6198 for communication with the subprocess, call shutdown to cause EOF.
6199 (In some old system, shutdown to socketpair doesn't work.
6200 Then we just can't win.) */
6201 if (NILP (XPROCESS (proc
)->pid
)
6202 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
6203 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
6204 /* In case of socketpair, outfd == infd, so don't close it. */
6205 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
6206 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6207 #else /* not HAVE_SHUTDOWN */
6208 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6209 #endif /* not HAVE_SHUTDOWN */
6210 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6211 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
6213 if (!proc_encode_coding_system
[new_outfd
])
6214 proc_encode_coding_system
[new_outfd
]
6215 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6216 bcopy (proc_encode_coding_system
[old_outfd
],
6217 proc_encode_coding_system
[new_outfd
],
6218 sizeof (struct coding_system
));
6219 bzero (proc_encode_coding_system
[old_outfd
],
6220 sizeof (struct coding_system
));
6222 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
6228 /* Kill all processes associated with `buffer'.
6229 If `buffer' is nil, kill all processes */
6232 kill_buffer_processes (buffer
)
6235 Lisp_Object tail
, proc
;
6237 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6239 proc
= XCDR (XCAR (tail
));
6240 if (GC_PROCESSP (proc
)
6241 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6243 if (NETCONN_P (proc
))
6244 Fdelete_process (proc
);
6245 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
6246 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6251 /* On receipt of a signal that a child status has changed, loop asking
6252 about children with changed statuses until the system says there
6255 All we do is change the status; we do not run sentinels or print
6256 notifications. That is saved for the next time keyboard input is
6257 done, in order to avoid timing errors.
6259 ** WARNING: this can be called during garbage collection.
6260 Therefore, it must not be fooled by the presence of mark bits in
6263 ** USG WARNING: Although it is not obvious from the documentation
6264 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6265 signal() before executing at least one wait(), otherwise the
6266 handler will be called again, resulting in an infinite loop. The
6267 relevant portion of the documentation reads "SIGCLD signals will be
6268 queued and the signal-catching function will be continually
6269 reentered until the queue is empty". Invoking signal() causes the
6270 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6273 ** Malloc WARNING: This should never call malloc either directly or
6274 indirectly; if it does, that is a bug */
6277 sigchld_handler (signo
)
6280 int old_errno
= errno
;
6282 register struct Lisp_Process
*p
;
6283 extern EMACS_TIME
*input_available_clear_time
;
6285 SIGNAL_THREAD_CHECK (signo
);
6289 sigheld
|= sigbit (SIGCHLD
);
6301 #endif /* no WUNTRACED */
6302 /* Keep trying to get a status until we get a definitive result. */
6306 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6308 while (pid
< 0 && errno
== EINTR
);
6312 /* PID == 0 means no processes found, PID == -1 means a real
6313 failure. We have done all our job, so return. */
6315 /* USG systems forget handlers when they are used;
6316 must reestablish each time */
6317 #if defined (USG) && !defined (POSIX_SIGNALS)
6318 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6321 sigheld
&= ~sigbit (SIGCHLD
);
6329 #endif /* no WNOHANG */
6331 /* Find the process that signaled us, and record its status. */
6334 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6336 proc
= XCDR (XCAR (tail
));
6337 p
= XPROCESS (proc
);
6338 if (GC_EQ (p
->childp
, Qt
) && XINT (p
->pid
) == pid
)
6343 /* Look for an asynchronous process whose pid hasn't been filled
6346 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6348 proc
= XCDR (XCAR (tail
));
6349 p
= XPROCESS (proc
);
6350 if (GC_INTEGERP (p
->pid
) && XINT (p
->pid
) == -1)
6355 /* Change the status of the process that was found. */
6358 union { int i
; WAITTYPE wt
; } u
;
6359 int clear_desc_flag
= 0;
6361 XSETINT (p
->tick
, ++process_tick
);
6363 XSETINT (p
->raw_status_low
, u
.i
& 0xffff);
6364 XSETINT (p
->raw_status_high
, u
.i
>> 16);
6366 /* If process has terminated, stop waiting for its output. */
6367 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6368 && XINT (p
->infd
) >= 0)
6369 clear_desc_flag
= 1;
6371 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6372 if (clear_desc_flag
)
6374 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6375 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6378 /* Tell wait_reading_process_output that it needs to wake up and
6380 if (input_available_clear_time
)
6381 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6384 /* There was no asynchronous process found for that id. Check
6385 if we have a synchronous process. */
6388 synch_process_alive
= 0;
6390 /* Report the status of the synchronous process. */
6392 synch_process_retcode
= WRETCODE (w
);
6393 else if (WIFSIGNALED (w
))
6394 synch_process_termsig
= WTERMSIG (w
);
6396 /* Tell wait_reading_process_output that it needs to wake up and
6398 if (input_available_clear_time
)
6399 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6402 /* On some systems, we must return right away.
6403 If any more processes want to signal us, we will
6405 Otherwise (on systems that have WNOHANG), loop around
6406 to use up all the processes that have something to tell us. */
6407 #if (defined WINDOWSNT \
6408 || (defined USG && !defined GNU_LINUX \
6409 && !(defined HPUX && defined WNOHANG)))
6410 #if defined (USG) && ! defined (POSIX_SIGNALS)
6411 signal (signo
, sigchld_handler
);
6415 #endif /* USG, but not HPUX with WNOHANG */
6421 exec_sentinel_unwind (data
)
6424 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6429 exec_sentinel_error_handler (error
)
6432 cmd_error_internal (error
, "error in process sentinel: ");
6434 update_echo_area ();
6435 Fsleep_for (make_number (2), Qnil
);
6440 exec_sentinel (proc
, reason
)
6441 Lisp_Object proc
, reason
;
6443 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6444 register struct Lisp_Process
*p
= XPROCESS (proc
);
6445 int count
= SPECPDL_INDEX ();
6446 int outer_running_asynch_code
= running_asynch_code
;
6447 int waiting
= waiting_for_user_input_p
;
6449 /* No need to gcpro these, because all we do with them later
6450 is test them for EQness, and none of them should be a string. */
6451 odeactivate
= Vdeactivate_mark
;
6452 XSETBUFFER (obuffer
, current_buffer
);
6453 okeymap
= current_buffer
->keymap
;
6455 sentinel
= p
->sentinel
;
6456 if (NILP (sentinel
))
6459 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6460 assure that it gets restored no matter how the sentinel exits. */
6462 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6463 /* Inhibit quit so that random quits don't screw up a running filter. */
6464 specbind (Qinhibit_quit
, Qt
);
6465 specbind (Qlast_nonmenu_event
, Qt
);
6467 /* In case we get recursively called,
6468 and we already saved the match data nonrecursively,
6469 save the same match data in safely recursive fashion. */
6470 if (outer_running_asynch_code
)
6473 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6474 restore_search_regs ();
6475 record_unwind_save_match_data ();
6476 Fset_match_data (tem
, Qt
);
6479 /* For speed, if a search happens within this code,
6480 save the match data in a special nonrecursive fashion. */
6481 running_asynch_code
= 1;
6483 internal_condition_case_1 (read_process_output_call
,
6485 Fcons (proc
, Fcons (reason
, Qnil
))),
6486 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6487 exec_sentinel_error_handler
);
6489 /* If we saved the match data nonrecursively, restore it now. */
6490 restore_search_regs ();
6491 running_asynch_code
= outer_running_asynch_code
;
6493 Vdeactivate_mark
= odeactivate
;
6495 /* Restore waiting_for_user_input_p as it was
6496 when we were called, in case the filter clobbered it. */
6497 waiting_for_user_input_p
= waiting
;
6500 if (! EQ (Fcurrent_buffer (), obuffer
)
6501 || ! EQ (current_buffer
->keymap
, okeymap
))
6503 /* But do it only if the caller is actually going to read events.
6504 Otherwise there's no need to make him wake up, and it could
6505 cause trouble (for example it would make Fsit_for return). */
6506 if (waiting_for_user_input_p
== -1)
6507 record_asynch_buffer_change ();
6509 unbind_to (count
, Qnil
);
6512 /* Report all recent events of a change in process status
6513 (either run the sentinel or output a message).
6514 This is usually done while Emacs is waiting for keyboard input
6515 but can be done at other times. */
6518 status_notify (deleting_process
)
6519 struct Lisp_Process
*deleting_process
;
6521 register Lisp_Object proc
, buffer
;
6522 Lisp_Object tail
, msg
;
6523 struct gcpro gcpro1
, gcpro2
;
6527 /* We need to gcpro tail; if read_process_output calls a filter
6528 which deletes a process and removes the cons to which tail points
6529 from Vprocess_alist, and then causes a GC, tail is an unprotected
6533 /* Set this now, so that if new processes are created by sentinels
6534 that we run, we get called again to handle their status changes. */
6535 update_tick
= process_tick
;
6537 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6540 register struct Lisp_Process
*p
;
6542 proc
= Fcdr (Fcar (tail
));
6543 p
= XPROCESS (proc
);
6545 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6547 XSETINT (p
->update_tick
, XINT (p
->tick
));
6549 /* If process is still active, read any output that remains. */
6550 while (! EQ (p
->filter
, Qt
)
6551 && ! EQ (p
->status
, Qconnect
)
6552 && ! EQ (p
->status
, Qlisten
)
6553 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6554 && XINT (p
->infd
) >= 0
6555 && p
!= deleting_process
6556 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6560 /* Get the text to use for the message. */
6561 if (!NILP (p
->raw_status_low
))
6563 msg
= status_message (p
);
6565 /* If process is terminated, deactivate it or delete it. */
6567 if (CONSP (p
->status
))
6568 symbol
= XCAR (p
->status
);
6570 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6571 || EQ (symbol
, Qclosed
))
6573 if (delete_exited_processes
)
6574 remove_process (proc
);
6576 deactivate_process (proc
);
6579 /* The actions above may have further incremented p->tick.
6580 So set p->update_tick again
6581 so that an error in the sentinel will not cause
6582 this code to be run again. */
6583 XSETINT (p
->update_tick
, XINT (p
->tick
));
6584 /* Now output the message suitably. */
6585 if (!NILP (p
->sentinel
))
6586 exec_sentinel (proc
, msg
);
6587 /* Don't bother with a message in the buffer
6588 when a process becomes runnable. */
6589 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6591 Lisp_Object ro
, tem
;
6592 struct buffer
*old
= current_buffer
;
6593 int opoint
, opoint_byte
;
6594 int before
, before_byte
;
6596 ro
= XBUFFER (buffer
)->read_only
;
6598 /* Avoid error if buffer is deleted
6599 (probably that's why the process is dead, too) */
6600 if (NILP (XBUFFER (buffer
)->name
))
6602 Fset_buffer (buffer
);
6605 opoint_byte
= PT_BYTE
;
6606 /* Insert new output into buffer
6607 at the current end-of-output marker,
6608 thus preserving logical ordering of input and output. */
6609 if (XMARKER (p
->mark
)->buffer
)
6610 Fgoto_char (p
->mark
);
6612 SET_PT_BOTH (ZV
, ZV_BYTE
);
6615 before_byte
= PT_BYTE
;
6617 tem
= current_buffer
->read_only
;
6618 current_buffer
->read_only
= Qnil
;
6619 insert_string ("\nProcess ");
6620 Finsert (1, &p
->name
);
6621 insert_string (" ");
6623 current_buffer
->read_only
= tem
;
6624 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6626 if (opoint
>= before
)
6627 SET_PT_BOTH (opoint
+ (PT
- before
),
6628 opoint_byte
+ (PT_BYTE
- before_byte
));
6630 SET_PT_BOTH (opoint
, opoint_byte
);
6632 set_buffer_internal (old
);
6637 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6638 redisplay_preserve_echo_area (13);
6644 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6645 Sset_process_coding_system
, 1, 3, 0,
6646 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6647 DECODING will be used to decode subprocess output and ENCODING to
6648 encode subprocess input. */)
6649 (process
, decoding
, encoding
)
6650 register Lisp_Object process
, decoding
, encoding
;
6652 register struct Lisp_Process
*p
;
6654 CHECK_PROCESS (process
);
6655 p
= XPROCESS (process
);
6656 if (XINT (p
->infd
) < 0)
6657 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6658 if (XINT (p
->outfd
) < 0)
6659 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6660 Fcheck_coding_system (decoding
);
6661 Fcheck_coding_system (encoding
);
6663 p
->decode_coding_system
= decoding
;
6664 p
->encode_coding_system
= encoding
;
6665 setup_process_coding_systems (process
);
6670 DEFUN ("process-coding-system",
6671 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6672 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6674 register Lisp_Object process
;
6676 CHECK_PROCESS (process
);
6677 return Fcons (XPROCESS (process
)->decode_coding_system
,
6678 XPROCESS (process
)->encode_coding_system
);
6681 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6682 Sset_process_filter_multibyte
, 2, 2, 0,
6683 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6684 If FLAG is non-nil, the filter is given multibyte strings.
6685 If FLAG is nil, the filter is given unibyte strings. In this case,
6686 all character code conversion except for end-of-line conversion is
6689 Lisp_Object process
, flag
;
6691 register struct Lisp_Process
*p
;
6693 CHECK_PROCESS (process
);
6694 p
= XPROCESS (process
);
6695 p
->filter_multibyte
= flag
;
6696 setup_process_coding_systems (process
);
6701 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6702 Sprocess_filter_multibyte_p
, 1, 1, 0,
6703 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6705 Lisp_Object process
;
6707 register struct Lisp_Process
*p
;
6709 CHECK_PROCESS (process
);
6710 p
= XPROCESS (process
);
6712 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6717 /* The first time this is called, assume keyboard input comes from DESC
6718 instead of from where we used to expect it.
6719 Subsequent calls mean assume input keyboard can come from DESC
6720 in addition to other places. */
6722 static int add_keyboard_wait_descriptor_called_flag
;
6725 add_keyboard_wait_descriptor (desc
)
6728 if (! add_keyboard_wait_descriptor_called_flag
)
6729 FD_CLR (0, &input_wait_mask
);
6730 add_keyboard_wait_descriptor_called_flag
= 1;
6731 FD_SET (desc
, &input_wait_mask
);
6732 FD_SET (desc
, &non_process_wait_mask
);
6733 if (desc
> max_keyboard_desc
)
6734 max_keyboard_desc
= desc
;
6737 /* From now on, do not expect DESC to give keyboard input. */
6740 delete_keyboard_wait_descriptor (desc
)
6744 int lim
= max_keyboard_desc
;
6746 FD_CLR (desc
, &input_wait_mask
);
6747 FD_CLR (desc
, &non_process_wait_mask
);
6749 if (desc
== max_keyboard_desc
)
6750 for (fd
= 0; fd
< lim
; fd
++)
6751 if (FD_ISSET (fd
, &input_wait_mask
)
6752 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6753 max_keyboard_desc
= fd
;
6756 /* Return nonzero if *MASK has a bit set
6757 that corresponds to one of the keyboard input descriptors. */
6760 keyboard_bit_set (mask
)
6765 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6766 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6767 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6780 if (! noninteractive
|| initialized
)
6782 signal (SIGCHLD
, sigchld_handler
);
6785 FD_ZERO (&input_wait_mask
);
6786 FD_ZERO (&non_keyboard_wait_mask
);
6787 FD_ZERO (&non_process_wait_mask
);
6788 max_process_desc
= 0;
6790 #ifdef NON_BLOCKING_CONNECT
6791 FD_ZERO (&connect_wait_mask
);
6792 num_pending_connects
= 0;
6795 #ifdef ADAPTIVE_READ_BUFFERING
6796 process_output_delay_count
= 0;
6797 process_output_skip
= 0;
6800 FD_SET (0, &input_wait_mask
);
6802 Vprocess_alist
= Qnil
;
6803 for (i
= 0; i
< MAXDESC
; i
++)
6805 chan_process
[i
] = Qnil
;
6806 proc_buffered_char
[i
] = -1;
6808 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6809 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6810 #ifdef DATAGRAM_SOCKETS
6811 bzero (datagram_address
, sizeof datagram_address
);
6816 Lisp_Object subfeatures
= Qnil
;
6817 struct socket_options
*sopt
;
6819 #define ADD_SUBFEATURE(key, val) \
6820 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6822 #ifdef NON_BLOCKING_CONNECT
6823 ADD_SUBFEATURE (QCnowait
, Qt
);
6825 #ifdef DATAGRAM_SOCKETS
6826 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6828 #ifdef HAVE_LOCAL_SOCKETS
6829 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6831 ADD_SUBFEATURE (QCfamily
, Qipv4
);
6833 ADD_SUBFEATURE (QCfamily
, Qipv6
);
6835 #ifdef HAVE_GETSOCKNAME
6836 ADD_SUBFEATURE (QCservice
, Qt
);
6838 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6839 ADD_SUBFEATURE (QCserver
, Qt
);
6842 for (sopt
= socket_options
; sopt
->name
; sopt
++)
6843 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
6845 Fprovide (intern ("make-network-process"), subfeatures
);
6847 #endif /* HAVE_SOCKETS */
6849 #if defined (DARWIN) || defined (MAC_OSX)
6850 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
6851 processes. As such, we only change the default value. */
6854 char *release
= get_operating_system_release();
6855 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
6856 && release
[1] == '.')) {
6857 Vprocess_connection_type
= Qnil
;
6866 Qprocessp
= intern ("processp");
6867 staticpro (&Qprocessp
);
6868 Qrun
= intern ("run");
6870 Qstop
= intern ("stop");
6872 Qsignal
= intern ("signal");
6873 staticpro (&Qsignal
);
6875 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6878 Qexit = intern ("exit");
6879 staticpro (&Qexit); */
6881 Qopen
= intern ("open");
6883 Qclosed
= intern ("closed");
6884 staticpro (&Qclosed
);
6885 Qconnect
= intern ("connect");
6886 staticpro (&Qconnect
);
6887 Qfailed
= intern ("failed");
6888 staticpro (&Qfailed
);
6889 Qlisten
= intern ("listen");
6890 staticpro (&Qlisten
);
6891 Qlocal
= intern ("local");
6892 staticpro (&Qlocal
);
6893 Qipv4
= intern ("ipv4");
6896 Qipv6
= intern ("ipv6");
6899 Qdatagram
= intern ("datagram");
6900 staticpro (&Qdatagram
);
6902 QCname
= intern (":name");
6903 staticpro (&QCname
);
6904 QCbuffer
= intern (":buffer");
6905 staticpro (&QCbuffer
);
6906 QChost
= intern (":host");
6907 staticpro (&QChost
);
6908 QCservice
= intern (":service");
6909 staticpro (&QCservice
);
6910 QCtype
= intern (":type");
6911 staticpro (&QCtype
);
6912 QClocal
= intern (":local");
6913 staticpro (&QClocal
);
6914 QCremote
= intern (":remote");
6915 staticpro (&QCremote
);
6916 QCcoding
= intern (":coding");
6917 staticpro (&QCcoding
);
6918 QCserver
= intern (":server");
6919 staticpro (&QCserver
);
6920 QCnowait
= intern (":nowait");
6921 staticpro (&QCnowait
);
6922 QCsentinel
= intern (":sentinel");
6923 staticpro (&QCsentinel
);
6924 QClog
= intern (":log");
6926 QCnoquery
= intern (":noquery");
6927 staticpro (&QCnoquery
);
6928 QCstop
= intern (":stop");
6929 staticpro (&QCstop
);
6930 QCoptions
= intern (":options");
6931 staticpro (&QCoptions
);
6932 QCplist
= intern (":plist");
6933 staticpro (&QCplist
);
6934 QCfilter_multibyte
= intern (":filter-multibyte");
6935 staticpro (&QCfilter_multibyte
);
6937 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
6938 staticpro (&Qlast_nonmenu_event
);
6940 staticpro (&Vprocess_alist
);
6942 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
6943 doc
: /* *Non-nil means delete processes immediately when they exit.
6944 nil means don't delete them until `list-processes' is run. */);
6946 delete_exited_processes
= 1;
6948 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
6949 doc
: /* Control type of device used to communicate with subprocesses.
6950 Values are nil to use a pipe, or t or `pty' to use a pty.
6951 The value has no effect if the system has no ptys or if all ptys are busy:
6952 then a pipe is used in any case.
6953 The value takes effect when `start-process' is called. */);
6954 Vprocess_connection_type
= Qt
;
6956 #ifdef ADAPTIVE_READ_BUFFERING
6957 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
6958 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
6959 On some systems, when Emacs reads the output from a subprocess, the output data
6960 is read in very small blocks, potentially resulting in very poor performance.
6961 This behavior can be remedied to some extent by setting this variable to a
6962 non-nil value, as it will automatically delay reading from such processes, to
6963 allowing them to produce more output before Emacs tries to read it.
6964 If the value is t, the delay is reset after each write to the process; any other
6965 non-nil value means that the delay is not reset on write.
6966 The variable takes effect when `start-process' is called. */);
6967 Vprocess_adaptive_read_buffering
= Qt
;
6970 defsubr (&Sprocessp
);
6971 defsubr (&Sget_process
);
6972 defsubr (&Sget_buffer_process
);
6973 defsubr (&Sdelete_process
);
6974 defsubr (&Sprocess_status
);
6975 defsubr (&Sprocess_exit_status
);
6976 defsubr (&Sprocess_id
);
6977 defsubr (&Sprocess_name
);
6978 defsubr (&Sprocess_tty_name
);
6979 defsubr (&Sprocess_command
);
6980 defsubr (&Sset_process_buffer
);
6981 defsubr (&Sprocess_buffer
);
6982 defsubr (&Sprocess_mark
);
6983 defsubr (&Sset_process_filter
);
6984 defsubr (&Sprocess_filter
);
6985 defsubr (&Sset_process_sentinel
);
6986 defsubr (&Sprocess_sentinel
);
6987 defsubr (&Sset_process_window_size
);
6988 defsubr (&Sset_process_inherit_coding_system_flag
);
6989 defsubr (&Sprocess_inherit_coding_system_flag
);
6990 defsubr (&Sset_process_query_on_exit_flag
);
6991 defsubr (&Sprocess_query_on_exit_flag
);
6992 defsubr (&Sprocess_contact
);
6993 defsubr (&Sprocess_plist
);
6994 defsubr (&Sset_process_plist
);
6995 defsubr (&Slist_processes
);
6996 defsubr (&Sprocess_list
);
6997 defsubr (&Sstart_process
);
6999 defsubr (&Sset_network_process_option
);
7000 defsubr (&Smake_network_process
);
7001 defsubr (&Sformat_network_address
);
7002 #endif /* HAVE_SOCKETS */
7003 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7005 defsubr (&Snetwork_interface_list
);
7007 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7008 defsubr (&Snetwork_interface_info
);
7010 #endif /* HAVE_SOCKETS ... */
7011 #ifdef DATAGRAM_SOCKETS
7012 defsubr (&Sprocess_datagram_address
);
7013 defsubr (&Sset_process_datagram_address
);
7015 defsubr (&Saccept_process_output
);
7016 defsubr (&Sprocess_send_region
);
7017 defsubr (&Sprocess_send_string
);
7018 defsubr (&Sinterrupt_process
);
7019 defsubr (&Skill_process
);
7020 defsubr (&Squit_process
);
7021 defsubr (&Sstop_process
);
7022 defsubr (&Scontinue_process
);
7023 defsubr (&Sprocess_running_child_p
);
7024 defsubr (&Sprocess_send_eof
);
7025 defsubr (&Ssignal_process
);
7026 defsubr (&Swaiting_for_user_input_p
);
7027 /* defsubr (&Sprocess_connection); */
7028 defsubr (&Sset_process_coding_system
);
7029 defsubr (&Sprocess_coding_system
);
7030 defsubr (&Sset_process_filter_multibyte
);
7031 defsubr (&Sprocess_filter_multibyte_p
);
7035 #else /* not subprocesses */
7037 #include <sys/types.h>
7041 #include "systime.h"
7042 #include "charset.h"
7044 #include "termopts.h"
7045 #include "sysselect.h"
7047 extern int frame_garbaged
;
7049 extern EMACS_TIME
timer_check ();
7050 extern int timers_run
;
7054 /* As described above, except assuming that there are no subprocesses:
7056 Wait for timeout to elapse and/or keyboard input to be available.
7059 timeout in seconds, or
7060 zero for no limit, or
7061 -1 means gobble data immediately available but don't wait for any.
7063 read_kbd is a Lisp_Object:
7064 0 to ignore keyboard input, or
7065 1 to return when input is available, or
7066 -1 means caller will actually read the input, so don't throw to
7069 see full version for other parameters. We know that wait_proc will
7070 always be NULL, since `subprocesses' isn't defined.
7072 do_display != 0 means redisplay should be done to show subprocess
7073 output that arrives.
7075 Return true iff we received input from any process. */
7078 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
7079 wait_for_cell
, wait_proc
, just_wait_proc
)
7080 int time_limit
, microsecs
, read_kbd
, do_display
;
7081 Lisp_Object wait_for_cell
;
7082 struct Lisp_Process
*wait_proc
;
7086 EMACS_TIME end_time
, timeout
;
7087 SELECT_TYPE waitchannels
;
7090 /* What does time_limit really mean? */
7091 if (time_limit
|| microsecs
)
7093 EMACS_GET_TIME (end_time
);
7094 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
7095 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
7098 /* Turn off periodic alarms (in case they are in use)
7099 and then turn off any other atimers,
7100 because the select emulator uses alarms. */
7102 turn_on_atimers (0);
7106 int timeout_reduced_for_timers
= 0;
7108 /* If calling from keyboard input, do not quit
7109 since we want to return C-g as an input character.
7110 Otherwise, do pending quit if requested. */
7114 /* Exit now if the cell we're waiting for became non-nil. */
7115 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7118 /* Compute time from now till when time limit is up */
7119 /* Exit if already run out */
7120 if (time_limit
== -1)
7122 /* -1 specified for timeout means
7123 gobble output available now
7124 but don't wait at all. */
7126 EMACS_SET_SECS_USECS (timeout
, 0, 0);
7128 else if (time_limit
|| microsecs
)
7130 EMACS_GET_TIME (timeout
);
7131 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
7132 if (EMACS_TIME_NEG_P (timeout
))
7137 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
7140 /* If our caller will not immediately handle keyboard events,
7141 run timer events directly.
7142 (Callers that will immediately read keyboard events
7143 call timer_delay on their own.) */
7144 if (NILP (wait_for_cell
))
7146 EMACS_TIME timer_delay
;
7150 int old_timers_run
= timers_run
;
7151 timer_delay
= timer_check (1);
7152 if (timers_run
!= old_timers_run
&& do_display
)
7153 /* We must retry, since a timer may have requeued itself
7154 and that could alter the time delay. */
7155 redisplay_preserve_echo_area (14);
7159 while (!detect_input_pending ());
7161 /* If there is unread keyboard input, also return. */
7163 && requeued_events_pending_p ())
7166 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
7168 EMACS_TIME difference
;
7169 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
7170 if (EMACS_TIME_NEG_P (difference
))
7172 timeout
= timer_delay
;
7173 timeout_reduced_for_timers
= 1;
7178 /* Cause C-g and alarm signals to take immediate action,
7179 and cause input available signals to zero out timeout. */
7181 set_waiting_for_input (&timeout
);
7183 /* Wait till there is something to do. */
7185 if (! read_kbd
&& NILP (wait_for_cell
))
7186 FD_ZERO (&waitchannels
);
7188 FD_SET (0, &waitchannels
);
7190 /* If a frame has been newly mapped and needs updating,
7191 reprocess its display stuff. */
7192 if (frame_garbaged
&& do_display
)
7194 clear_waiting_for_input ();
7195 redisplay_preserve_echo_area (15);
7197 set_waiting_for_input (&timeout
);
7200 if (read_kbd
&& detect_input_pending ())
7203 FD_ZERO (&waitchannels
);
7206 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7211 /* Make C-g and alarm signals set flags again */
7212 clear_waiting_for_input ();
7214 /* If we woke up due to SIGWINCH, actually change size now. */
7215 do_pending_window_change (0);
7217 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7218 /* We waited the full specified time, so return now. */
7223 /* If the system call was interrupted, then go around the
7225 if (xerrno
== EINTR
)
7226 FD_ZERO (&waitchannels
);
7228 error ("select error: %s", emacs_strerror (xerrno
));
7231 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7232 /* System sometimes fails to deliver SIGIO. */
7233 kill (getpid (), SIGIO
);
7236 if (read_kbd
&& interrupt_input
&& (waitchannels
& 1))
7237 kill (getpid (), SIGIO
);
7240 /* Check for keyboard input */
7243 && detect_input_pending_run_timers (do_display
))
7245 swallow_events (do_display
);
7246 if (detect_input_pending_run_timers (do_display
))
7250 /* If there is unread keyboard input, also return. */
7252 && requeued_events_pending_p ())
7255 /* If wait_for_cell. check for keyboard input
7256 but don't run any timers.
7257 ??? (It seems wrong to me to check for keyboard
7258 input at all when wait_for_cell, but the code
7259 has been this way since July 1994.
7260 Try changing this after version 19.31.) */
7261 if (! NILP (wait_for_cell
)
7262 && detect_input_pending ())
7264 swallow_events (do_display
);
7265 if (detect_input_pending ())
7269 /* Exit now if the cell we're waiting for became non-nil. */
7270 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7280 /* Don't confuse make-docfile by having two doc strings for this function.
7281 make-docfile does not pay attention to #if, for good reason! */
7282 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7285 register Lisp_Object name
;
7290 /* Don't confuse make-docfile by having two doc strings for this function.
7291 make-docfile does not pay attention to #if, for good reason! */
7292 DEFUN ("process-inherit-coding-system-flag",
7293 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7297 register Lisp_Object process
;
7299 /* Ignore the argument and return the value of
7300 inherit-process-coding-system. */
7301 return inherit_process_coding_system
? Qt
: Qnil
;
7304 /* Kill all processes associated with `buffer'.
7305 If `buffer' is nil, kill all processes.
7306 Since we have no subprocesses, this does nothing. */
7309 kill_buffer_processes (buffer
)
7322 QCtype
= intern (":type");
7323 staticpro (&QCtype
);
7325 defsubr (&Sget_buffer_process
);
7326 defsubr (&Sprocess_inherit_coding_system_flag
);
7330 #endif /* not subprocesses */
7332 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7333 (do not change this comment) */