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>
121 /* Disable IPv6 support for w32 until someone figures out how to do it
139 #include "termhooks.h"
140 #include "termopts.h"
141 #include "commands.h"
142 #include "keyboard.h"
143 #include "blockinput.h"
144 #include "dispextern.h"
145 #include "composite.h"
148 Lisp_Object Qprocessp
;
149 Lisp_Object Qrun
, Qstop
, Qsignal
;
150 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
151 Lisp_Object Qlocal
, Qipv4
, Qdatagram
;
155 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
156 Lisp_Object QClocal
, QCremote
, QCcoding
;
157 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
158 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
159 Lisp_Object QCfilter_multibyte
;
160 Lisp_Object Qlast_nonmenu_event
;
161 /* QCfamily is declared and initialized in xfaces.c,
162 QCfilter in keyboard.c. */
163 extern Lisp_Object QCfamily
, QCfilter
;
165 /* Qexit is declared and initialized in eval.c. */
167 /* QCfamily is defined in xfaces.c. */
168 extern Lisp_Object QCfamily
;
169 /* QCfilter is defined in keyboard.c. */
170 extern Lisp_Object QCfilter
;
172 /* a process object is a network connection when its childp field is neither
173 Qt nor Qnil but is instead a property list (KEY VAL ...). */
176 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
177 #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
179 #define NETCONN_P(p) 0
180 #define NETCONN1_P(p) 0
181 #endif /* HAVE_SOCKETS */
183 /* Define first descriptor number available for subprocesses. */
185 #define FIRST_PROC_DESC 1
187 #define FIRST_PROC_DESC 3
190 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
193 #if !defined (SIGCHLD) && defined (SIGCLD)
194 #define SIGCHLD SIGCLD
197 #include "syssignal.h"
201 extern char *get_operating_system_release ();
207 extern char *sys_errlist
[];
214 /* t means use pty, nil means use a pipe,
215 maybe other values to come. */
216 static Lisp_Object Vprocess_connection_type
;
220 #include <sys/socket.h>
224 /* These next two vars are non-static since sysdep.c uses them in the
225 emulation of `select'. */
226 /* Number of events of change of status of a process. */
228 /* Number of events for which the user or sentinel has been notified. */
231 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
233 #ifdef BROKEN_NON_BLOCKING_CONNECT
234 #undef NON_BLOCKING_CONNECT
236 #ifndef NON_BLOCKING_CONNECT
239 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
240 #if defined (O_NONBLOCK) || defined (O_NDELAY)
241 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
242 #define NON_BLOCKING_CONNECT
243 #endif /* EWOULDBLOCK || EINPROGRESS */
244 #endif /* O_NONBLOCK || O_NDELAY */
245 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
246 #endif /* HAVE_SELECT */
247 #endif /* HAVE_SOCKETS */
248 #endif /* NON_BLOCKING_CONNECT */
249 #endif /* BROKEN_NON_BLOCKING_CONNECT */
251 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
252 this system. We need to read full packets, so we need a
253 "non-destructive" select. So we require either native select,
254 or emulation of select using FIONREAD. */
256 #ifdef BROKEN_DATAGRAM_SOCKETS
257 #undef DATAGRAM_SOCKETS
259 #ifndef DATAGRAM_SOCKETS
261 #if defined (HAVE_SELECT) || defined (FIONREAD)
262 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
263 #define DATAGRAM_SOCKETS
264 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
265 #endif /* HAVE_SELECT || FIONREAD */
266 #endif /* HAVE_SOCKETS */
267 #endif /* DATAGRAM_SOCKETS */
268 #endif /* BROKEN_DATAGRAM_SOCKETS */
271 #undef NON_BLOCKING_CONNECT
272 #undef DATAGRAM_SOCKETS
275 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
276 #ifdef EMACS_HAS_USECS
277 #define ADAPTIVE_READ_BUFFERING
281 #ifdef ADAPTIVE_READ_BUFFERING
282 #define READ_OUTPUT_DELAY_INCREMENT 10000
283 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
284 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
286 /* Number of processes which have a non-zero read_output_delay,
287 and therefore might be delayed for adaptive read buffering. */
289 static int process_output_delay_count
;
291 /* Non-zero if any process has non-nil read_output_skip. */
293 static int process_output_skip
;
295 /* Non-nil means to delay reading process output to improve buffering.
296 A value of t means that delay is reset after each send, any other
297 non-nil value does not reset the delay. A value of nil disables
298 adaptive read buffering completely. */
299 static Lisp_Object Vprocess_adaptive_read_buffering
;
301 #define process_output_delay_count 0
305 #include "sysselect.h"
307 static int keyboard_bit_set
P_ ((SELECT_TYPE
*));
308 static void deactivate_process
P_ ((Lisp_Object
));
309 static void status_notify
P_ ((struct Lisp_Process
*));
310 static int read_process_output
P_ ((Lisp_Object
, int));
312 /* If we support a window system, turn on the code to poll periodically
313 to detect C-g. It isn't actually used when doing interrupt input. */
314 #ifdef HAVE_WINDOW_SYSTEM
315 #define POLL_FOR_INPUT
318 /* Mask of bits indicating the descriptors that we wait for input on. */
320 static SELECT_TYPE input_wait_mask
;
322 /* Mask that excludes keyboard input descriptor(s). */
324 static SELECT_TYPE non_keyboard_wait_mask
;
326 /* Mask that excludes process input descriptor(s). */
328 static SELECT_TYPE non_process_wait_mask
;
330 #ifdef NON_BLOCKING_CONNECT
331 /* Mask of bits indicating the descriptors that we wait for connect to
332 complete on. Once they complete, they are removed from this mask
333 and added to the input_wait_mask and non_keyboard_wait_mask. */
335 static SELECT_TYPE connect_wait_mask
;
337 /* Number of bits set in connect_wait_mask. */
338 static int num_pending_connects
;
340 #define IF_NON_BLOCKING_CONNECT(s) s
342 #define IF_NON_BLOCKING_CONNECT(s)
345 /* The largest descriptor currently in use for a process object. */
346 static int max_process_desc
;
348 /* The largest descriptor currently in use for keyboard input. */
349 static int max_keyboard_desc
;
351 /* Nonzero means delete a process right away if it exits. */
352 static int delete_exited_processes
;
354 /* Indexed by descriptor, gives the process (if any) for that descriptor */
355 Lisp_Object chan_process
[MAXDESC
];
357 /* Alist of elements (NAME . PROCESS) */
358 Lisp_Object Vprocess_alist
;
360 /* Buffered-ahead input char from process, indexed by channel.
361 -1 means empty (no char is buffered).
362 Used on sys V where the only way to tell if there is any
363 output from the process is to read at least one char.
364 Always -1 on systems that support FIONREAD. */
366 /* Don't make static; need to access externally. */
367 int proc_buffered_char
[MAXDESC
];
369 /* Table of `struct coding-system' for each process. */
370 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
371 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
373 #ifdef DATAGRAM_SOCKETS
374 /* Table of `partner address' for datagram sockets. */
375 struct sockaddr_and_len
{
378 } datagram_address
[MAXDESC
];
379 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
380 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
382 #define DATAGRAM_CHAN_P(chan) (0)
383 #define DATAGRAM_CONN_P(proc) (0)
386 static Lisp_Object
get_process ();
387 static void exec_sentinel ();
389 extern EMACS_TIME
timer_check ();
390 extern int timers_run
;
392 /* Maximum number of bytes to send to a pty without an eof. */
393 static int pty_max_bytes
;
399 /* The file name of the pty opened by allocate_pty. */
401 static char pty_name
[24];
404 /* Compute the Lisp form of the process status, p->status, from
405 the numeric status that was returned by `wait'. */
407 static Lisp_Object
status_convert ();
411 struct Lisp_Process
*p
;
413 union { int i
; WAITTYPE wt
; } u
;
414 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
415 p
->status
= status_convert (u
.wt
);
416 p
->raw_status_low
= Qnil
;
417 p
->raw_status_high
= Qnil
;
420 /* Convert a process status word in Unix format to
421 the list that we use internally. */
428 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
429 else if (WIFEXITED (w
))
430 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
431 WCOREDUMP (w
) ? Qt
: Qnil
));
432 else if (WIFSIGNALED (w
))
433 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
434 WCOREDUMP (w
) ? Qt
: Qnil
));
439 /* Given a status-list, extract the three pieces of information
440 and store them individually through the three pointers. */
443 decode_status (l
, symbol
, code
, coredump
)
461 *code
= XFASTINT (XCAR (tem
));
463 *coredump
= !NILP (tem
);
467 /* Return a string describing a process status list. */
471 struct Lisp_Process
*p
;
473 Lisp_Object status
= p
->status
;
476 Lisp_Object string
, string2
;
478 decode_status (status
, &symbol
, &code
, &coredump
);
480 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
483 synchronize_system_messages_locale ();
484 signame
= strsignal (code
);
487 string
= build_string (signame
);
488 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
489 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
490 return concat2 (string
, string2
);
492 else if (EQ (symbol
, Qexit
))
495 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
497 return build_string ("finished\n");
498 string
= Fnumber_to_string (make_number (code
));
499 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
500 return concat3 (build_string ("exited abnormally with code "),
503 else if (EQ (symbol
, Qfailed
))
505 string
= Fnumber_to_string (make_number (code
));
506 string2
= build_string ("\n");
507 return concat3 (build_string ("failed with code "),
511 return Fcopy_sequence (Fsymbol_name (symbol
));
516 /* Open an available pty, returning a file descriptor.
517 Return -1 on failure.
518 The file name of the terminal corresponding to the pty
519 is left in the variable pty_name. */
530 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
531 for (i
= 0; i
< 16; i
++)
534 struct stat stb
; /* Used in some PTY_OPEN. */
535 #ifdef PTY_NAME_SPRINTF
538 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
539 #endif /* no PTY_NAME_SPRINTF */
543 #else /* no PTY_OPEN */
546 /* Unusual IRIS code */
547 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
550 if (fstat (fd
, &stb
) < 0)
552 # else /* not IRIS */
553 { /* Some systems name their pseudoterminals so that there are gaps in
554 the usual sequence - for example, on HP9000/S700 systems, there
555 are no pseudoterminals with names ending in 'f'. So we wait for
556 three failures in a row before deciding that we've reached the
558 int failed_count
= 0;
560 if (stat (pty_name
, &stb
) < 0)
563 if (failed_count
>= 3)
570 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
572 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
574 # endif /* not IRIS */
576 #endif /* no PTY_OPEN */
580 /* check to make certain that both sides are available
581 this avoids a nasty yet stupid bug in rlogins */
582 #ifdef PTY_TTY_NAME_SPRINTF
585 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
586 #endif /* no PTY_TTY_NAME_SPRINTF */
588 if (access (pty_name
, 6) != 0)
591 # if !defined(IRIS) && !defined(__sgi)
597 #endif /* not UNIPLUS */
604 #endif /* HAVE_PTYS */
610 register Lisp_Object val
, tem
, name1
;
611 register struct Lisp_Process
*p
;
615 p
= allocate_process ();
617 XSETINT (p
->infd
, -1);
618 XSETINT (p
->outfd
, -1);
619 XSETFASTINT (p
->pid
, 0);
620 XSETFASTINT (p
->tick
, 0);
621 XSETFASTINT (p
->update_tick
, 0);
622 p
->raw_status_low
= Qnil
;
623 p
->raw_status_high
= Qnil
;
625 p
->mark
= Fmake_marker ();
627 #ifdef ADAPTIVE_READ_BUFFERING
628 p
->adaptive_read_buffering
= Qnil
;
629 XSETFASTINT (p
->read_output_delay
, 0);
630 p
->read_output_skip
= Qnil
;
633 /* If name is already in use, modify it until it is unused. */
638 tem
= Fget_process (name1
);
639 if (NILP (tem
)) break;
640 sprintf (suffix
, "<%d>", i
);
641 name1
= concat2 (name
, build_string (suffix
));
645 XSETPROCESS (val
, p
);
646 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
651 remove_process (proc
)
652 register Lisp_Object proc
;
654 register Lisp_Object pair
;
656 pair
= Frassq (proc
, Vprocess_alist
);
657 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
659 deactivate_process (proc
);
662 /* Setup coding systems of PROCESS. */
665 setup_process_coding_systems (process
)
668 struct Lisp_Process
*p
= XPROCESS (process
);
669 int inch
= XINT (p
->infd
);
670 int outch
= XINT (p
->outfd
);
672 if (inch
< 0 || outch
< 0)
675 if (!proc_decode_coding_system
[inch
])
676 proc_decode_coding_system
[inch
]
677 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
678 setup_coding_system (p
->decode_coding_system
,
679 proc_decode_coding_system
[inch
]);
680 if (! NILP (p
->filter
))
682 if (NILP (p
->filter_multibyte
))
683 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
685 else if (BUFFERP (p
->buffer
))
687 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
688 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
691 if (!proc_encode_coding_system
[outch
])
692 proc_encode_coding_system
[outch
]
693 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
694 setup_coding_system (p
->encode_coding_system
,
695 proc_encode_coding_system
[outch
]);
698 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
699 doc
: /* Return t if OBJECT is a process. */)
703 return PROCESSP (object
) ? Qt
: Qnil
;
706 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
707 doc
: /* Return the process named NAME, or nil if there is none. */)
709 register Lisp_Object name
;
714 return Fcdr (Fassoc (name
, Vprocess_alist
));
717 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
718 doc
: /* Return the (or a) process associated with BUFFER.
719 BUFFER may be a buffer or the name of one. */)
721 register Lisp_Object buffer
;
723 register Lisp_Object buf
, tail
, proc
;
725 if (NILP (buffer
)) return Qnil
;
726 buf
= Fget_buffer (buffer
);
727 if (NILP (buf
)) return Qnil
;
729 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
731 proc
= Fcdr (Fcar (tail
));
732 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
738 /* This is how commands for the user decode process arguments. It
739 accepts a process, a process name, a buffer, a buffer name, or nil.
740 Buffers denote the first process in the buffer, and nil denotes the
745 register Lisp_Object name
;
747 register Lisp_Object proc
, obj
;
750 obj
= Fget_process (name
);
752 obj
= Fget_buffer (name
);
754 error ("Process %s does not exist", SDATA (name
));
756 else if (NILP (name
))
757 obj
= Fcurrent_buffer ();
761 /* Now obj should be either a buffer object or a process object.
765 proc
= Fget_buffer_process (obj
);
767 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
777 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
778 doc
: /* Delete PROCESS: kill it and forget about it immediately.
779 PROCESS may be a process, a buffer, the name of a process or buffer, or
780 nil, indicating the current buffer's process. */)
782 register Lisp_Object process
;
784 register struct Lisp_Process
*p
;
786 process
= get_process (process
);
787 p
= XPROCESS (process
);
789 p
->raw_status_low
= Qnil
;
790 p
->raw_status_high
= Qnil
;
793 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
794 XSETINT (p
->tick
, ++process_tick
);
797 else if (XINT (p
->infd
) >= 0)
799 Fkill_process (process
, Qnil
);
800 /* Do this now, since remove_process will make sigchld_handler do nothing. */
802 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
803 XSETINT (p
->tick
, ++process_tick
);
806 remove_process (process
);
810 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
811 doc
: /* Return the status of PROCESS.
812 The returned value is one of the following symbols:
813 run -- for a process that is running.
814 stop -- for a process stopped but continuable.
815 exit -- for a process that has exited.
816 signal -- for a process that has got a fatal signal.
817 open -- for a network stream connection that is open.
818 listen -- for a network stream server that is listening.
819 closed -- for a network stream connection that is closed.
820 connect -- when waiting for a non-blocking connection to complete.
821 failed -- when a non-blocking connection has failed.
822 nil -- if arg is a process name and no such process exists.
823 PROCESS may be a process, a buffer, the name of a process, or
824 nil, indicating the current buffer's process. */)
826 register Lisp_Object process
;
828 register struct Lisp_Process
*p
;
829 register Lisp_Object status
;
831 if (STRINGP (process
))
832 process
= Fget_process (process
);
834 process
= get_process (process
);
839 p
= XPROCESS (process
);
840 if (!NILP (p
->raw_status_low
))
844 status
= XCAR (status
);
847 if (EQ (status
, Qexit
))
849 else if (EQ (p
->command
, Qt
))
851 else if (EQ (status
, Qrun
))
857 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
859 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
860 If PROCESS has not yet exited or died, return 0. */)
862 register Lisp_Object process
;
864 CHECK_PROCESS (process
);
865 if (!NILP (XPROCESS (process
)->raw_status_low
))
866 update_status (XPROCESS (process
));
867 if (CONSP (XPROCESS (process
)->status
))
868 return XCAR (XCDR (XPROCESS (process
)->status
));
869 return make_number (0);
872 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
873 doc
: /* Return the process id of PROCESS.
874 This is the pid of the external process which PROCESS uses or talks to.
875 For a network connection, this value is nil. */)
877 register Lisp_Object process
;
879 CHECK_PROCESS (process
);
880 return XPROCESS (process
)->pid
;
883 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
884 doc
: /* Return the name of PROCESS, as a string.
885 This is the name of the program invoked in PROCESS,
886 possibly modified to make it unique among process names. */)
888 register Lisp_Object process
;
890 CHECK_PROCESS (process
);
891 return XPROCESS (process
)->name
;
894 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
895 doc
: /* Return the command that was executed to start PROCESS.
896 This is a list of strings, the first string being the program executed
897 and the rest of the strings being the arguments given to it.
898 For a non-child channel, this is nil. */)
900 register Lisp_Object process
;
902 CHECK_PROCESS (process
);
903 return XPROCESS (process
)->command
;
906 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
907 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
908 This is the terminal that the process itself reads and writes on,
909 not the name of the pty that Emacs uses to talk with that terminal. */)
911 register Lisp_Object process
;
913 CHECK_PROCESS (process
);
914 return XPROCESS (process
)->tty_name
;
917 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
919 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
921 register Lisp_Object process
, buffer
;
923 struct Lisp_Process
*p
;
925 CHECK_PROCESS (process
);
927 CHECK_BUFFER (buffer
);
928 p
= XPROCESS (process
);
931 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
932 setup_process_coding_systems (process
);
936 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
938 doc
: /* Return the buffer PROCESS is associated with.
939 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
941 register Lisp_Object process
;
943 CHECK_PROCESS (process
);
944 return XPROCESS (process
)->buffer
;
947 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
949 doc
: /* Return the marker for the end of the last output from PROCESS. */)
951 register Lisp_Object process
;
953 CHECK_PROCESS (process
);
954 return XPROCESS (process
)->mark
;
957 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
959 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
960 t means stop accepting output from the process.
962 When a process has a filter, its buffer is not used for output.
963 Instead, each time it does output, the entire string of output is
964 passed to the filter.
966 The filter gets two arguments: the process and the string of output.
967 The string argument is normally a multibyte string, except:
968 - if the process' input coding system is no-conversion or raw-text,
969 it is a unibyte string (the non-converted input), or else
970 - if `default-enable-multibyte-characters' is nil, it is a unibyte
971 string (the result of converting the decoded input multibyte
972 string to unibyte with `string-make-unibyte'). */)
974 register Lisp_Object process
, filter
;
976 struct Lisp_Process
*p
;
978 CHECK_PROCESS (process
);
979 p
= XPROCESS (process
);
981 /* Don't signal an error if the process' input file descriptor
982 is closed. This could make debugging Lisp more difficult,
983 for example when doing something like
985 (setq process (start-process ...))
987 (set-process-filter process ...) */
989 if (XINT (p
->infd
) >= 0)
991 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
993 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
994 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
996 else if (EQ (p
->filter
, Qt
)
997 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
999 FD_SET (XINT (p
->infd
), &input_wait_mask
);
1000 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
1006 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
1007 setup_process_coding_systems (process
);
1011 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1013 doc
: /* Returns the filter function of PROCESS; nil if none.
1014 See `set-process-filter' for more info on filter functions. */)
1016 register Lisp_Object process
;
1018 CHECK_PROCESS (process
);
1019 return XPROCESS (process
)->filter
;
1022 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1024 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1025 The sentinel is called as a function when the process changes state.
1026 It gets two arguments: the process, and a string describing the change. */)
1028 register Lisp_Object process
, sentinel
;
1030 struct Lisp_Process
*p
;
1032 CHECK_PROCESS (process
);
1033 p
= XPROCESS (process
);
1035 p
->sentinel
= sentinel
;
1037 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1041 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1043 doc
: /* Return the sentinel of PROCESS; nil if none.
1044 See `set-process-sentinel' for more info on sentinels. */)
1046 register Lisp_Object process
;
1048 CHECK_PROCESS (process
);
1049 return XPROCESS (process
)->sentinel
;
1052 DEFUN ("set-process-window-size", Fset_process_window_size
,
1053 Sset_process_window_size
, 3, 3, 0,
1054 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1055 (process
, height
, width
)
1056 register Lisp_Object process
, height
, width
;
1058 CHECK_PROCESS (process
);
1059 CHECK_NATNUM (height
);
1060 CHECK_NATNUM (width
);
1062 if (XINT (XPROCESS (process
)->infd
) < 0
1063 || set_window_size (XINT (XPROCESS (process
)->infd
),
1064 XINT (height
), XINT (width
)) <= 0)
1070 DEFUN ("set-process-inherit-coding-system-flag",
1071 Fset_process_inherit_coding_system_flag
,
1072 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1073 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1074 If the second argument FLAG is non-nil, then the variable
1075 `buffer-file-coding-system' of the buffer associated with PROCESS
1076 will be bound to the value of the coding system used to decode
1079 This is useful when the coding system specified for the process buffer
1080 leaves either the character code conversion or the end-of-line conversion
1081 unspecified, or if the coding system used to decode the process output
1082 is more appropriate for saving the process buffer.
1084 Binding the variable `inherit-process-coding-system' to non-nil before
1085 starting the process is an alternative way of setting the inherit flag
1086 for the process which will run. */)
1088 register Lisp_Object process
, flag
;
1090 CHECK_PROCESS (process
);
1091 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
1095 DEFUN ("process-inherit-coding-system-flag",
1096 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1098 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1099 If this flag is t, `buffer-file-coding-system' of the buffer
1100 associated with PROCESS will inherit the coding system used to decode
1101 the process output. */)
1103 register Lisp_Object process
;
1105 CHECK_PROCESS (process
);
1106 return XPROCESS (process
)->inherit_coding_system_flag
;
1109 DEFUN ("set-process-query-on-exit-flag",
1110 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1112 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1113 If the second argument FLAG is non-nil, Emacs will query the user before
1114 exiting if PROCESS is running. */)
1116 register Lisp_Object process
, flag
;
1118 CHECK_PROCESS (process
);
1119 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
1123 DEFUN ("process-query-on-exit-flag",
1124 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1126 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1128 register Lisp_Object process
;
1130 CHECK_PROCESS (process
);
1131 return Fnull (XPROCESS (process
)->kill_without_query
);
1134 #ifdef DATAGRAM_SOCKETS
1135 Lisp_Object
Fprocess_datagram_address ();
1138 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1140 doc
: /* Return the contact info of PROCESS; t for a real child.
1141 For a net connection, the value depends on the optional KEY arg.
1142 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1143 if KEY is t, the complete contact information for the connection is
1144 returned, else the specific value for the keyword KEY is returned.
1145 See `make-network-process' for a list of keywords. */)
1147 register Lisp_Object process
, key
;
1149 Lisp_Object contact
;
1151 CHECK_PROCESS (process
);
1152 contact
= XPROCESS (process
)->childp
;
1154 #ifdef DATAGRAM_SOCKETS
1155 if (DATAGRAM_CONN_P (process
)
1156 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1157 contact
= Fplist_put (contact
, QCremote
,
1158 Fprocess_datagram_address (process
));
1161 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1164 return Fcons (Fplist_get (contact
, QChost
),
1165 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1166 return Fplist_get (contact
, key
);
1169 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1171 doc
: /* Return the plist of PROCESS. */)
1173 register Lisp_Object process
;
1175 CHECK_PROCESS (process
);
1176 return XPROCESS (process
)->plist
;
1179 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1181 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1183 register Lisp_Object process
, plist
;
1185 CHECK_PROCESS (process
);
1188 XPROCESS (process
)->plist
= plist
;
1192 #if 0 /* Turned off because we don't currently record this info
1193 in the process. Perhaps add it. */
1194 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1195 doc
: /* Return the connection type of PROCESS.
1196 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1197 a socket connection. */)
1199 Lisp_Object process
;
1201 return XPROCESS (process
)->type
;
1206 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1208 doc
: /* Convert network ADDRESS from internal format to a string.
1209 A 4 or 5 element vector represents an IPv4 address (with port number).
1210 An 8 or 9 element vector represents an IPv6 address (with port number).
1211 If optional second argument OMIT-PORT is non-nil, don't include a port
1212 number in the string, even when present in ADDRESS.
1213 Returns nil if format of ADDRESS is invalid. */)
1214 (address
, omit_port
)
1215 Lisp_Object address
, omit_port
;
1220 if (STRINGP (address
)) /* AF_LOCAL */
1223 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1225 register struct Lisp_Vector
*p
= XVECTOR (address
);
1226 Lisp_Object args
[6];
1229 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1231 args
[0] = build_string ("%d.%d.%d.%d");
1234 else if (p
->size
== 5)
1236 args
[0] = build_string ("%d.%d.%d.%d:%d");
1239 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1241 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1244 else if (p
->size
== 9)
1246 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1252 for (i
= 0; i
< nargs
; i
++)
1253 args
[i
+1] = p
->contents
[i
];
1254 return Fformat (nargs
+1, args
);
1257 if (CONSP (address
))
1259 Lisp_Object args
[2];
1260 args
[0] = build_string ("<Family %d>");
1261 args
[1] = Fcar (address
);
1262 return Fformat (2, args
);
1271 list_processes_1 (query_only
)
1272 Lisp_Object query_only
;
1274 register Lisp_Object tail
, tem
;
1275 Lisp_Object proc
, minspace
, tem1
;
1276 register struct Lisp_Process
*p
;
1278 int w_proc
, w_buffer
, w_tty
;
1279 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1281 w_proc
= 4; /* Proc */
1282 w_buffer
= 6; /* Buffer */
1283 w_tty
= 0; /* Omit if no ttys */
1285 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1289 proc
= Fcdr (Fcar (tail
));
1290 p
= XPROCESS (proc
);
1291 if (NILP (p
->childp
))
1293 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1295 if (STRINGP (p
->name
)
1296 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1298 if (!NILP (p
->buffer
))
1300 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1301 w_buffer
= 8; /* (Killed) */
1302 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1305 if (STRINGP (p
->tty_name
)
1306 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1310 XSETFASTINT (i_status
, w_proc
+ 1);
1311 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1314 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1315 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1318 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1321 XSETFASTINT (minspace
, 1);
1323 set_buffer_internal (XBUFFER (Vstandard_output
));
1324 current_buffer
->undo_list
= Qt
;
1326 current_buffer
->truncate_lines
= Qt
;
1328 write_string ("Proc", -1);
1329 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1330 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1333 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1335 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1336 write_string ("\n", -1);
1338 write_string ("----", -1);
1339 Findent_to (i_status
, minspace
); write_string ("------", -1);
1340 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1343 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1345 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1346 write_string ("\n", -1);
1348 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1352 proc
= Fcdr (Fcar (tail
));
1353 p
= XPROCESS (proc
);
1354 if (NILP (p
->childp
))
1356 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1359 Finsert (1, &p
->name
);
1360 Findent_to (i_status
, minspace
);
1362 if (!NILP (p
->raw_status_low
))
1365 if (CONSP (p
->status
))
1366 symbol
= XCAR (p
->status
);
1369 if (EQ (symbol
, Qsignal
))
1372 tem
= Fcar (Fcdr (p
->status
));
1374 if (XINT (tem
) < NSIG
)
1375 write_string (sys_errlist
[XINT (tem
)], -1);
1378 Fprinc (symbol
, Qnil
);
1380 else if (NETCONN1_P (p
))
1382 if (EQ (symbol
, Qexit
))
1383 write_string ("closed", -1);
1384 else if (EQ (p
->command
, Qt
))
1385 write_string ("stopped", -1);
1386 else if (EQ (symbol
, Qrun
))
1387 write_string ("open", -1);
1389 Fprinc (symbol
, Qnil
);
1392 Fprinc (symbol
, Qnil
);
1394 if (EQ (symbol
, Qexit
))
1397 tem
= Fcar (Fcdr (p
->status
));
1400 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1401 write_string (tembuf
, -1);
1405 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
1406 remove_process (proc
);
1408 Findent_to (i_buffer
, minspace
);
1409 if (NILP (p
->buffer
))
1410 insert_string ("(none)");
1411 else if (NILP (XBUFFER (p
->buffer
)->name
))
1412 insert_string ("(Killed)");
1414 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1418 Findent_to (i_tty
, minspace
);
1419 if (STRINGP (p
->tty_name
))
1420 Finsert (1, &p
->tty_name
);
1423 Findent_to (i_command
, minspace
);
1425 if (EQ (p
->status
, Qlisten
))
1427 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1428 if (INTEGERP (port
))
1429 port
= Fnumber_to_string (port
);
1431 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1432 sprintf (tembuf
, "(network %s server on %s)\n",
1433 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1434 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1435 insert_string (tembuf
);
1437 else if (NETCONN1_P (p
))
1439 /* For a local socket, there is no host name,
1440 so display service instead. */
1441 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1442 if (!STRINGP (host
))
1444 host
= Fplist_get (p
->childp
, QCservice
);
1445 if (INTEGERP (host
))
1446 host
= Fnumber_to_string (host
);
1449 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1450 sprintf (tembuf
, "(network %s connection to %s)\n",
1451 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1452 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1453 insert_string (tembuf
);
1465 insert_string (" ");
1467 insert_string ("\n");
1473 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1474 doc
: /* Display a list of all processes.
1475 If optional argument QUERY-ONLY is non-nil, only processes with
1476 the query-on-exit flag set will be listed.
1477 Any process listed as exited or signaled is actually eliminated
1478 after the listing is made. */)
1480 Lisp_Object query_only
;
1482 internal_with_output_to_temp_buffer ("*Process List*",
1483 list_processes_1
, query_only
);
1487 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1488 doc
: /* Return a list of all processes. */)
1491 return Fmapcar (Qcdr
, Vprocess_alist
);
1494 /* Starting asynchronous inferior processes. */
1496 static Lisp_Object
start_process_unwind ();
1498 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1499 doc
: /* Start a program in a subprocess. Return the process object for it.
1500 NAME is name for process. It is modified if necessary to make it unique.
1501 BUFFER is the buffer (or buffer name) to associate with the process.
1502 Process output goes at end of that buffer, unless you specify
1503 an output stream or filter function to handle the output.
1504 BUFFER may be also nil, meaning that this process is not associated
1506 PROGRAM is the program file name. It is searched for in PATH.
1507 Remaining arguments are strings to give program as arguments.
1509 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1512 register Lisp_Object
*args
;
1514 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1516 register unsigned char *new_argv
;
1519 register unsigned char **new_argv
;
1522 int count
= SPECPDL_INDEX ();
1526 buffer
= Fget_buffer_create (buffer
);
1528 /* Make sure that the child will be able to chdir to the current
1529 buffer's current directory, or its unhandled equivalent. We
1530 can't just have the child check for an error when it does the
1531 chdir, since it's in a vfork.
1533 We have to GCPRO around this because Fexpand_file_name and
1534 Funhandled_file_name_directory might call a file name handling
1535 function. The argument list is protected by the caller, so all
1536 we really have to worry about is buffer. */
1538 struct gcpro gcpro1
, gcpro2
;
1540 current_dir
= current_buffer
->directory
;
1542 GCPRO2 (buffer
, current_dir
);
1545 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1547 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1548 report_file_error ("Setting current directory",
1549 Fcons (current_buffer
->directory
, Qnil
));
1555 CHECK_STRING (name
);
1559 CHECK_STRING (program
);
1561 proc
= make_process (name
);
1562 /* If an error occurs and we can't start the process, we want to
1563 remove it from the process list. This means that each error
1564 check in create_process doesn't need to call remove_process
1565 itself; it's all taken care of here. */
1566 record_unwind_protect (start_process_unwind
, proc
);
1568 XPROCESS (proc
)->childp
= Qt
;
1569 XPROCESS (proc
)->plist
= Qnil
;
1570 XPROCESS (proc
)->buffer
= buffer
;
1571 XPROCESS (proc
)->sentinel
= Qnil
;
1572 XPROCESS (proc
)->filter
= Qnil
;
1573 XPROCESS (proc
)->filter_multibyte
1574 = buffer_defaults
.enable_multibyte_characters
;
1575 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1577 #ifdef ADAPTIVE_READ_BUFFERING
1578 XPROCESS (proc
)->adaptive_read_buffering
= Vprocess_adaptive_read_buffering
;
1581 /* Make the process marker point into the process buffer (if any). */
1583 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1584 BUF_ZV (XBUFFER (buffer
)),
1585 BUF_ZV_BYTE (XBUFFER (buffer
)));
1588 /* Decide coding systems for communicating with the process. Here
1589 we don't setup the structure coding_system nor pay attention to
1590 unibyte mode. They are done in create_process. */
1592 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1593 Lisp_Object coding_systems
= Qt
;
1594 Lisp_Object val
, *args2
;
1595 struct gcpro gcpro1
, gcpro2
;
1597 val
= Vcoding_system_for_read
;
1600 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1601 args2
[0] = Qstart_process
;
1602 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1603 GCPRO2 (proc
, current_dir
);
1604 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1606 if (CONSP (coding_systems
))
1607 val
= XCAR (coding_systems
);
1608 else if (CONSP (Vdefault_process_coding_system
))
1609 val
= XCAR (Vdefault_process_coding_system
);
1611 XPROCESS (proc
)->decode_coding_system
= val
;
1613 val
= Vcoding_system_for_write
;
1616 if (EQ (coding_systems
, Qt
))
1618 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1619 args2
[0] = Qstart_process
;
1620 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1621 GCPRO2 (proc
, current_dir
);
1622 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1625 if (CONSP (coding_systems
))
1626 val
= XCDR (coding_systems
);
1627 else if (CONSP (Vdefault_process_coding_system
))
1628 val
= XCDR (Vdefault_process_coding_system
);
1630 XPROCESS (proc
)->encode_coding_system
= val
;
1634 /* Make a one member argv with all args concatenated
1635 together separated by a blank. */
1636 len
= SBYTES (program
) + 2;
1637 for (i
= 3; i
< nargs
; i
++)
1641 len
+= SBYTES (tem
) + 1; /* count the blank */
1643 new_argv
= (unsigned char *) alloca (len
);
1644 strcpy (new_argv
, SDATA (program
));
1645 for (i
= 3; i
< nargs
; i
++)
1649 strcat (new_argv
, " ");
1650 strcat (new_argv
, SDATA (tem
));
1652 /* Need to add code here to check for program existence on VMS */
1655 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1657 /* If program file name is not absolute, search our path for it.
1658 Put the name we will really use in TEM. */
1659 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1660 && !(SCHARS (program
) > 1
1661 && IS_DEVICE_SEP (SREF (program
, 1))))
1663 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1666 GCPRO4 (name
, program
, buffer
, current_dir
);
1667 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1670 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1671 tem
= Fexpand_file_name (tem
, Qnil
);
1675 if (!NILP (Ffile_directory_p (program
)))
1676 error ("Specified program for new process is a directory");
1680 /* If program file name starts with /: for quoting a magic name,
1682 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1683 && SREF (tem
, 1) == ':')
1684 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1686 /* Encode the file name and put it in NEW_ARGV.
1687 That's where the child will use it to execute the program. */
1688 tem
= ENCODE_FILE (tem
);
1689 new_argv
[0] = SDATA (tem
);
1691 /* Here we encode arguments by the coding system used for sending
1692 data to the process. We don't support using different coding
1693 systems for encoding arguments and for encoding data sent to the
1696 for (i
= 3; i
< nargs
; i
++)
1700 if (STRING_MULTIBYTE (tem
))
1701 tem
= (code_convert_string_norecord
1702 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1703 new_argv
[i
- 2] = SDATA (tem
);
1705 new_argv
[i
- 2] = 0;
1706 #endif /* not VMS */
1708 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1709 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1710 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1711 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1713 XPROCESS (proc
)->inherit_coding_system_flag
1714 = (NILP (buffer
) || !inherit_process_coding_system
1717 create_process (proc
, (char **) new_argv
, current_dir
);
1719 return unbind_to (count
, proc
);
1722 /* This function is the unwind_protect form for Fstart_process. If
1723 PROC doesn't have its pid set, then we know someone has signaled
1724 an error and the process wasn't started successfully, so we should
1725 remove it from the process list. */
1727 start_process_unwind (proc
)
1730 if (!PROCESSP (proc
))
1733 /* Was PROC started successfully? */
1734 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1735 remove_process (proc
);
1741 create_process_1 (timer
)
1742 struct atimer
*timer
;
1744 /* Nothing to do. */
1748 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1751 /* Mimic blocking of signals on system V, which doesn't really have it. */
1753 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1754 int sigchld_deferred
;
1757 create_process_sigchld ()
1759 signal (SIGCHLD
, create_process_sigchld
);
1761 sigchld_deferred
= 1;
1767 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1769 create_process (process
, new_argv
, current_dir
)
1770 Lisp_Object process
;
1772 Lisp_Object current_dir
;
1774 int pid
, inchannel
, outchannel
;
1776 #ifdef POSIX_SIGNALS
1779 struct sigaction sigint_action
;
1780 struct sigaction sigquit_action
;
1782 struct sigaction sighup_action
;
1784 #else /* !POSIX_SIGNALS */
1787 SIGTYPE (*sigchld
)();
1790 #endif /* !POSIX_SIGNALS */
1791 /* Use volatile to protect variables from being clobbered by longjmp. */
1792 volatile int forkin
, forkout
;
1793 volatile int pty_flag
= 0;
1795 extern char **environ
;
1798 inchannel
= outchannel
= -1;
1801 if (!NILP (Vprocess_connection_type
))
1802 outchannel
= inchannel
= allocate_pty ();
1806 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1807 /* On most USG systems it does not work to open the pty's tty here,
1808 then close it and reopen it in the child. */
1810 /* Don't let this terminal become our controlling terminal
1811 (in case we don't have one). */
1812 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1814 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1817 report_file_error ("Opening pty", Qnil
);
1818 #if defined (RTU) || defined (UNIPLUS) || defined (DONT_REOPEN_PTY)
1819 /* In the case that vfork is defined as fork, the parent process
1820 (Emacs) may send some data before the child process completes
1821 tty options setup. So we setup tty before forking. */
1822 child_setup_tty (forkout
);
1823 #endif /* RTU or UNIPLUS or DONT_REOPEN_PTY */
1825 forkin
= forkout
= -1;
1826 #endif /* not USG, or USG_SUBTTY_WORKS */
1830 #endif /* HAVE_PTYS */
1833 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1834 report_file_error ("Opening socketpair", Qnil
);
1835 outchannel
= inchannel
= sv
[0];
1836 forkout
= forkin
= sv
[1];
1838 #else /* not SKTPAIR */
1843 report_file_error ("Creating pipe", Qnil
);
1849 emacs_close (inchannel
);
1850 emacs_close (forkout
);
1851 report_file_error ("Creating pipe", Qnil
);
1856 #endif /* not SKTPAIR */
1859 /* Replaced by close_process_descs */
1860 set_exclusive_use (inchannel
);
1861 set_exclusive_use (outchannel
);
1864 /* Stride people say it's a mystery why this is needed
1865 as well as the O_NDELAY, but that it fails without this. */
1866 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1869 ioctl (inchannel
, FIONBIO
, &one
);
1874 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1875 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1878 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1879 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1883 /* Record this as an active process, with its channels.
1884 As a result, child_setup will close Emacs's side of the pipes. */
1885 chan_process
[inchannel
] = process
;
1886 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1887 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1889 /* Previously we recorded the tty descriptor used in the subprocess.
1890 It was only used for getting the foreground tty process, so now
1891 we just reopen the device (see emacs_get_tty_pgrp) as this is
1892 more portable (see USG_SUBTTY_WORKS above). */
1894 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1895 XPROCESS (process
)->status
= Qrun
;
1896 setup_process_coding_systems (process
);
1898 /* Delay interrupts until we have a chance to store
1899 the new fork's pid in its process structure */
1900 #ifdef POSIX_SIGNALS
1901 sigemptyset (&blocked
);
1903 sigaddset (&blocked
, SIGCHLD
);
1905 #ifdef HAVE_WORKING_VFORK
1906 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1907 this sets the parent's signal handlers as well as the child's.
1908 So delay all interrupts whose handlers the child might munge,
1909 and record the current handlers so they can be restored later. */
1910 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1911 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1913 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1915 #endif /* HAVE_WORKING_VFORK */
1916 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1917 #else /* !POSIX_SIGNALS */
1921 #else /* not BSD4_1 */
1922 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1923 sigsetmask (sigmask (SIGCHLD
));
1924 #else /* ordinary USG */
1926 sigchld_deferred
= 0;
1927 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1929 #endif /* ordinary USG */
1930 #endif /* not BSD4_1 */
1931 #endif /* SIGCHLD */
1932 #endif /* !POSIX_SIGNALS */
1934 FD_SET (inchannel
, &input_wait_mask
);
1935 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1936 if (inchannel
> max_process_desc
)
1937 max_process_desc
= inchannel
;
1939 /* Until we store the proper pid, enable sigchld_handler
1940 to recognize an unknown pid as standing for this process.
1941 It is very important not to let this `marker' value stay
1942 in the table after this function has returned; if it does
1943 it might cause call-process to hang and subsequent asynchronous
1944 processes to get their return values scrambled. */
1945 XSETINT (XPROCESS (process
)->pid
, -1);
1950 /* child_setup must clobber environ on systems with true vfork.
1951 Protect it from permanent change. */
1952 char **save_environ
= environ
;
1954 current_dir
= ENCODE_FILE (current_dir
);
1959 #endif /* not WINDOWSNT */
1961 int xforkin
= forkin
;
1962 int xforkout
= forkout
;
1964 #if 0 /* This was probably a mistake--it duplicates code later on,
1965 but fails to handle all the cases. */
1966 /* Make sure SIGCHLD is not blocked in the child. */
1967 sigsetmask (SIGEMPTYMASK
);
1970 /* Make the pty be the controlling terminal of the process. */
1972 /* First, disconnect its current controlling terminal. */
1974 /* We tried doing setsid only if pty_flag, but it caused
1975 process_set_signal to fail on SGI when using a pipe. */
1977 /* Make the pty's terminal the controlling terminal. */
1981 /* We ignore the return value
1982 because faith@cs.unc.edu says that is necessary on Linux. */
1983 ioctl (xforkin
, TIOCSCTTY
, 0);
1986 #else /* not HAVE_SETSID */
1988 /* It's very important to call setpgrp here and no time
1989 afterwards. Otherwise, we lose our controlling tty which
1990 is set when we open the pty. */
1993 #endif /* not HAVE_SETSID */
1994 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1995 if (pty_flag
&& xforkin
>= 0)
1998 tcgetattr (xforkin
, &t
);
2000 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
2001 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
2004 #if defined (NTTYDISC) && defined (TIOCSETD)
2005 if (pty_flag
&& xforkin
>= 0)
2007 /* Use new line discipline. */
2008 int ldisc
= NTTYDISC
;
2009 ioctl (xforkin
, TIOCSETD
, &ldisc
);
2014 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2015 can do TIOCSPGRP only to the process's controlling tty. */
2018 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2019 I can't test it since I don't have 4.3. */
2020 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
2021 ioctl (j
, TIOCNOTTY
, 0);
2024 /* In order to get a controlling terminal on some versions
2025 of BSD, it is necessary to put the process in pgrp 0
2026 before it opens the terminal. */
2034 #endif /* TIOCNOTTY */
2036 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2037 /*** There is a suggestion that this ought to be a
2038 conditional on TIOCSPGRP,
2039 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2040 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2041 that system does seem to need this code, even though
2042 both HAVE_SETSID and TIOCSCTTY are defined. */
2043 /* Now close the pty (if we had it open) and reopen it.
2044 This makes the pty the controlling terminal of the subprocess. */
2047 #ifdef SET_CHILD_PTY_PGRP
2048 int pgrp
= getpid ();
2051 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2054 emacs_close (xforkin
);
2055 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2059 emacs_write (1, "Couldn't open the pty terminal ", 31);
2060 emacs_write (1, pty_name
, strlen (pty_name
));
2061 emacs_write (1, "\n", 1);
2065 #ifdef SET_CHILD_PTY_PGRP
2066 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
2067 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
2070 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
2072 #ifdef SETUP_SLAVE_PTY
2077 #endif /* SETUP_SLAVE_PTY */
2079 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2080 Now reenable it in the child, so it will die when we want it to. */
2082 signal (SIGHUP
, SIG_DFL
);
2084 #endif /* HAVE_PTYS */
2086 signal (SIGINT
, SIG_DFL
);
2087 signal (SIGQUIT
, SIG_DFL
);
2089 /* Stop blocking signals in the child. */
2090 #ifdef POSIX_SIGNALS
2091 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2092 #else /* !POSIX_SIGNALS */
2096 #else /* not BSD4_1 */
2097 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2098 sigsetmask (SIGEMPTYMASK
);
2099 #else /* ordinary USG */
2101 signal (SIGCHLD
, sigchld
);
2103 #endif /* ordinary USG */
2104 #endif /* not BSD4_1 */
2105 #endif /* SIGCHLD */
2106 #endif /* !POSIX_SIGNALS */
2108 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2110 child_setup_tty (xforkout
);
2111 #endif /* not RTU and not UNIPLUS and not DONT_REOPEN_PTY */
2113 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2114 new_argv
, 1, current_dir
);
2115 #else /* not WINDOWSNT */
2116 child_setup (xforkin
, xforkout
, xforkout
,
2117 new_argv
, 1, current_dir
);
2118 #endif /* not WINDOWSNT */
2120 environ
= save_environ
;
2125 /* This runs in the Emacs process. */
2129 emacs_close (forkin
);
2130 if (forkin
!= forkout
&& forkout
>= 0)
2131 emacs_close (forkout
);
2135 /* vfork succeeded. */
2136 XSETFASTINT (XPROCESS (process
)->pid
, pid
);
2139 register_child (pid
, inchannel
);
2140 #endif /* WINDOWSNT */
2142 /* If the subfork execv fails, and it exits,
2143 this close hangs. I don't know why.
2144 So have an interrupt jar it loose. */
2146 struct atimer
*timer
;
2150 EMACS_SET_SECS_USECS (offset
, 1, 0);
2151 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2154 emacs_close (forkin
);
2156 cancel_atimer (timer
);
2160 if (forkin
!= forkout
&& forkout
>= 0)
2161 emacs_close (forkout
);
2165 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2168 XPROCESS (process
)->tty_name
= Qnil
;
2171 /* Restore the signal state whether vfork succeeded or not.
2172 (We will signal an error, below, if it failed.) */
2173 #ifdef POSIX_SIGNALS
2174 #ifdef HAVE_WORKING_VFORK
2175 /* Restore the parent's signal handlers. */
2176 sigaction (SIGINT
, &sigint_action
, 0);
2177 sigaction (SIGQUIT
, &sigquit_action
, 0);
2179 sigaction (SIGHUP
, &sighup_action
, 0);
2181 #endif /* HAVE_WORKING_VFORK */
2182 /* Stop blocking signals in the parent. */
2183 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2184 #else /* !POSIX_SIGNALS */
2188 #else /* not BSD4_1 */
2189 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2190 sigsetmask (SIGEMPTYMASK
);
2191 #else /* ordinary USG */
2193 signal (SIGCHLD
, sigchld
);
2194 /* Now really handle any of these signals
2195 that came in during this function. */
2196 if (sigchld_deferred
)
2197 kill (getpid (), SIGCHLD
);
2199 #endif /* ordinary USG */
2200 #endif /* not BSD4_1 */
2201 #endif /* SIGCHLD */
2202 #endif /* !POSIX_SIGNALS */
2204 /* Now generate the error if vfork failed. */
2206 report_file_error ("Doing vfork", Qnil
);
2208 #endif /* not VMS */
2213 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2214 The address family of sa is not included in the result. */
2217 conv_sockaddr_to_lisp (sa
, len
)
2218 struct sockaddr
*sa
;
2221 Lisp_Object address
;
2224 register struct Lisp_Vector
*p
;
2226 switch (sa
->sa_family
)
2230 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2231 len
= sizeof (sin
->sin_addr
) + 1;
2232 address
= Fmake_vector (make_number (len
), Qnil
);
2233 p
= XVECTOR (address
);
2234 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2235 cp
= (unsigned char *)&sin
->sin_addr
;
2241 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2242 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2243 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2244 address
= Fmake_vector (make_number (len
), Qnil
);
2245 p
= XVECTOR (address
);
2246 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2247 for (i
= 0; i
< len
; i
++)
2248 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2252 #ifdef HAVE_LOCAL_SOCKETS
2255 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2256 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2257 if (sockun
->sun_path
[i
] == 0)
2259 return make_unibyte_string (sockun
->sun_path
, i
);
2263 len
-= sizeof (sa
->sa_family
);
2264 address
= Fcons (make_number (sa
->sa_family
),
2265 Fmake_vector (make_number (len
), Qnil
));
2266 p
= XVECTOR (XCDR (address
));
2267 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2273 p
->contents
[i
++] = make_number (*cp
++);
2279 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2282 get_lisp_to_sockaddr_size (address
, familyp
)
2283 Lisp_Object address
;
2286 register struct Lisp_Vector
*p
;
2288 if (VECTORP (address
))
2290 p
= XVECTOR (address
);
2294 return sizeof (struct sockaddr_in
);
2297 else if (p
->size
== 9)
2299 *familyp
= AF_INET6
;
2300 return sizeof (struct sockaddr_in6
);
2304 #ifdef HAVE_LOCAL_SOCKETS
2305 else if (STRINGP (address
))
2307 *familyp
= AF_LOCAL
;
2308 return sizeof (struct sockaddr_un
);
2311 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2313 struct sockaddr
*sa
;
2314 *familyp
= XINT (XCAR (address
));
2315 p
= XVECTOR (XCDR (address
));
2316 return p
->size
+ sizeof (sa
->sa_family
);
2321 /* Convert an address object (vector or string) to an internal sockaddr.
2322 Format of address has already been validated by size_lisp_to_sockaddr. */
2325 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2327 Lisp_Object address
;
2328 struct sockaddr
*sa
;
2331 register struct Lisp_Vector
*p
;
2332 register unsigned char *cp
= NULL
;
2336 sa
->sa_family
= family
;
2338 if (VECTORP (address
))
2340 p
= XVECTOR (address
);
2341 if (family
== AF_INET
)
2343 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2344 len
= sizeof (sin
->sin_addr
) + 1;
2345 i
= XINT (p
->contents
[--len
]);
2346 sin
->sin_port
= htons (i
);
2347 cp
= (unsigned char *)&sin
->sin_addr
;
2350 else if (family
== AF_INET6
)
2352 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2353 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2354 len
= sizeof (sin6
->sin6_addr
) + 1;
2355 i
= XINT (p
->contents
[--len
]);
2356 sin6
->sin6_port
= htons (i
);
2357 for (i
= 0; i
< len
; i
++)
2358 if (INTEGERP (p
->contents
[i
]))
2360 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2367 else if (STRINGP (address
))
2369 #ifdef HAVE_LOCAL_SOCKETS
2370 if (family
== AF_LOCAL
)
2372 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2373 cp
= SDATA (address
);
2374 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2375 sockun
->sun_path
[i
] = *cp
++;
2382 p
= XVECTOR (XCDR (address
));
2383 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2386 for (i
= 0; i
< len
; i
++)
2387 if (INTEGERP (p
->contents
[i
]))
2388 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2391 #ifdef DATAGRAM_SOCKETS
2392 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2394 doc
: /* Get the current datagram address associated with PROCESS. */)
2396 Lisp_Object process
;
2400 CHECK_PROCESS (process
);
2402 if (!DATAGRAM_CONN_P (process
))
2405 channel
= XINT (XPROCESS (process
)->infd
);
2406 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2407 datagram_address
[channel
].len
);
2410 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2412 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2413 Returns nil upon error setting address, ADDRESS otherwise. */)
2415 Lisp_Object process
, address
;
2420 CHECK_PROCESS (process
);
2422 if (!DATAGRAM_CONN_P (process
))
2425 channel
= XINT (XPROCESS (process
)->infd
);
2427 len
= get_lisp_to_sockaddr_size (address
, &family
);
2428 if (datagram_address
[channel
].len
!= len
)
2430 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2436 static struct socket_options
{
2437 /* The name of this option. Should be lowercase version of option
2438 name without SO_ prefix. */
2440 /* Option level SOL_... */
2442 /* Option number SO_... */
2444 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2445 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2446 } socket_options
[] =
2448 #ifdef SO_BINDTODEVICE
2449 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2452 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2455 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2458 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2461 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2464 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2467 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2470 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2472 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2475 /* Set option OPT to value VAL on socket S.
2477 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2478 Signals an error if setting a known option fails.
2482 set_socket_option (s
, opt
, val
)
2484 Lisp_Object opt
, val
;
2487 struct socket_options
*sopt
;
2492 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2493 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2494 if (strcmp (name
, sopt
->name
) == 0)
2497 switch (sopt
->opttype
)
2502 optval
= NILP (val
) ? 0 : 1;
2503 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2504 &optval
, sizeof (optval
));
2512 optval
= XINT (val
);
2514 error ("Bad option value for %s", name
);
2515 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2516 &optval
, sizeof (optval
));
2520 #ifdef SO_BINDTODEVICE
2523 char devname
[IFNAMSIZ
+1];
2525 /* This is broken, at least in the Linux 2.4 kernel.
2526 To unbind, the arg must be a zero integer, not the empty string.
2527 This should work on all systems. KFS. 2003-09-23. */
2528 bzero (devname
, sizeof devname
);
2531 char *arg
= (char *) SDATA (val
);
2532 int len
= min (strlen (arg
), IFNAMSIZ
);
2533 bcopy (arg
, devname
, len
);
2535 else if (!NILP (val
))
2536 error ("Bad option value for %s", name
);
2537 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2546 struct linger linger
;
2549 linger
.l_linger
= 0;
2551 linger
.l_linger
= XINT (val
);
2553 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2554 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2555 &linger
, sizeof (linger
));
2565 report_file_error ("Cannot set network option",
2566 Fcons (opt
, Fcons (val
, Qnil
)));
2567 return (1 << sopt
->optbit
);
2571 DEFUN ("set-network-process-option",
2572 Fset_network_process_option
, Sset_network_process_option
,
2574 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2575 See `make-network-process' for a list of options and values.
2576 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2577 OPTION is not a supported option, return nil instead; otherwise return t. */)
2578 (process
, option
, value
, no_error
)
2579 Lisp_Object process
, option
, value
;
2580 Lisp_Object no_error
;
2583 struct Lisp_Process
*p
;
2585 CHECK_PROCESS (process
);
2586 p
= XPROCESS (process
);
2587 if (!NETCONN1_P (p
))
2588 error ("Process is not a network process");
2592 error ("Process is not running");
2594 if (set_socket_option (s
, option
, value
))
2596 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2600 if (NILP (no_error
))
2601 error ("Unknown or unsupported option");
2607 /* A version of request_sigio suitable for a record_unwind_protect. */
2610 unwind_request_sigio (dummy
)
2613 if (interrupt_input
)
2618 /* Create a network stream/datagram client/server process. Treated
2619 exactly like a normal process when reading and writing. Primary
2620 differences are in status display and process deletion. A network
2621 connection has no PID; you cannot signal it. All you can do is
2622 stop/continue it and deactivate/close it via delete-process */
2624 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2626 doc
: /* Create and return a network server or client process.
2628 In Emacs, network connections are represented by process objects, so
2629 input and output work as for subprocesses and `delete-process' closes
2630 a network connection. However, a network process has no process id,
2631 it cannot be signaled, and the status codes are different from normal
2634 Arguments are specified as keyword/argument pairs. The following
2635 arguments are defined:
2637 :name NAME -- NAME is name for process. It is modified if necessary
2640 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2641 with the process. Process output goes at end of that buffer, unless
2642 you specify an output stream or filter function to handle the output.
2643 BUFFER may be also nil, meaning that this process is not associated
2646 :host HOST -- HOST is name of the host to connect to, or its IP
2647 address. The symbol `local' specifies the local host. If specified
2648 for a server process, it must be a valid name or address for the local
2649 host, and only clients connecting to that address will be accepted.
2651 :service SERVICE -- SERVICE is name of the service desired, or an
2652 integer specifying a port number to connect to. If SERVICE is t,
2653 a random port number is selected for the server.
2655 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2656 stream type connection, `datagram' creates a datagram type connection.
2658 :family FAMILY -- FAMILY is the address (and protocol) family for the
2659 service specified by HOST and SERVICE. The default (nil) is to use
2660 whatever address family (IPv4 or IPv6) that is defined for the host
2661 and port number specified by HOST and SERVICE. Other address families
2663 local -- for a local (i.e. UNIX) address specified by SERVICE.
2664 ipv4 -- use IPv4 address family only.
2665 ipv6 -- use IPv6 address family only.
2667 :local ADDRESS -- ADDRESS is the local address used for the connection.
2668 This parameter is ignored when opening a client process. When specified
2669 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2671 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2672 connection. This parameter is ignored when opening a stream server
2673 process. For a datagram server process, it specifies the initial
2674 setting of the remote datagram address. When specified for a client
2675 process, the FAMILY, HOST, and SERVICE args are ignored.
2677 The format of ADDRESS depends on the address family:
2678 - An IPv4 address is represented as an vector of integers [A B C D P]
2679 corresponding to numeric IP address A.B.C.D and port number P.
2680 - A local address is represented as a string with the address in the
2681 local address space.
2682 - An "unsupported family" address is represented by a cons (F . AV)
2683 where F is the family number and AV is a vector containing the socket
2684 address data with one element per address data byte. Do not rely on
2685 this format in portable code, as it may depend on implementation
2686 defined constants, data sizes, and data structure alignment.
2688 :coding CODING -- If CODING is a symbol, it specifies the coding
2689 system used for both reading and writing for this process. If CODING
2690 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2691 ENCODING is used for writing.
2693 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2694 return without waiting for the connection to complete; instead, the
2695 sentinel function will be called with second arg matching "open" (if
2696 successful) or "failed" when the connect completes. Default is to use
2697 a blocking connect (i.e. wait) for stream type connections.
2699 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2700 running when Emacs is exited.
2702 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2703 In the stopped state, a server process does not accept new
2704 connections, and a client process does not handle incoming traffic.
2705 The stopped state is cleared by `continue-process' and set by
2708 :filter FILTER -- Install FILTER as the process filter.
2710 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2711 process filter are multibyte, otherwise they are unibyte.
2712 If this keyword is not specified, the strings are multibyte iff
2713 `default-enable-multibyte-characters' is non-nil.
2715 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2717 :log LOG -- Install LOG as the server process log function. This
2718 function is called when the server accepts a network connection from a
2719 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2720 is the server process, CLIENT is the new process for the connection,
2721 and MESSAGE is a string.
2723 :plist PLIST -- Install PLIST as the new process' initial plist.
2725 :server QLEN -- if QLEN is non-nil, create a server process for the
2726 specified FAMILY, SERVICE, and connection type (stream or datagram).
2727 If QLEN is an integer, it is used as the max. length of the server's
2728 pending connection queue (also known as the backlog); the default
2729 queue length is 5. Default is to create a client process.
2731 The following network options can be specified for this connection:
2733 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2734 :dontroute BOOL -- Only send to directly connected hosts.
2735 :keepalive BOOL -- Send keep-alive messages on network stream.
2736 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2737 :oobinline BOOL -- Place out-of-band data in receive data stream.
2738 :priority INT -- Set protocol defined priority for sent packets.
2739 :reuseaddr BOOL -- Allow reusing a recently used local address
2740 (this is allowed by default for a server process).
2741 :bindtodevice NAME -- bind to interface NAME. Using this may require
2742 special privileges on some systems.
2744 Consult the relevant system programmer's manual pages for more
2745 information on using these options.
2748 A server process will listen for and accept connections from clients.
2749 When a client connection is accepted, a new network process is created
2750 for the connection with the following parameters:
2752 - The client's process name is constructed by concatenating the server
2753 process' NAME and a client identification string.
2754 - If the FILTER argument is non-nil, the client process will not get a
2755 separate process buffer; otherwise, the client's process buffer is a newly
2756 created buffer named after the server process' BUFFER name or process
2757 NAME concatenated with the client identification string.
2758 - The connection type and the process filter and sentinel parameters are
2759 inherited from the server process' TYPE, FILTER and SENTINEL.
2760 - The client process' contact info is set according to the client's
2761 addressing information (typically an IP address and a port number).
2762 - The client process' plist is initialized from the server's plist.
2764 Notice that the FILTER and SENTINEL args are never used directly by
2765 the server process. Also, the BUFFER argument is not used directly by
2766 the server process, but via the optional :log function, accepted (and
2767 failed) connections may be logged in the server process' buffer.
2769 The original argument list, modified with the actual connection
2770 information, is available via the `process-contact' function.
2772 usage: (make-network-process &rest ARGS) */)
2778 Lisp_Object contact
;
2779 struct Lisp_Process
*p
;
2780 #ifdef HAVE_GETADDRINFO
2781 struct addrinfo ai
, *res
, *lres
;
2782 struct addrinfo hints
;
2783 char *portstring
, portbuf
[128];
2784 #else /* HAVE_GETADDRINFO */
2785 struct _emacs_addrinfo
2791 struct sockaddr
*ai_addr
;
2792 struct _emacs_addrinfo
*ai_next
;
2794 #endif /* HAVE_GETADDRINFO */
2795 struct sockaddr_in address_in
;
2796 #ifdef HAVE_LOCAL_SOCKETS
2797 struct sockaddr_un address_un
;
2802 int s
= -1, outch
, inch
;
2803 struct gcpro gcpro1
;
2804 int count
= SPECPDL_INDEX ();
2806 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2808 Lisp_Object name
, buffer
, host
, service
, address
;
2809 Lisp_Object filter
, sentinel
;
2810 int is_non_blocking_client
= 0;
2811 int is_server
= 0, backlog
= 5;
2818 /* Save arguments for process-contact and clone-process. */
2819 contact
= Flist (nargs
, args
);
2823 /* Ensure socket support is loaded if available. */
2824 init_winsock (TRUE
);
2827 /* :type TYPE (nil: stream, datagram */
2828 tem
= Fplist_get (contact
, QCtype
);
2830 socktype
= SOCK_STREAM
;
2831 #ifdef DATAGRAM_SOCKETS
2832 else if (EQ (tem
, Qdatagram
))
2833 socktype
= SOCK_DGRAM
;
2836 error ("Unsupported connection type");
2839 tem
= Fplist_get (contact
, QCserver
);
2842 /* Don't support network sockets when non-blocking mode is
2843 not available, since a blocked Emacs is not useful. */
2844 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2845 error ("Network servers not supported");
2849 backlog
= XINT (tem
);
2853 /* Make QCaddress an alias for :local (server) or :remote (client). */
2854 QCaddress
= is_server
? QClocal
: QCremote
;
2857 if (!is_server
&& socktype
== SOCK_STREAM
2858 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2860 #ifndef NON_BLOCKING_CONNECT
2861 error ("Non-blocking connect not supported");
2863 is_non_blocking_client
= 1;
2867 name
= Fplist_get (contact
, QCname
);
2868 buffer
= Fplist_get (contact
, QCbuffer
);
2869 filter
= Fplist_get (contact
, QCfilter
);
2870 sentinel
= Fplist_get (contact
, QCsentinel
);
2872 CHECK_STRING (name
);
2875 /* Let's handle TERM before things get complicated ... */
2876 host
= Fplist_get (contact
, QChost
);
2877 CHECK_STRING (host
);
2879 service
= Fplist_get (contact
, QCservice
);
2880 if (INTEGERP (service
))
2881 port
= htons ((unsigned short) XINT (service
));
2884 struct servent
*svc_info
;
2885 CHECK_STRING (service
);
2886 svc_info
= getservbyname (SDATA (service
), "tcp");
2888 error ("Unknown service: %s", SDATA (service
));
2889 port
= svc_info
->s_port
;
2892 s
= connect_server (0);
2894 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2895 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2896 send_command (s
, C_DUMB
, 1, 0);
2898 #else /* not TERM */
2900 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2901 ai
.ai_socktype
= socktype
;
2906 /* :local ADDRESS or :remote ADDRESS */
2907 address
= Fplist_get (contact
, QCaddress
);
2908 if (!NILP (address
))
2910 host
= service
= Qnil
;
2912 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2913 error ("Malformed :address");
2914 ai
.ai_family
= family
;
2915 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2916 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2920 /* :family FAMILY -- nil (for Inet), local, or integer. */
2921 tem
= Fplist_get (contact
, QCfamily
);
2924 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
2930 #ifdef HAVE_LOCAL_SOCKETS
2931 else if (EQ (tem
, Qlocal
))
2935 else if (EQ (tem
, Qipv6
))
2938 else if (EQ (tem
, Qipv4
))
2940 else if (INTEGERP (tem
))
2941 family
= XINT (tem
);
2943 error ("Unknown address family");
2945 ai
.ai_family
= family
;
2947 /* :service SERVICE -- string, integer (port number), or t (random port). */
2948 service
= Fplist_get (contact
, QCservice
);
2950 #ifdef HAVE_LOCAL_SOCKETS
2951 if (family
== AF_LOCAL
)
2953 /* Host is not used. */
2955 CHECK_STRING (service
);
2956 bzero (&address_un
, sizeof address_un
);
2957 address_un
.sun_family
= AF_LOCAL
;
2958 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
2959 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
2960 ai
.ai_addrlen
= sizeof address_un
;
2965 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2966 host
= Fplist_get (contact
, QChost
);
2969 if (EQ (host
, Qlocal
))
2970 host
= build_string ("localhost");
2971 CHECK_STRING (host
);
2974 /* Slow down polling to every ten seconds.
2975 Some kernels have a bug which causes retrying connect to fail
2976 after a connect. Polling can interfere with gethostbyname too. */
2977 #ifdef POLL_FOR_INPUT
2978 if (socktype
== SOCK_STREAM
)
2980 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
2981 bind_polling_period (10);
2985 #ifdef HAVE_GETADDRINFO
2986 /* If we have a host, use getaddrinfo to resolve both host and service.
2987 Otherwise, use getservbyname to lookup the service. */
2991 /* SERVICE can either be a string or int.
2992 Convert to a C string for later use by getaddrinfo. */
2993 if (EQ (service
, Qt
))
2995 else if (INTEGERP (service
))
2997 sprintf (portbuf
, "%ld", (long) XINT (service
));
2998 portstring
= portbuf
;
3002 CHECK_STRING (service
);
3003 portstring
= SDATA (service
);
3008 memset (&hints
, 0, sizeof (hints
));
3010 hints
.ai_family
= family
;
3011 hints
.ai_socktype
= socktype
;
3012 hints
.ai_protocol
= 0;
3013 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3015 #ifdef HAVE_GAI_STRERROR
3016 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
3018 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3024 #endif /* HAVE_GETADDRINFO */
3026 /* We end up here if getaddrinfo is not defined, or in case no hostname
3027 has been specified (e.g. for a local server process). */
3029 if (EQ (service
, Qt
))
3031 else if (INTEGERP (service
))
3032 port
= htons ((unsigned short) XINT (service
));
3035 struct servent
*svc_info
;
3036 CHECK_STRING (service
);
3037 svc_info
= getservbyname (SDATA (service
),
3038 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3040 error ("Unknown service: %s", SDATA (service
));
3041 port
= svc_info
->s_port
;
3044 bzero (&address_in
, sizeof address_in
);
3045 address_in
.sin_family
= family
;
3046 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3047 address_in
.sin_port
= port
;
3049 #ifndef HAVE_GETADDRINFO
3052 struct hostent
*host_info_ptr
;
3054 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3055 as it may `hang' Emacs for a very long time. */
3058 host_info_ptr
= gethostbyname (SDATA (host
));
3063 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
3064 host_info_ptr
->h_length
);
3065 family
= host_info_ptr
->h_addrtype
;
3066 address_in
.sin_family
= family
;
3069 /* Attempt to interpret host as numeric inet address */
3071 IN_ADDR numeric_addr
;
3072 numeric_addr
= inet_addr ((char *) SDATA (host
));
3073 if (NUMERIC_ADDR_ERROR
)
3074 error ("Unknown host \"%s\"", SDATA (host
));
3076 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
3077 sizeof (address_in
.sin_addr
));
3081 #endif /* not HAVE_GETADDRINFO */
3083 ai
.ai_family
= family
;
3084 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3085 ai
.ai_addrlen
= sizeof address_in
;
3089 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
3090 when connect is interrupted. So let's not let it get interrupted.
3091 Note we do not turn off polling, because polling is only used
3092 when not interrupt_input, and thus not normally used on the systems
3093 which have this bug. On systems which use polling, there's no way
3094 to quit if polling is turned off. */
3096 && !is_server
&& socktype
== SOCK_STREAM
)
3098 /* Comment from KFS: The original open-network-stream code
3099 didn't unwind protect this, but it seems like the proper
3100 thing to do. In any case, I don't see how it could harm to
3101 do this -- and it makes cleanup (using unbind_to) easier. */
3102 record_unwind_protect (unwind_request_sigio
, Qnil
);
3106 /* Do this in case we never enter the for-loop below. */
3107 count1
= SPECPDL_INDEX ();
3110 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3116 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3123 #ifdef DATAGRAM_SOCKETS
3124 if (!is_server
&& socktype
== SOCK_DGRAM
)
3126 #endif /* DATAGRAM_SOCKETS */
3128 #ifdef NON_BLOCKING_CONNECT
3129 if (is_non_blocking_client
)
3132 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3134 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3146 /* Make us close S if quit. */
3147 record_unwind_protect (close_file_unwind
, make_number (s
));
3149 /* Parse network options in the arg list.
3150 We simply ignore anything which isn't a known option (including other keywords).
3151 An error is signalled if setting a known option fails. */
3152 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3153 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3157 /* Configure as a server socket. */
3159 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3160 explicit :reuseaddr key to override this. */
3161 #ifdef HAVE_LOCAL_SOCKETS
3162 if (family
!= AF_LOCAL
)
3164 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3167 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3168 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3171 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3172 report_file_error ("Cannot bind server socket", Qnil
);
3174 #ifdef HAVE_GETSOCKNAME
3175 if (EQ (service
, Qt
))
3177 struct sockaddr_in sa1
;
3178 int len1
= sizeof (sa1
);
3179 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3181 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3182 service
= make_number (ntohs (sa1
.sin_port
));
3183 contact
= Fplist_put (contact
, QCservice
, service
);
3188 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3189 report_file_error ("Cannot listen on server socket", Qnil
);
3197 /* This turns off all alarm-based interrupts; the
3198 bind_polling_period call above doesn't always turn all the
3199 short-interval ones off, especially if interrupt_input is
3202 It'd be nice to be able to control the connect timeout
3203 though. Would non-blocking connect calls be portable?
3205 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3207 turn_on_atimers (0);
3209 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3212 turn_on_atimers (1);
3214 if (ret
== 0 || xerrno
== EISCONN
)
3216 /* The unwind-protect will be discarded afterwards.
3217 Likewise for immediate_quit. */
3221 #ifdef NON_BLOCKING_CONNECT
3223 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3227 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3235 /* Discard the unwind protect closing S. */
3236 specpdl_ptr
= specpdl
+ count1
;
3240 if (xerrno
== EINTR
)
3246 #ifdef DATAGRAM_SOCKETS
3247 if (socktype
== SOCK_DGRAM
)
3249 if (datagram_address
[s
].sa
)
3251 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3252 datagram_address
[s
].len
= lres
->ai_addrlen
;
3256 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3257 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3260 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3261 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3262 conv_lisp_to_sockaddr (rfamily
, remote
,
3263 datagram_address
[s
].sa
, rlen
);
3267 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3270 contact
= Fplist_put (contact
, QCaddress
,
3271 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3272 #ifdef HAVE_GETSOCKNAME
3275 struct sockaddr_in sa1
;
3276 int len1
= sizeof (sa1
);
3277 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3278 contact
= Fplist_put (contact
, QClocal
,
3279 conv_sockaddr_to_lisp (&sa1
, len1
));
3284 #ifdef HAVE_GETADDRINFO
3291 /* Discard the unwind protect for closing S, if any. */
3292 specpdl_ptr
= specpdl
+ count1
;
3294 /* Unwind bind_polling_period and request_sigio. */
3295 unbind_to (count
, Qnil
);
3299 /* If non-blocking got this far - and failed - assume non-blocking is
3300 not supported after all. This is probably a wrong assumption, but
3301 the normal blocking calls to open-network-stream handles this error
3303 if (is_non_blocking_client
)
3308 report_file_error ("make server process failed", contact
);
3310 report_file_error ("make client process failed", contact
);
3313 #endif /* not TERM */
3319 buffer
= Fget_buffer_create (buffer
);
3320 proc
= make_process (name
);
3322 chan_process
[inch
] = proc
;
3325 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3328 fcntl (inch
, F_SETFL
, O_NDELAY
);
3332 p
= XPROCESS (proc
);
3334 p
->childp
= contact
;
3335 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3338 p
->sentinel
= sentinel
;
3340 p
->filter_multibyte
= buffer_defaults
.enable_multibyte_characters
;
3341 /* Override the above only if :filter-multibyte is specified. */
3342 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3343 p
->filter_multibyte
= Fplist_get (contact
, QCfilter_multibyte
);
3344 p
->log
= Fplist_get (contact
, QClog
);
3345 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3346 p
->kill_without_query
= Qt
;
3347 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3350 XSETINT (p
->infd
, inch
);
3351 XSETINT (p
->outfd
, outch
);
3352 if (is_server
&& socktype
== SOCK_STREAM
)
3353 p
->status
= Qlisten
;
3355 #ifdef NON_BLOCKING_CONNECT
3356 if (is_non_blocking_client
)
3358 /* We may get here if connect did succeed immediately. However,
3359 in that case, we still need to signal this like a non-blocking
3361 p
->status
= Qconnect
;
3362 if (!FD_ISSET (inch
, &connect_wait_mask
))
3364 FD_SET (inch
, &connect_wait_mask
);
3365 num_pending_connects
++;
3370 /* A server may have a client filter setting of Qt, but it must
3371 still listen for incoming connects unless it is stopped. */
3372 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3373 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3375 FD_SET (inch
, &input_wait_mask
);
3376 FD_SET (inch
, &non_keyboard_wait_mask
);
3379 if (inch
> max_process_desc
)
3380 max_process_desc
= inch
;
3382 tem
= Fplist_member (contact
, QCcoding
);
3383 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3384 tem
= Qnil
; /* No error message (too late!). */
3387 /* Setup coding systems for communicating with the network stream. */
3388 struct gcpro gcpro1
;
3389 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3390 Lisp_Object coding_systems
= Qt
;
3391 Lisp_Object args
[5], val
;
3395 val
= XCAR (XCDR (tem
));
3399 else if (!NILP (Vcoding_system_for_read
))
3400 val
= Vcoding_system_for_read
;
3401 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3402 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3403 /* We dare not decode end-of-line format by setting VAL to
3404 Qraw_text, because the existing Emacs Lisp libraries
3405 assume that they receive bare code including a sequene of
3410 if (NILP (host
) || NILP (service
))
3411 coding_systems
= Qnil
;
3414 args
[0] = Qopen_network_stream
, args
[1] = name
,
3415 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3417 coding_systems
= Ffind_operation_coding_system (5, args
);
3420 if (CONSP (coding_systems
))
3421 val
= XCAR (coding_systems
);
3422 else if (CONSP (Vdefault_process_coding_system
))
3423 val
= XCAR (Vdefault_process_coding_system
);
3427 p
->decode_coding_system
= val
;
3431 val
= XCAR (XCDR (tem
));
3435 else if (!NILP (Vcoding_system_for_write
))
3436 val
= Vcoding_system_for_write
;
3437 else if (NILP (current_buffer
->enable_multibyte_characters
))
3441 if (EQ (coding_systems
, Qt
))
3443 if (NILP (host
) || NILP (service
))
3444 coding_systems
= Qnil
;
3447 args
[0] = Qopen_network_stream
, args
[1] = name
,
3448 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3450 coding_systems
= Ffind_operation_coding_system (5, args
);
3454 if (CONSP (coding_systems
))
3455 val
= XCDR (coding_systems
);
3456 else if (CONSP (Vdefault_process_coding_system
))
3457 val
= XCDR (Vdefault_process_coding_system
);
3461 p
->encode_coding_system
= val
;
3463 setup_process_coding_systems (proc
);
3465 p
->decoding_buf
= make_uninit_string (0);
3466 p
->decoding_carryover
= make_number (0);
3467 p
->encoding_buf
= make_uninit_string (0);
3468 p
->encoding_carryover
= make_number (0);
3470 p
->inherit_coding_system_flag
3471 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3477 #endif /* HAVE_SOCKETS */
3480 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3483 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3484 doc
: /* Return an alist of all network interfaces and their network address.
3485 Each element is a cons, the car of which is a string containing the
3486 interface name, and the cdr is the network address in internal
3487 format; see the description of ADDRESS in `make-network-process'. */)
3490 struct ifconf ifconf
;
3491 struct ifreq
*ifreqs
= NULL
;
3496 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3502 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3503 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3510 ifconf
.ifc_len
= buf_size
;
3511 ifconf
.ifc_req
= ifreqs
;
3512 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3518 if (ifconf
.ifc_len
== buf_size
)
3522 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3525 while (--ifaces
>= 0)
3527 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3528 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3529 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3531 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3532 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3533 res
= Fcons (Fcons (build_string (namebuf
),
3534 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3535 sizeof (struct sockaddr
))),
3541 #endif /* SIOCGIFCONF */
3543 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3550 static struct ifflag_def ifflag_table
[] = {
3554 #ifdef IFF_BROADCAST
3555 { IFF_BROADCAST
, "broadcast" },
3558 { IFF_DEBUG
, "debug" },
3561 { IFF_LOOPBACK
, "loopback" },
3563 #ifdef IFF_POINTOPOINT
3564 { IFF_POINTOPOINT
, "pointopoint" },
3567 { IFF_RUNNING
, "running" },
3570 { IFF_NOARP
, "noarp" },
3573 { IFF_PROMISC
, "promisc" },
3575 #ifdef IFF_NOTRAILERS
3576 { IFF_NOTRAILERS
, "notrailers" },
3579 { IFF_ALLMULTI
, "allmulti" },
3582 { IFF_MASTER
, "master" },
3585 { IFF_SLAVE
, "slave" },
3587 #ifdef IFF_MULTICAST
3588 { IFF_MULTICAST
, "multicast" },
3591 { IFF_PORTSEL
, "portsel" },
3593 #ifdef IFF_AUTOMEDIA
3594 { IFF_AUTOMEDIA
, "automedia" },
3597 { IFF_DYNAMIC
, "dynamic" },
3600 { IFF_OACTIV
, "oactiv" }, /* OpenBSD: transmission in progress */
3603 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3606 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3609 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3612 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3617 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3618 doc
: /* Return information about network interface named IFNAME.
3619 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3620 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3621 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3622 FLAGS is the current flags of the interface. */)
3627 Lisp_Object res
= Qnil
;
3632 CHECK_STRING (ifname
);
3634 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3635 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3637 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3642 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3643 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3645 int flags
= rq
.ifr_flags
;
3646 struct ifflag_def
*fp
;
3650 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3652 if (flags
& fp
->flag_bit
)
3654 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3655 flags
-= fp
->flag_bit
;
3658 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3660 if (flags
& (1 << fnum
))
3662 elt
= Fcons (make_number (fnum
), elt
);
3667 res
= Fcons (elt
, res
);
3670 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3671 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3673 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3674 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3678 for (n
= 0; n
< 6; n
++)
3679 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3680 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3683 res
= Fcons (elt
, res
);
3686 #if defined(SIOCGIFNETMASK) && defined(ifr_netmask)
3687 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3690 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3693 res
= Fcons (elt
, res
);
3696 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3697 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3700 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3703 res
= Fcons (elt
, res
);
3706 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3707 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3710 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3713 res
= Fcons (elt
, res
);
3717 return any
? res
: Qnil
;
3720 #endif /* HAVE_SOCKETS */
3722 /* Turn off input and output for process PROC. */
3725 deactivate_process (proc
)
3728 register int inchannel
, outchannel
;
3729 register struct Lisp_Process
*p
= XPROCESS (proc
);
3731 inchannel
= XINT (p
->infd
);
3732 outchannel
= XINT (p
->outfd
);
3734 #ifdef ADAPTIVE_READ_BUFFERING
3735 if (XINT (p
->read_output_delay
) > 0)
3737 if (--process_output_delay_count
< 0)
3738 process_output_delay_count
= 0;
3739 XSETINT (p
->read_output_delay
, 0);
3740 p
->read_output_skip
= Qnil
;
3746 /* Beware SIGCHLD hereabouts. */
3747 flush_pending_output (inchannel
);
3750 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3751 sys$
dassgn (outchannel
);
3752 vs
= get_vms_process_pointer (p
->pid
);
3754 give_back_vms_process_stuff (vs
);
3757 emacs_close (inchannel
);
3758 if (outchannel
>= 0 && outchannel
!= inchannel
)
3759 emacs_close (outchannel
);
3762 XSETINT (p
->infd
, -1);
3763 XSETINT (p
->outfd
, -1);
3764 #ifdef DATAGRAM_SOCKETS
3765 if (DATAGRAM_CHAN_P (inchannel
))
3767 xfree (datagram_address
[inchannel
].sa
);
3768 datagram_address
[inchannel
].sa
= 0;
3769 datagram_address
[inchannel
].len
= 0;
3772 chan_process
[inchannel
] = Qnil
;
3773 FD_CLR (inchannel
, &input_wait_mask
);
3774 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3775 #ifdef NON_BLOCKING_CONNECT
3776 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3778 FD_CLR (inchannel
, &connect_wait_mask
);
3779 if (--num_pending_connects
< 0)
3783 if (inchannel
== max_process_desc
)
3786 /* We just closed the highest-numbered process input descriptor,
3787 so recompute the highest-numbered one now. */
3788 max_process_desc
= 0;
3789 for (i
= 0; i
< MAXDESC
; i
++)
3790 if (!NILP (chan_process
[i
]))
3791 max_process_desc
= i
;
3796 /* Close all descriptors currently in use for communication
3797 with subprocess. This is used in a newly-forked subprocess
3798 to get rid of irrelevant descriptors. */
3801 close_process_descs ()
3805 for (i
= 0; i
< MAXDESC
; i
++)
3807 Lisp_Object process
;
3808 process
= chan_process
[i
];
3809 if (!NILP (process
))
3811 int in
= XINT (XPROCESS (process
)->infd
);
3812 int out
= XINT (XPROCESS (process
)->outfd
);
3815 if (out
>= 0 && in
!= out
)
3822 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3824 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3825 It is read into the process' buffers or given to their filter functions.
3826 Non-nil arg PROCESS means do not return until some output has been received
3828 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of
3829 seconds and microseconds to wait; return after that much time whether
3830 or not there is input.
3831 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3832 from PROCESS, suspending reading output from other processes.
3833 If JUST-THIS-ONE is an integer, don't run any timers either.
3834 Return non-nil iff we received any output before the timeout expired. */)
3835 (process
, timeout
, timeout_msecs
, just_this_one
)
3836 register Lisp_Object process
, timeout
, timeout_msecs
, just_this_one
;
3841 if (! NILP (process
))
3842 CHECK_PROCESS (process
);
3844 just_this_one
= Qnil
;
3846 if (! NILP (timeout_msecs
))
3848 CHECK_NUMBER (timeout_msecs
);
3849 useconds
= XINT (timeout_msecs
);
3850 if (!INTEGERP (timeout
))
3851 XSETINT (timeout
, 0);
3854 int carry
= useconds
/ 1000000;
3856 XSETINT (timeout
, XINT (timeout
) + carry
);
3857 useconds
-= carry
* 1000000;
3859 /* I think this clause is necessary because C doesn't
3860 guarantee a particular rounding direction for negative
3864 XSETINT (timeout
, XINT (timeout
) - 1);
3865 useconds
+= 1000000;
3872 if (! NILP (timeout
))
3874 CHECK_NUMBER (timeout
);
3875 seconds
= XINT (timeout
);
3876 if (seconds
< 0 || (seconds
== 0 && useconds
== 0))
3880 seconds
= NILP (process
) ? -1 : 0;
3883 (wait_reading_process_output (seconds
, useconds
, 0, 0,
3885 !NILP (process
) ? XPROCESS (process
) : NULL
,
3886 NILP (just_this_one
) ? 0 :
3887 !INTEGERP (just_this_one
) ? 1 : -1)
3891 /* Accept a connection for server process SERVER on CHANNEL. */
3893 static int connect_counter
= 0;
3896 server_accept_connection (server
, channel
)
3900 Lisp_Object proc
, caller
, name
, buffer
;
3901 Lisp_Object contact
, host
, service
;
3902 struct Lisp_Process
*ps
= XPROCESS (server
);
3903 struct Lisp_Process
*p
;
3907 struct sockaddr_in in
;
3909 struct sockaddr_in6 in6
;
3911 #ifdef HAVE_LOCAL_SOCKETS
3912 struct sockaddr_un un
;
3915 int len
= sizeof saddr
;
3917 s
= accept (channel
, &saddr
.sa
, &len
);
3926 if (code
== EWOULDBLOCK
)
3930 if (!NILP (ps
->log
))
3931 call3 (ps
->log
, server
, Qnil
,
3932 concat3 (build_string ("accept failed with code"),
3933 Fnumber_to_string (make_number (code
)),
3934 build_string ("\n")));
3940 /* Setup a new process to handle the connection. */
3942 /* Generate a unique identification of the caller, and build contact
3943 information for this process. */
3946 switch (saddr
.sa
.sa_family
)
3950 Lisp_Object args
[5];
3951 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
3952 args
[0] = build_string ("%d.%d.%d.%d");
3953 args
[1] = make_number (*ip
++);
3954 args
[2] = make_number (*ip
++);
3955 args
[3] = make_number (*ip
++);
3956 args
[4] = make_number (*ip
++);
3957 host
= Fformat (5, args
);
3958 service
= make_number (ntohs (saddr
.in
.sin_port
));
3960 args
[0] = build_string (" <%s:%d>");
3963 caller
= Fformat (3, args
);
3970 Lisp_Object args
[9];
3971 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
3973 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
3974 for (i
= 0; i
< 8; i
++)
3975 args
[i
+1] = make_number (ntohs(ip6
[i
]));
3976 host
= Fformat (9, args
);
3977 service
= make_number (ntohs (saddr
.in
.sin_port
));
3979 args
[0] = build_string (" <[%s]:%d>");
3982 caller
= Fformat (3, args
);
3987 #ifdef HAVE_LOCAL_SOCKETS
3991 caller
= Fnumber_to_string (make_number (connect_counter
));
3992 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
3996 /* Create a new buffer name for this process if it doesn't have a
3997 filter. The new buffer name is based on the buffer name or
3998 process name of the server process concatenated with the caller
4001 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4005 buffer
= ps
->buffer
;
4007 buffer
= Fbuffer_name (buffer
);
4012 buffer
= concat2 (buffer
, caller
);
4013 buffer
= Fget_buffer_create (buffer
);
4017 /* Generate a unique name for the new server process. Combine the
4018 server process name with the caller identification. */
4020 name
= concat2 (ps
->name
, caller
);
4021 proc
= make_process (name
);
4023 chan_process
[s
] = proc
;
4026 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4029 fcntl (s
, F_SETFL
, O_NDELAY
);
4033 p
= XPROCESS (proc
);
4035 /* Build new contact information for this setup. */
4036 contact
= Fcopy_sequence (ps
->childp
);
4037 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4038 contact
= Fplist_put (contact
, QChost
, host
);
4039 if (!NILP (service
))
4040 contact
= Fplist_put (contact
, QCservice
, service
);
4041 contact
= Fplist_put (contact
, QCremote
,
4042 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4043 #ifdef HAVE_GETSOCKNAME
4045 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4046 contact
= Fplist_put (contact
, QClocal
,
4047 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4050 p
->childp
= contact
;
4051 p
->plist
= Fcopy_sequence (ps
->plist
);
4054 p
->sentinel
= ps
->sentinel
;
4055 p
->filter
= ps
->filter
;
4058 XSETINT (p
->infd
, s
);
4059 XSETINT (p
->outfd
, s
);
4062 /* Client processes for accepted connections are not stopped initially. */
4063 if (!EQ (p
->filter
, Qt
))
4065 FD_SET (s
, &input_wait_mask
);
4066 FD_SET (s
, &non_keyboard_wait_mask
);
4069 if (s
> max_process_desc
)
4070 max_process_desc
= s
;
4072 /* Setup coding system for new process based on server process.
4073 This seems to be the proper thing to do, as the coding system
4074 of the new process should reflect the settings at the time the
4075 server socket was opened; not the current settings. */
4077 p
->decode_coding_system
= ps
->decode_coding_system
;
4078 p
->encode_coding_system
= ps
->encode_coding_system
;
4079 setup_process_coding_systems (proc
);
4081 p
->decoding_buf
= make_uninit_string (0);
4082 p
->decoding_carryover
= make_number (0);
4083 p
->encoding_buf
= make_uninit_string (0);
4084 p
->encoding_carryover
= make_number (0);
4086 p
->inherit_coding_system_flag
4087 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
4089 if (!NILP (ps
->log
))
4090 call3 (ps
->log
, server
, proc
,
4091 concat3 (build_string ("accept from "),
4092 (STRINGP (host
) ? host
: build_string ("-")),
4093 build_string ("\n")));
4095 if (!NILP (p
->sentinel
))
4096 exec_sentinel (proc
,
4097 concat3 (build_string ("open from "),
4098 (STRINGP (host
) ? host
: build_string ("-")),
4099 build_string ("\n")));
4102 /* This variable is different from waiting_for_input in keyboard.c.
4103 It is used to communicate to a lisp process-filter/sentinel (via the
4104 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4105 for user-input when that process-filter was called.
4106 waiting_for_input cannot be used as that is by definition 0 when
4107 lisp code is being evalled.
4108 This is also used in record_asynch_buffer_change.
4109 For that purpose, this must be 0
4110 when not inside wait_reading_process_output. */
4111 static int waiting_for_user_input_p
;
4113 /* This is here so breakpoints can be put on it. */
4115 wait_reading_process_output_1 ()
4119 /* Read and dispose of subprocess output while waiting for timeout to
4120 elapse and/or keyboard input to be available.
4123 timeout in seconds, or
4124 zero for no limit, or
4125 -1 means gobble data immediately available but don't wait for any.
4128 an additional duration to wait, measured in microseconds.
4129 If this is nonzero and time_limit is 0, then the timeout
4130 consists of MICROSECS only.
4132 READ_KBD is a lisp value:
4133 0 to ignore keyboard input, or
4134 1 to return when input is available, or
4135 -1 meaning caller will actually read the input, so don't throw to
4136 the quit handler, or
4138 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4139 output that arrives.
4141 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4142 (and gobble terminal input into the buffer if any arrives).
4144 If WAIT_PROC is specified, wait until something arrives from that
4145 process. The return value is true iff we read some input from
4148 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4149 (suspending output from other processes). A negative value
4150 means don't run any timers either.
4152 If WAIT_PROC is specified, then the function returns true iff we
4153 received input from that process before the timeout elapsed.
4154 Otherwise, return true iff we received input from any process. */
4157 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
4158 wait_for_cell
, wait_proc
, just_wait_proc
)
4159 int time_limit
, microsecs
, read_kbd
, do_display
;
4160 Lisp_Object wait_for_cell
;
4161 struct Lisp_Process
*wait_proc
;
4164 register int channel
, nfds
;
4165 SELECT_TYPE Available
;
4166 #ifdef NON_BLOCKING_CONNECT
4167 SELECT_TYPE Connecting
;
4170 int check_delay
, no_avail
;
4173 EMACS_TIME timeout
, end_time
;
4174 int wait_channel
= -1;
4175 int got_some_input
= 0;
4176 /* Either nil or a cons cell, the car of which is of interest and
4177 may be changed outside of this routine. */
4178 int saved_waiting_for_user_input_p
= waiting_for_user_input_p
;
4180 FD_ZERO (&Available
);
4181 #ifdef NON_BLOCKING_CONNECT
4182 FD_ZERO (&Connecting
);
4185 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4186 if (wait_proc
!= NULL
)
4187 wait_channel
= XINT (wait_proc
->infd
);
4189 waiting_for_user_input_p
= read_kbd
;
4191 /* Since we may need to wait several times,
4192 compute the absolute time to return at. */
4193 if (time_limit
|| microsecs
)
4195 EMACS_GET_TIME (end_time
);
4196 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4197 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4199 #ifdef POLL_INTERRUPTED_SYS_CALL
4200 /* AlainF 5-Jul-1996
4201 HP-UX 10.10 seem to have problems with signals coming in
4202 Causes "poll: interrupted system call" messages when Emacs is run
4204 Turn off periodic alarms (in case they are in use),
4205 and then turn off any other atimers. */
4207 turn_on_atimers (0);
4208 #endif /* POLL_INTERRUPTED_SYS_CALL */
4212 int timeout_reduced_for_timers
= 0;
4214 /* If calling from keyboard input, do not quit
4215 since we want to return C-g as an input character.
4216 Otherwise, do pending quit if requested. */
4220 else if (interrupt_input_pending
)
4221 handle_async_input ();
4224 /* Exit now if the cell we're waiting for became non-nil. */
4225 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4228 /* Compute time from now till when time limit is up */
4229 /* Exit if already run out */
4230 if (time_limit
== -1)
4232 /* -1 specified for timeout means
4233 gobble output available now
4234 but don't wait at all. */
4236 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4238 else if (time_limit
|| microsecs
)
4240 EMACS_GET_TIME (timeout
);
4241 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4242 if (EMACS_TIME_NEG_P (timeout
))
4247 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4250 /* Normally we run timers here.
4251 But not if wait_for_cell; in those cases,
4252 the wait is supposed to be short,
4253 and those callers cannot handle running arbitrary Lisp code here. */
4254 if (NILP (wait_for_cell
)
4255 && just_wait_proc
>= 0)
4257 EMACS_TIME timer_delay
;
4261 int old_timers_run
= timers_run
;
4262 struct buffer
*old_buffer
= current_buffer
;
4264 timer_delay
= timer_check (1);
4266 /* If a timer has run, this might have changed buffers
4267 an alike. Make read_key_sequence aware of that. */
4268 if (timers_run
!= old_timers_run
4269 && old_buffer
!= current_buffer
4270 && waiting_for_user_input_p
== -1)
4271 record_asynch_buffer_change ();
4273 if (timers_run
!= old_timers_run
&& do_display
)
4274 /* We must retry, since a timer may have requeued itself
4275 and that could alter the time_delay. */
4276 redisplay_preserve_echo_area (9);
4280 while (!detect_input_pending ());
4282 /* If there is unread keyboard input, also return. */
4284 && requeued_events_pending_p ())
4287 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4289 EMACS_TIME difference
;
4290 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4291 if (EMACS_TIME_NEG_P (difference
))
4293 timeout
= timer_delay
;
4294 timeout_reduced_for_timers
= 1;
4297 /* If time_limit is -1, we are not going to wait at all. */
4298 else if (time_limit
!= -1)
4300 /* This is so a breakpoint can be put here. */
4301 wait_reading_process_output_1 ();
4305 /* Cause C-g and alarm signals to take immediate action,
4306 and cause input available signals to zero out timeout.
4308 It is important that we do this before checking for process
4309 activity. If we get a SIGCHLD after the explicit checks for
4310 process activity, timeout is the only way we will know. */
4312 set_waiting_for_input (&timeout
);
4314 /* If status of something has changed, and no input is
4315 available, notify the user of the change right away. After
4316 this explicit check, we'll let the SIGCHLD handler zap
4317 timeout to get our attention. */
4318 if (update_tick
!= process_tick
&& do_display
)
4321 #ifdef NON_BLOCKING_CONNECT
4325 Atemp
= input_wait_mask
;
4327 /* On Mac OS X 10.0, the SELECT system call always says input is
4328 present (for reading) at stdin, even when none is. This
4329 causes the call to SELECT below to return 1 and
4330 status_notify not to be called. As a result output of
4331 subprocesses are incorrectly discarded.
4335 IF_NON_BLOCKING_CONNECT (Ctemp
= connect_wait_mask
);
4337 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4338 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
4340 #ifdef NON_BLOCKING_CONNECT
4341 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4345 (SELECT_TYPE
*)0, &timeout
)
4348 /* It's okay for us to do this and then continue with
4349 the loop, since timeout has already been zeroed out. */
4350 clear_waiting_for_input ();
4351 status_notify (NULL
);
4355 /* Don't wait for output from a non-running process. Just
4356 read whatever data has already been received. */
4357 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
4358 update_status (wait_proc
);
4360 && ! EQ (wait_proc
->status
, Qrun
)
4361 && ! EQ (wait_proc
->status
, Qconnect
))
4363 int nread
, total_nread
= 0;
4365 clear_waiting_for_input ();
4366 XSETPROCESS (proc
, wait_proc
);
4368 /* Read data from the process, until we exhaust it. */
4369 while (XINT (wait_proc
->infd
) >= 0)
4371 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
4377 total_nread
+= nread
;
4379 else if (nread
== -1 && EIO
== errno
)
4383 else if (nread
== -1 && EAGAIN
== errno
)
4387 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4391 if (total_nread
> 0 && do_display
)
4392 redisplay_preserve_echo_area (10);
4397 /* Wait till there is something to do */
4399 if (wait_proc
&& just_wait_proc
)
4401 if (XINT (wait_proc
->infd
) < 0) /* Terminated */
4403 FD_SET (XINT (wait_proc
->infd
), &Available
);
4405 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4407 else if (!NILP (wait_for_cell
))
4409 Available
= non_process_wait_mask
;
4411 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4416 Available
= non_keyboard_wait_mask
;
4418 Available
= input_wait_mask
;
4419 IF_NON_BLOCKING_CONNECT (check_connect
= (num_pending_connects
> 0));
4420 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4423 /* If frame size has changed or the window is newly mapped,
4424 redisplay now, before we start to wait. There is a race
4425 condition here; if a SIGIO arrives between now and the select
4426 and indicates that a frame is trashed, the select may block
4427 displaying a trashed screen. */
4428 if (frame_garbaged
&& do_display
)
4430 clear_waiting_for_input ();
4431 redisplay_preserve_echo_area (11);
4433 set_waiting_for_input (&timeout
);
4437 if (read_kbd
&& detect_input_pending ())
4444 #ifdef NON_BLOCKING_CONNECT
4446 Connecting
= connect_wait_mask
;
4449 #ifdef ADAPTIVE_READ_BUFFERING
4450 /* Set the timeout for adaptive read buffering if any
4451 process has non-nil read_output_skip and non-zero
4452 read_output_delay, and we are not reading output for a
4453 specific wait_channel. It is not executed if
4454 Vprocess_adaptive_read_buffering is nil. */
4455 if (process_output_skip
&& check_delay
> 0)
4457 int usecs
= EMACS_USECS (timeout
);
4458 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4459 usecs
= READ_OUTPUT_DELAY_MAX
;
4460 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4462 proc
= chan_process
[channel
];
4465 /* Find minimum non-zero read_output_delay among the
4466 processes with non-nil read_output_skip. */
4467 if (XINT (XPROCESS (proc
)->read_output_delay
) > 0)
4470 if (NILP (XPROCESS (proc
)->read_output_skip
))
4472 FD_CLR (channel
, &Available
);
4473 XPROCESS (proc
)->read_output_skip
= Qnil
;
4474 if (XINT (XPROCESS (proc
)->read_output_delay
) < usecs
)
4475 usecs
= XINT (XPROCESS (proc
)->read_output_delay
);
4478 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4479 process_output_skip
= 0;
4483 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4485 #ifdef NON_BLOCKING_CONNECT
4486 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4490 (SELECT_TYPE
*)0, &timeout
);
4495 /* Make C-g and alarm signals set flags again */
4496 clear_waiting_for_input ();
4498 /* If we woke up due to SIGWINCH, actually change size now. */
4499 do_pending_window_change (0);
4501 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4502 /* We wanted the full specified time, so return now. */
4506 if (xerrno
== EINTR
)
4509 /* Ultrix select seems to return ENOMEM when it is
4510 interrupted. Treat it just like EINTR. Bleah. Note
4511 that we want to test for the "ultrix" CPP symbol, not
4512 "__ultrix__"; the latter is only defined under GCC, but
4513 not by DEC's bundled CC. -JimB */
4514 else if (xerrno
== ENOMEM
)
4518 /* This happens for no known reason on ALLIANT.
4519 I am guessing that this is the right response. -- RMS. */
4520 else if (xerrno
== EFAULT
)
4523 else if (xerrno
== EBADF
)
4526 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4527 the child's closure of the pts gives the parent a SIGHUP, and
4528 the ptc file descriptor is automatically closed,
4529 yielding EBADF here or at select() call above.
4530 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4531 in m/ibmrt-aix.h), and here we just ignore the select error.
4532 Cleanup occurs c/o status_notify after SIGCLD. */
4533 no_avail
= 1; /* Cannot depend on values returned */
4539 error ("select error: %s", emacs_strerror (xerrno
));
4544 FD_ZERO (&Available
);
4545 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4548 #if defined(sun) && !defined(USG5_4)
4549 if (nfds
> 0 && keyboard_bit_set (&Available
)
4551 /* System sometimes fails to deliver SIGIO.
4553 David J. Mackenzie says that Emacs doesn't compile under
4554 Solaris if this code is enabled, thus the USG5_4 in the CPP
4555 conditional. "I haven't noticed any ill effects so far.
4556 If you find a Solaris expert somewhere, they might know
4558 kill (getpid (), SIGIO
);
4561 #if 0 /* When polling is used, interrupt_input is 0,
4562 so get_input_pending should read the input.
4563 So this should not be needed. */
4564 /* If we are using polling for input,
4565 and we see input available, make it get read now.
4566 Otherwise it might not actually get read for a second.
4567 And on hpux, since we turn off polling in wait_reading_process_output,
4568 it might never get read at all if we don't spend much time
4569 outside of wait_reading_process_output. */
4570 if (read_kbd
&& interrupt_input
4571 && keyboard_bit_set (&Available
)
4572 && input_polling_used ())
4573 kill (getpid (), SIGALRM
);
4576 /* Check for keyboard input */
4577 /* If there is any, return immediately
4578 to give it higher priority than subprocesses */
4582 int old_timers_run
= timers_run
;
4583 struct buffer
*old_buffer
= current_buffer
;
4586 if (detect_input_pending_run_timers (do_display
))
4588 swallow_events (do_display
);
4589 if (detect_input_pending_run_timers (do_display
))
4593 /* If a timer has run, this might have changed buffers
4594 an alike. Make read_key_sequence aware of that. */
4595 if (timers_run
!= old_timers_run
4596 && waiting_for_user_input_p
== -1
4597 && old_buffer
!= current_buffer
)
4598 record_asynch_buffer_change ();
4604 /* If there is unread keyboard input, also return. */
4606 && requeued_events_pending_p ())
4609 /* If we are not checking for keyboard input now,
4610 do process events (but don't run any timers).
4611 This is so that X events will be processed.
4612 Otherwise they may have to wait until polling takes place.
4613 That would causes delays in pasting selections, for example.
4615 (We used to do this only if wait_for_cell.) */
4616 if (read_kbd
== 0 && detect_input_pending ())
4618 swallow_events (do_display
);
4619 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4620 if (detect_input_pending ())
4625 /* Exit now if the cell we're waiting for became non-nil. */
4626 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4630 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4631 go read it. This can happen with X on BSD after logging out.
4632 In that case, there really is no input and no SIGIO,
4633 but select says there is input. */
4635 if (read_kbd
&& interrupt_input
4636 && keyboard_bit_set (&Available
) && ! noninteractive
)
4637 kill (getpid (), SIGIO
);
4641 got_some_input
|= nfds
> 0;
4643 /* If checking input just got us a size-change event from X,
4644 obey it now if we should. */
4645 if (read_kbd
|| ! NILP (wait_for_cell
))
4646 do_pending_window_change (0);
4648 /* Check for data from a process. */
4649 if (no_avail
|| nfds
== 0)
4652 /* Really FIRST_PROC_DESC should be 0 on Unix,
4653 but this is safer in the short run. */
4654 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4656 if (FD_ISSET (channel
, &Available
)
4657 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4661 /* If waiting for this channel, arrange to return as
4662 soon as no more input to be processed. No more
4664 if (wait_channel
== channel
)
4670 proc
= chan_process
[channel
];
4674 /* If this is a server stream socket, accept connection. */
4675 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4677 server_accept_connection (proc
, channel
);
4681 /* Read data from the process, starting with our
4682 buffered-ahead character if we have one. */
4684 nread
= read_process_output (proc
, channel
);
4687 /* Since read_process_output can run a filter,
4688 which can call accept-process-output,
4689 don't try to read from any other processes
4690 before doing the select again. */
4691 FD_ZERO (&Available
);
4694 redisplay_preserve_echo_area (12);
4697 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4700 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4701 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4703 else if (nread
== -1 && errno
== EAGAIN
)
4707 else if (nread
== -1 && errno
== EAGAIN
)
4709 /* Note that we cannot distinguish between no input
4710 available now and a closed pipe.
4711 With luck, a closed pipe will be accompanied by
4712 subprocess termination and SIGCHLD. */
4713 else if (nread
== 0 && !NETCONN_P (proc
))
4715 #endif /* O_NDELAY */
4716 #endif /* O_NONBLOCK */
4718 /* On some OSs with ptys, when the process on one end of
4719 a pty exits, the other end gets an error reading with
4720 errno = EIO instead of getting an EOF (0 bytes read).
4721 Therefore, if we get an error reading and errno =
4722 EIO, just continue, because the child process has
4723 exited and should clean itself up soon (e.g. when we
4726 However, it has been known to happen that the SIGCHLD
4727 got lost. So raise the signl again just in case.
4729 else if (nread
== -1 && errno
== EIO
)
4730 kill (getpid (), SIGCHLD
);
4731 #endif /* HAVE_PTYS */
4732 /* If we can detect process termination, don't consider the process
4733 gone just because its pipe is closed. */
4735 else if (nread
== 0 && !NETCONN_P (proc
))
4740 /* Preserve status of processes already terminated. */
4741 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4742 deactivate_process (proc
);
4743 if (!NILP (XPROCESS (proc
)->raw_status_low
))
4744 update_status (XPROCESS (proc
));
4745 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4746 XPROCESS (proc
)->status
4747 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4750 #ifdef NON_BLOCKING_CONNECT
4751 if (check_connect
&& FD_ISSET (channel
, &Connecting
)
4752 && FD_ISSET (channel
, &connect_wait_mask
))
4754 struct Lisp_Process
*p
;
4756 FD_CLR (channel
, &connect_wait_mask
);
4757 if (--num_pending_connects
< 0)
4760 proc
= chan_process
[channel
];
4764 p
= XPROCESS (proc
);
4767 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4768 So only use it on systems where it is known to work. */
4770 int xlen
= sizeof(xerrno
);
4771 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4776 struct sockaddr pname
;
4777 int pnamelen
= sizeof(pname
);
4779 /* If connection failed, getpeername will fail. */
4781 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4783 /* Obtain connect failure code through error slippage. */
4786 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4793 XSETINT (p
->tick
, ++process_tick
);
4794 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4795 deactivate_process (proc
);
4800 /* Execute the sentinel here. If we had relied on
4801 status_notify to do it later, it will read input
4802 from the process before calling the sentinel. */
4803 exec_sentinel (proc
, build_string ("open\n"));
4804 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4806 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4807 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4811 #endif /* NON_BLOCKING_CONNECT */
4812 } /* end for each file descriptor */
4813 } /* end while exit conditions not met */
4815 waiting_for_user_input_p
= saved_waiting_for_user_input_p
;
4817 /* If calling from keyboard input, do not quit
4818 since we want to return C-g as an input character.
4819 Otherwise, do pending quit if requested. */
4822 /* Prevent input_pending from remaining set if we quit. */
4823 clear_input_pending ();
4826 #ifdef POLL_INTERRUPTED_SYS_CALL
4827 /* AlainF 5-Jul-1996
4828 HP-UX 10.10 seems to have problems with signals coming in
4829 Causes "poll: interrupted system call" messages when Emacs is run
4831 Turn periodic alarms back on */
4833 #endif /* POLL_INTERRUPTED_SYS_CALL */
4835 return got_some_input
;
4838 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4841 read_process_output_call (fun_and_args
)
4842 Lisp_Object fun_and_args
;
4844 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4848 read_process_output_error_handler (error
)
4851 cmd_error_internal (error
, "error in process filter: ");
4853 update_echo_area ();
4854 Fsleep_for (make_number (2), Qnil
);
4858 /* Read pending output from the process channel,
4859 starting with our buffered-ahead character if we have one.
4860 Yield number of decoded characters read.
4862 This function reads at most 4096 characters.
4863 If you want to read all available subprocess output,
4864 you must call it repeatedly until it returns zero.
4866 The characters read are decoded according to PROC's coding-system
4870 read_process_output (proc
, channel
)
4872 register int channel
;
4874 register int nbytes
;
4876 register Lisp_Object outstream
;
4877 register struct buffer
*old
= current_buffer
;
4878 register struct Lisp_Process
*p
= XPROCESS (proc
);
4879 register int opoint
;
4880 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4881 int carryover
= XINT (p
->decoding_carryover
);
4885 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4887 vs
= get_vms_process_pointer (p
->pid
);
4891 return (0); /* Really weird if it does this */
4892 if (!(vs
->iosb
[0] & 1))
4893 return -1; /* I/O error */
4896 error ("Could not get VMS process pointer");
4897 chars
= vs
->inputBuffer
;
4898 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4901 start_vms_process_read (vs
); /* Crank up the next read on the process */
4902 return 1; /* Nothing worth printing, say we got 1 */
4906 /* The data carried over in the previous decoding (which are at
4907 the tail of decoding buffer) should be prepended to the new
4908 data read to decode all together. */
4909 chars
= (char *) alloca (nbytes
+ carryover
);
4910 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4911 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4915 chars
= (char *) alloca (carryover
+ readmax
);
4917 /* See the comment above. */
4918 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
4920 #ifdef DATAGRAM_SOCKETS
4921 /* We have a working select, so proc_buffered_char is always -1. */
4922 if (DATAGRAM_CHAN_P (channel
))
4924 int len
= datagram_address
[channel
].len
;
4925 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
4926 0, datagram_address
[channel
].sa
, &len
);
4930 if (proc_buffered_char
[channel
] < 0)
4932 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
4933 #ifdef ADAPTIVE_READ_BUFFERING
4934 if (nbytes
> 0 && !NILP (p
->adaptive_read_buffering
))
4936 int delay
= XINT (p
->read_output_delay
);
4939 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
4942 process_output_delay_count
++;
4943 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
4946 else if (delay
> 0 && (nbytes
== readmax
))
4948 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
4950 process_output_delay_count
--;
4952 XSETINT (p
->read_output_delay
, delay
);
4955 p
->read_output_skip
= Qt
;
4956 process_output_skip
= 1;
4963 chars
[carryover
] = proc_buffered_char
[channel
];
4964 proc_buffered_char
[channel
] = -1;
4965 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
4969 nbytes
= nbytes
+ 1;
4971 #endif /* not VMS */
4973 XSETINT (p
->decoding_carryover
, 0);
4975 /* At this point, NBYTES holds number of bytes just received
4976 (including the one in proc_buffered_char[channel]). */
4979 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
4981 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4984 /* Now set NBYTES how many bytes we must decode. */
4985 nbytes
+= carryover
;
4987 /* Read and dispose of the process output. */
4988 outstream
= p
->filter
;
4989 if (!NILP (outstream
))
4991 /* We inhibit quit here instead of just catching it so that
4992 hitting ^G when a filter happens to be running won't screw
4994 int count
= SPECPDL_INDEX ();
4995 Lisp_Object odeactivate
;
4996 Lisp_Object obuffer
, okeymap
;
4998 int outer_running_asynch_code
= running_asynch_code
;
4999 int waiting
= waiting_for_user_input_p
;
5001 /* No need to gcpro these, because all we do with them later
5002 is test them for EQness, and none of them should be a string. */
5003 odeactivate
= Vdeactivate_mark
;
5004 XSETBUFFER (obuffer
, current_buffer
);
5005 okeymap
= current_buffer
->keymap
;
5007 specbind (Qinhibit_quit
, Qt
);
5008 specbind (Qlast_nonmenu_event
, Qt
);
5010 /* In case we get recursively called,
5011 and we already saved the match data nonrecursively,
5012 save the same match data in safely recursive fashion. */
5013 if (outer_running_asynch_code
)
5016 /* Don't clobber the CURRENT match data, either! */
5017 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5018 restore_search_regs ();
5019 record_unwind_save_match_data ();
5020 Fset_match_data (tem
, Qt
);
5023 /* For speed, if a search happens within this code,
5024 save the match data in a special nonrecursive fashion. */
5025 running_asynch_code
= 1;
5027 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5029 Vlast_coding_system_used
= coding
->symbol
;
5030 /* A new coding system might be found. */
5031 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5033 p
->decode_coding_system
= coding
->symbol
;
5035 /* Don't call setup_coding_system for
5036 proc_decode_coding_system[channel] here. It is done in
5037 detect_coding called via decode_coding above. */
5039 /* If a coding system for encoding is not yet decided, we set
5040 it as the same as coding-system for decoding.
5042 But, before doing that we must check if
5043 proc_encode_coding_system[p->outfd] surely points to a
5044 valid memory because p->outfd will be changed once EOF is
5045 sent to the process. */
5046 if (NILP (p
->encode_coding_system
)
5047 && proc_encode_coding_system
[XINT (p
->outfd
)])
5049 p
->encode_coding_system
= coding
->symbol
;
5050 setup_coding_system (coding
->symbol
,
5051 proc_encode_coding_system
[XINT (p
->outfd
)]);
5055 carryover
= nbytes
- coding
->consumed
;
5056 if (SCHARS (p
->decoding_buf
) < carryover
)
5057 p
->decoding_buf
= make_uninit_string (carryover
);
5058 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5060 XSETINT (p
->decoding_carryover
, carryover
);
5061 /* Adjust the multibyteness of TEXT to that of the filter. */
5062 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
5063 text
= (STRING_MULTIBYTE (text
)
5064 ? Fstring_as_unibyte (text
)
5065 : Fstring_to_multibyte (text
));
5066 if (SBYTES (text
) > 0)
5067 internal_condition_case_1 (read_process_output_call
,
5069 Fcons (proc
, Fcons (text
, Qnil
))),
5070 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5071 read_process_output_error_handler
);
5073 /* If we saved the match data nonrecursively, restore it now. */
5074 restore_search_regs ();
5075 running_asynch_code
= outer_running_asynch_code
;
5077 /* Handling the process output should not deactivate the mark. */
5078 Vdeactivate_mark
= odeactivate
;
5080 /* Restore waiting_for_user_input_p as it was
5081 when we were called, in case the filter clobbered it. */
5082 waiting_for_user_input_p
= waiting
;
5084 #if 0 /* Call record_asynch_buffer_change unconditionally,
5085 because we might have changed minor modes or other things
5086 that affect key bindings. */
5087 if (! EQ (Fcurrent_buffer (), obuffer
)
5088 || ! EQ (current_buffer
->keymap
, okeymap
))
5090 /* But do it only if the caller is actually going to read events.
5091 Otherwise there's no need to make him wake up, and it could
5092 cause trouble (for example it would make Fsit_for return). */
5093 if (waiting_for_user_input_p
== -1)
5094 record_asynch_buffer_change ();
5097 start_vms_process_read (vs
);
5099 unbind_to (count
, Qnil
);
5103 /* If no filter, write into buffer if it isn't dead. */
5104 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5106 Lisp_Object old_read_only
;
5107 int old_begv
, old_zv
;
5108 int old_begv_byte
, old_zv_byte
;
5109 Lisp_Object odeactivate
;
5110 int before
, before_byte
;
5115 odeactivate
= Vdeactivate_mark
;
5117 Fset_buffer (p
->buffer
);
5119 opoint_byte
= PT_BYTE
;
5120 old_read_only
= current_buffer
->read_only
;
5123 old_begv_byte
= BEGV_BYTE
;
5124 old_zv_byte
= ZV_BYTE
;
5126 current_buffer
->read_only
= Qnil
;
5128 /* Insert new output into buffer
5129 at the current end-of-output marker,
5130 thus preserving logical ordering of input and output. */
5131 if (XMARKER (p
->mark
)->buffer
)
5132 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5133 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5136 SET_PT_BOTH (ZV
, ZV_BYTE
);
5138 before_byte
= PT_BYTE
;
5140 /* If the output marker is outside of the visible region, save
5141 the restriction and widen. */
5142 if (! (BEGV
<= PT
&& PT
<= ZV
))
5145 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5147 Vlast_coding_system_used
= coding
->symbol
;
5148 /* A new coding system might be found. See the comment in the
5149 similar code in the previous `if' block. */
5150 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5152 p
->decode_coding_system
= coding
->symbol
;
5153 if (NILP (p
->encode_coding_system
)
5154 && proc_encode_coding_system
[XINT (p
->outfd
)])
5156 p
->encode_coding_system
= coding
->symbol
;
5157 setup_coding_system (coding
->symbol
,
5158 proc_encode_coding_system
[XINT (p
->outfd
)]);
5161 carryover
= nbytes
- coding
->consumed
;
5162 if (SCHARS (p
->decoding_buf
) < carryover
)
5163 p
->decoding_buf
= make_uninit_string (carryover
);
5164 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5166 XSETINT (p
->decoding_carryover
, carryover
);
5167 /* Adjust the multibyteness of TEXT to that of the buffer. */
5168 if (NILP (current_buffer
->enable_multibyte_characters
)
5169 != ! STRING_MULTIBYTE (text
))
5170 text
= (STRING_MULTIBYTE (text
)
5171 ? Fstring_as_unibyte (text
)
5172 : Fstring_to_multibyte (text
));
5173 /* Insert before markers in case we are inserting where
5174 the buffer's mark is, and the user's next command is Meta-y. */
5175 insert_from_string_before_markers (text
, 0, 0,
5176 SCHARS (text
), SBYTES (text
), 0);
5178 /* Make sure the process marker's position is valid when the
5179 process buffer is changed in the signal_after_change above.
5180 W3 is known to do that. */
5181 if (BUFFERP (p
->buffer
)
5182 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5183 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5185 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5187 update_mode_lines
++;
5189 /* Make sure opoint and the old restrictions
5190 float ahead of any new text just as point would. */
5191 if (opoint
>= before
)
5193 opoint
+= PT
- before
;
5194 opoint_byte
+= PT_BYTE
- before_byte
;
5196 if (old_begv
> before
)
5198 old_begv
+= PT
- before
;
5199 old_begv_byte
+= PT_BYTE
- before_byte
;
5201 if (old_zv
>= before
)
5203 old_zv
+= PT
- before
;
5204 old_zv_byte
+= PT_BYTE
- before_byte
;
5207 /* If the restriction isn't what it should be, set it. */
5208 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5209 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5211 /* Handling the process output should not deactivate the mark. */
5212 Vdeactivate_mark
= odeactivate
;
5214 current_buffer
->read_only
= old_read_only
;
5215 SET_PT_BOTH (opoint
, opoint_byte
);
5216 set_buffer_internal (old
);
5219 start_vms_process_read (vs
);
5224 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5226 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5227 This is intended for use by asynchronous process output filters and sentinels. */)
5230 return (waiting_for_user_input_p
? Qt
: Qnil
);
5233 /* Sending data to subprocess */
5235 jmp_buf send_process_frame
;
5236 Lisp_Object process_sent_to
;
5239 send_process_trap ()
5241 SIGNAL_THREAD_CHECK (SIGPIPE
);
5246 sigunblock (sigmask (SIGPIPE
));
5247 longjmp (send_process_frame
, 1);
5250 /* Send some data to process PROC.
5251 BUF is the beginning of the data; LEN is the number of characters.
5252 OBJECT is the Lisp object that the data comes from. If OBJECT is
5253 nil or t, it means that the data comes from C string.
5255 If OBJECT is not nil, the data is encoded by PROC's coding-system
5256 for encoding before it is sent.
5258 This function can evaluate Lisp code and can garbage collect. */
5261 send_process (proc
, buf
, len
, object
)
5262 volatile Lisp_Object proc
;
5263 unsigned char *volatile buf
;
5265 volatile Lisp_Object object
;
5267 /* Use volatile to protect variables from being clobbered by longjmp. */
5268 struct Lisp_Process
*p
= XPROCESS (proc
);
5270 struct coding_system
*coding
;
5271 struct gcpro gcpro1
;
5272 SIGTYPE (*volatile old_sigpipe
) ();
5277 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5280 if (! NILP (p
->raw_status_low
))
5282 if (! EQ (p
->status
, Qrun
))
5283 error ("Process %s not running", SDATA (p
->name
));
5284 if (XINT (p
->outfd
) < 0)
5285 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5287 coding
= proc_encode_coding_system
[XINT (p
->outfd
)];
5288 Vlast_coding_system_used
= coding
->symbol
;
5290 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5291 || (BUFFERP (object
)
5292 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5295 if (!EQ (coding
->symbol
, p
->encode_coding_system
))
5296 /* The coding system for encoding was changed to raw-text
5297 because we sent a unibyte text previously. Now we are
5298 sending a multibyte text, thus we must encode it by the
5299 original coding system specified for the current process. */
5300 setup_coding_system (p
->encode_coding_system
, coding
);
5301 /* src_multibyte should be set to 1 _after_ a call to
5302 setup_coding_system, since it resets src_multibyte to
5304 coding
->src_multibyte
= 1;
5308 /* For sending a unibyte text, character code conversion should
5309 not take place but EOL conversion should. So, setup raw-text
5310 or one of the subsidiary if we have not yet done it. */
5311 if (coding
->type
!= coding_type_raw_text
)
5313 if (CODING_REQUIRE_FLUSHING (coding
))
5315 /* But, before changing the coding, we must flush out data. */
5316 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5317 send_process (proc
, "", 0, Qt
);
5319 coding
->src_multibyte
= 0;
5320 setup_raw_text_coding_system (coding
);
5323 coding
->dst_multibyte
= 0;
5325 if (CODING_REQUIRE_ENCODING (coding
))
5327 int require
= encoding_buffer_size (coding
, len
);
5328 int from_byte
= -1, from
= -1, to
= -1;
5330 if (BUFFERP (object
))
5332 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5333 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
5334 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
5336 else if (STRINGP (object
))
5338 from_byte
= buf
- SDATA (object
);
5339 from
= string_byte_to_char (object
, from_byte
);
5340 to
= string_byte_to_char (object
, from_byte
+ len
);
5343 if (coding
->composing
!= COMPOSITION_DISABLED
)
5346 coding_save_composition (coding
, from
, to
, object
);
5348 coding
->composing
= COMPOSITION_DISABLED
;
5351 if (SBYTES (p
->encoding_buf
) < require
)
5352 p
->encoding_buf
= make_uninit_string (require
);
5355 buf
= (BUFFERP (object
)
5356 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
5357 : SDATA (object
) + from_byte
);
5359 object
= p
->encoding_buf
;
5360 encode_coding (coding
, (char *) buf
, SDATA (object
),
5361 len
, SBYTES (object
));
5362 coding_free_composition_data (coding
);
5363 len
= coding
->produced
;
5364 buf
= SDATA (object
);
5368 vs
= get_vms_process_pointer (p
->pid
);
5370 error ("Could not find this process: %x", p
->pid
);
5371 else if (write_to_vms_process (vs
, buf
, len
))
5375 if (pty_max_bytes
== 0)
5377 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5378 pty_max_bytes
= fpathconf (XFASTINT (p
->outfd
), _PC_MAX_CANON
);
5379 if (pty_max_bytes
< 0)
5380 pty_max_bytes
= 250;
5382 pty_max_bytes
= 250;
5384 /* Deduct one, to leave space for the eof. */
5388 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5389 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5390 when returning with longjmp despite being declared volatile. */
5391 if (!setjmp (send_process_frame
))
5393 process_sent_to
= proc
;
5398 /* Decide how much data we can send in one batch.
5399 Long lines need to be split into multiple batches. */
5400 if (!NILP (p
->pty_flag
))
5402 /* Starting this at zero is always correct when not the first
5403 iteration because the previous iteration ended by sending C-d.
5404 It may not be correct for the first iteration
5405 if a partial line was sent in a separate send_process call.
5406 If that proves worth handling, we need to save linepos
5407 in the process object. */
5409 unsigned char *ptr
= (unsigned char *) buf
;
5410 unsigned char *end
= (unsigned char *) buf
+ len
;
5412 /* Scan through this text for a line that is too long. */
5413 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5421 /* If we found one, break the line there
5422 and put in a C-d to force the buffer through. */
5426 /* Send this batch, using one or more write calls. */
5429 int outfd
= XINT (p
->outfd
);
5430 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5431 #ifdef DATAGRAM_SOCKETS
5432 if (DATAGRAM_CHAN_P (outfd
))
5434 rv
= sendto (outfd
, (char *) buf
, this,
5435 0, datagram_address
[outfd
].sa
,
5436 datagram_address
[outfd
].len
);
5437 if (rv
< 0 && errno
== EMSGSIZE
)
5439 signal (SIGPIPE
, old_sigpipe
);
5440 report_file_error ("sending datagram",
5441 Fcons (proc
, Qnil
));
5447 rv
= emacs_write (outfd
, (char *) buf
, this);
5448 #ifdef ADAPTIVE_READ_BUFFERING
5449 if (XINT (p
->read_output_delay
) > 0
5450 && EQ (p
->adaptive_read_buffering
, Qt
))
5452 XSETFASTINT (p
->read_output_delay
, 0);
5453 process_output_delay_count
--;
5454 p
->read_output_skip
= Qnil
;
5458 signal (SIGPIPE
, old_sigpipe
);
5464 || errno
== EWOULDBLOCK
5470 /* Buffer is full. Wait, accepting input;
5471 that may allow the program
5472 to finish doing output and read more. */
5476 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5477 /* A gross hack to work around a bug in FreeBSD.
5478 In the following sequence, read(2) returns
5482 write(2) 954 bytes, get EAGAIN
5483 read(2) 1024 bytes in process_read_output
5484 read(2) 11 bytes in process_read_output
5486 That is, read(2) returns more bytes than have
5487 ever been written successfully. The 1033 bytes
5488 read are the 1022 bytes written successfully
5489 after processing (for example with CRs added if
5490 the terminal is set up that way which it is
5491 here). The same bytes will be seen again in a
5492 later read(2), without the CRs. */
5494 if (errno
== EAGAIN
)
5497 ioctl (XINT (p
->outfd
), TIOCFLUSH
, &flags
);
5499 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5501 /* Running filters might relocate buffers or strings.
5502 Arrange to relocate BUF. */
5503 if (BUFFERP (object
))
5504 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5505 else if (STRINGP (object
))
5506 offset
= buf
- SDATA (object
);
5508 #ifdef EMACS_HAS_USECS
5509 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5511 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5514 if (BUFFERP (object
))
5515 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5516 else if (STRINGP (object
))
5517 buf
= offset
+ SDATA (object
);
5522 /* This is a real error. */
5523 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5530 /* If we sent just part of the string, put in an EOF
5531 to force it through, before we send the rest. */
5533 Fprocess_send_eof (proc
);
5536 #endif /* not VMS */
5539 signal (SIGPIPE
, old_sigpipe
);
5541 proc
= process_sent_to
;
5542 p
= XPROCESS (proc
);
5544 p
->raw_status_low
= Qnil
;
5545 p
->raw_status_high
= Qnil
;
5546 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5547 XSETINT (p
->tick
, ++process_tick
);
5548 deactivate_process (proc
);
5550 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5552 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5559 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5561 doc
: /* Send current contents of region as input to PROCESS.
5562 PROCESS may be a process, a buffer, the name of a process or buffer, or
5563 nil, indicating the current buffer's process.
5564 Called from program, takes three arguments, PROCESS, START and END.
5565 If the region is more than 500 characters long,
5566 it is sent in several bunches. This may happen even for shorter regions.
5567 Output from processes can arrive in between bunches. */)
5568 (process
, start
, end
)
5569 Lisp_Object process
, start
, end
;
5574 proc
= get_process (process
);
5575 validate_region (&start
, &end
);
5577 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5578 move_gap (XINT (start
));
5580 start1
= CHAR_TO_BYTE (XINT (start
));
5581 end1
= CHAR_TO_BYTE (XINT (end
));
5582 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5583 Fcurrent_buffer ());
5588 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5590 doc
: /* Send PROCESS the contents of STRING as input.
5591 PROCESS may be a process, a buffer, the name of a process or buffer, or
5592 nil, indicating the current buffer's process.
5593 If STRING is more than 500 characters long,
5594 it is sent in several bunches. This may happen even for shorter strings.
5595 Output from processes can arrive in between bunches. */)
5597 Lisp_Object process
, string
;
5600 CHECK_STRING (string
);
5601 proc
= get_process (process
);
5602 send_process (proc
, SDATA (string
),
5603 SBYTES (string
), string
);
5607 /* Return the foreground process group for the tty/pty that
5608 the process P uses. */
5610 emacs_get_tty_pgrp (p
)
5611 struct Lisp_Process
*p
;
5616 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5619 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5620 master side. Try the slave side. */
5621 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5625 ioctl (fd
, TIOCGPGRP
, &gid
);
5629 #endif /* defined (TIOCGPGRP ) */
5634 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5635 Sprocess_running_child_p
, 0, 1, 0,
5636 doc
: /* Return t if PROCESS has given the terminal to a child.
5637 If the operating system does not make it possible to find out,
5638 return t unconditionally. */)
5640 Lisp_Object process
;
5642 /* Initialize in case ioctl doesn't exist or gives an error,
5643 in a way that will cause returning t. */
5646 struct Lisp_Process
*p
;
5648 proc
= get_process (process
);
5649 p
= XPROCESS (proc
);
5651 if (!EQ (p
->childp
, Qt
))
5652 error ("Process %s is not a subprocess",
5654 if (XINT (p
->infd
) < 0)
5655 error ("Process %s is not active",
5658 gid
= emacs_get_tty_pgrp (p
);
5660 if (gid
== XFASTINT (p
->pid
))
5665 /* send a signal number SIGNO to PROCESS.
5666 If CURRENT_GROUP is t, that means send to the process group
5667 that currently owns the terminal being used to communicate with PROCESS.
5668 This is used for various commands in shell mode.
5669 If CURRENT_GROUP is lambda, that means send to the process group
5670 that currently owns the terminal, but only if it is NOT the shell itself.
5672 If NOMSG is zero, insert signal-announcements into process's buffers
5675 If we can, we try to signal PROCESS by sending control characters
5676 down the pty. This allows us to signal inferiors who have changed
5677 their uid, for which killpg would return an EPERM error. */
5680 process_send_signal (process
, signo
, current_group
, nomsg
)
5681 Lisp_Object process
;
5683 Lisp_Object current_group
;
5687 register struct Lisp_Process
*p
;
5691 proc
= get_process (process
);
5692 p
= XPROCESS (proc
);
5694 if (!EQ (p
->childp
, Qt
))
5695 error ("Process %s is not a subprocess",
5697 if (XINT (p
->infd
) < 0)
5698 error ("Process %s is not active",
5701 if (NILP (p
->pty_flag
))
5702 current_group
= Qnil
;
5704 /* If we are using pgrps, get a pgrp number and make it negative. */
5705 if (NILP (current_group
))
5706 /* Send the signal to the shell's process group. */
5707 gid
= XFASTINT (p
->pid
);
5710 #ifdef SIGNALS_VIA_CHARACTERS
5711 /* If possible, send signals to the entire pgrp
5712 by sending an input character to it. */
5714 /* TERMIOS is the latest and bestest, and seems most likely to
5715 work. If the system has it, use it. */
5718 cc_t
*sig_char
= NULL
;
5720 tcgetattr (XINT (p
->infd
), &t
);
5725 sig_char
= &t
.c_cc
[VINTR
];
5729 sig_char
= &t
.c_cc
[VQUIT
];
5733 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5734 sig_char
= &t
.c_cc
[VSWTCH
];
5736 sig_char
= &t
.c_cc
[VSUSP
];
5741 if (sig_char
&& *sig_char
!= CDISABLE
)
5743 send_process (proc
, sig_char
, 1, Qnil
);
5746 /* If we can't send the signal with a character,
5747 fall through and send it another way. */
5748 #else /* ! HAVE_TERMIOS */
5750 /* On Berkeley descendants, the following IOCTL's retrieve the
5751 current control characters. */
5752 #if defined (TIOCGLTC) && defined (TIOCGETC)
5760 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5761 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5764 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5765 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5769 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5770 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5772 #endif /* ! defined (SIGTSTP) */
5775 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5777 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5784 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5785 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5788 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5789 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5793 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5794 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5796 #endif /* ! defined (SIGTSTP) */
5798 #else /* ! defined (TCGETA) */
5799 Your configuration files are messed up
.
5800 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5801 you'd better be using one of the alternatives above! */
5802 #endif /* ! defined (TCGETA) */
5803 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5804 /* In this case, the code above should alway returns. */
5806 #endif /* ! defined HAVE_TERMIOS */
5808 /* The code above may fall through if it can't
5809 handle the signal. */
5810 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5813 /* Get the current pgrp using the tty itself, if we have that.
5814 Otherwise, use the pty to get the pgrp.
5815 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5816 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5817 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5818 His patch indicates that if TIOCGPGRP returns an error, then
5819 we should just assume that p->pid is also the process group id. */
5821 gid
= emacs_get_tty_pgrp (p
);
5824 /* If we can't get the information, assume
5825 the shell owns the tty. */
5826 gid
= XFASTINT (p
->pid
);
5828 /* It is not clear whether anything really can set GID to -1.
5829 Perhaps on some system one of those ioctls can or could do so.
5830 Or perhaps this is vestigial. */
5833 #else /* ! defined (TIOCGPGRP ) */
5834 /* Can't select pgrps on this system, so we know that
5835 the child itself heads the pgrp. */
5836 gid
= XFASTINT (p
->pid
);
5837 #endif /* ! defined (TIOCGPGRP ) */
5839 /* If current_group is lambda, and the shell owns the terminal,
5840 don't send any signal. */
5841 if (EQ (current_group
, Qlambda
) && gid
== XFASTINT (p
->pid
))
5849 p
->raw_status_low
= Qnil
;
5850 p
->raw_status_high
= Qnil
;
5852 XSETINT (p
->tick
, ++process_tick
);
5854 status_notify (NULL
);
5856 #endif /* ! defined (SIGCONT) */
5859 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5864 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5869 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
5872 flush_pending_output (XINT (p
->infd
));
5876 /* If we don't have process groups, send the signal to the immediate
5877 subprocess. That isn't really right, but it's better than any
5878 obvious alternative. */
5881 kill (XFASTINT (p
->pid
), signo
);
5885 /* gid may be a pid, or minus a pgrp's number */
5887 if (!NILP (current_group
))
5889 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
5890 EMACS_KILLPG (gid
, signo
);
5894 gid
= - XFASTINT (p
->pid
);
5897 #else /* ! defined (TIOCSIGSEND) */
5898 EMACS_KILLPG (gid
, signo
);
5899 #endif /* ! defined (TIOCSIGSEND) */
5902 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5903 doc
: /* Interrupt process PROCESS.
5904 PROCESS may be a process, a buffer, or the name of a process or buffer.
5905 No arg or nil means current buffer's process.
5906 Second arg CURRENT-GROUP non-nil means send signal to
5907 the current process-group of the process's controlling terminal
5908 rather than to the process's own process group.
5909 If the process is a shell, this means interrupt current subjob
5910 rather than the shell.
5912 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5913 don't send the signal. */)
5914 (process
, current_group
)
5915 Lisp_Object process
, current_group
;
5917 process_send_signal (process
, SIGINT
, current_group
, 0);
5921 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5922 doc
: /* Kill process PROCESS. May be process or name of one.
5923 See function `interrupt-process' for more details on usage. */)
5924 (process
, current_group
)
5925 Lisp_Object process
, current_group
;
5927 process_send_signal (process
, SIGKILL
, current_group
, 0);
5931 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5932 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5933 See function `interrupt-process' for more details on usage. */)
5934 (process
, current_group
)
5935 Lisp_Object process
, current_group
;
5937 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5941 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5942 doc
: /* Stop process PROCESS. May be process or name of one.
5943 See function `interrupt-process' for more details on usage.
5944 If PROCESS is a network process, inhibit handling of incoming traffic. */)
5945 (process
, current_group
)
5946 Lisp_Object process
, current_group
;
5949 if (PROCESSP (process
) && NETCONN_P (process
))
5951 struct Lisp_Process
*p
;
5953 p
= XPROCESS (process
);
5954 if (NILP (p
->command
)
5955 && XINT (p
->infd
) >= 0)
5957 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5958 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5965 error ("No SIGTSTP support");
5967 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5972 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5973 doc
: /* Continue process PROCESS. May be process or name of one.
5974 See function `interrupt-process' for more details on usage.
5975 If PROCESS is a network process, resume handling of incoming traffic. */)
5976 (process
, current_group
)
5977 Lisp_Object process
, current_group
;
5980 if (PROCESSP (process
) && NETCONN_P (process
))
5982 struct Lisp_Process
*p
;
5984 p
= XPROCESS (process
);
5985 if (EQ (p
->command
, Qt
)
5986 && XINT (p
->infd
) >= 0
5987 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
5989 FD_SET (XINT (p
->infd
), &input_wait_mask
);
5990 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
5997 process_send_signal (process
, SIGCONT
, current_group
, 0);
5999 error ("No SIGCONT support");
6004 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6005 2, 2, "sProcess (name or number): \nnSignal code: ",
6006 doc
: /* Send PROCESS the signal with code SIGCODE.
6007 PROCESS may also be an integer specifying the process id of the
6008 process to signal; in this case, the process need not be a child of
6010 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6012 Lisp_Object process
, sigcode
;
6016 if (INTEGERP (process
))
6022 if (STRINGP (process
))
6025 if (tem
= Fget_process (process
), NILP (tem
))
6027 pid
= Fstring_to_number (process
, make_number (10));
6028 if (XINT (pid
) != 0)
6034 process
= get_process (process
);
6039 CHECK_PROCESS (process
);
6040 pid
= XPROCESS (process
)->pid
;
6041 if (!INTEGERP (pid
) || XINT (pid
) <= 0)
6042 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6046 #define handle_signal(NAME, VALUE) \
6047 else if (!strcmp (name, NAME)) \
6048 XSETINT (sigcode, VALUE)
6050 if (INTEGERP (sigcode
))
6054 unsigned char *name
;
6056 CHECK_SYMBOL (sigcode
);
6057 name
= SDATA (SYMBOL_NAME (sigcode
));
6059 if (!strncmp(name
, "SIG", 3))
6065 handle_signal ("HUP", SIGHUP
);
6068 handle_signal ("INT", SIGINT
);
6071 handle_signal ("QUIT", SIGQUIT
);
6074 handle_signal ("ILL", SIGILL
);
6077 handle_signal ("ABRT", SIGABRT
);
6080 handle_signal ("EMT", SIGEMT
);
6083 handle_signal ("KILL", SIGKILL
);
6086 handle_signal ("FPE", SIGFPE
);
6089 handle_signal ("BUS", SIGBUS
);
6092 handle_signal ("SEGV", SIGSEGV
);
6095 handle_signal ("SYS", SIGSYS
);
6098 handle_signal ("PIPE", SIGPIPE
);
6101 handle_signal ("ALRM", SIGALRM
);
6104 handle_signal ("TERM", SIGTERM
);
6107 handle_signal ("URG", SIGURG
);
6110 handle_signal ("STOP", SIGSTOP
);
6113 handle_signal ("TSTP", SIGTSTP
);
6116 handle_signal ("CONT", SIGCONT
);
6119 handle_signal ("CHLD", SIGCHLD
);
6122 handle_signal ("TTIN", SIGTTIN
);
6125 handle_signal ("TTOU", SIGTTOU
);
6128 handle_signal ("IO", SIGIO
);
6131 handle_signal ("XCPU", SIGXCPU
);
6134 handle_signal ("XFSZ", SIGXFSZ
);
6137 handle_signal ("VTALRM", SIGVTALRM
);
6140 handle_signal ("PROF", SIGPROF
);
6143 handle_signal ("WINCH", SIGWINCH
);
6146 handle_signal ("INFO", SIGINFO
);
6149 handle_signal ("USR1", SIGUSR1
);
6152 handle_signal ("USR2", SIGUSR2
);
6155 error ("Undefined signal name %s", name
);
6158 #undef handle_signal
6160 return make_number (kill (XINT (pid
), XINT (sigcode
)));
6163 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6164 doc
: /* Make PROCESS see end-of-file in its input.
6165 EOF comes after any text already sent to it.
6166 PROCESS may be a process, a buffer, the name of a process or buffer, or
6167 nil, indicating the current buffer's process.
6168 If PROCESS is a network connection, or is a process communicating
6169 through a pipe (as opposed to a pty), then you cannot send any more
6170 text to PROCESS after you call this function. */)
6172 Lisp_Object process
;
6175 struct coding_system
*coding
;
6177 if (DATAGRAM_CONN_P (process
))
6180 proc
= get_process (process
);
6181 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
6183 /* Make sure the process is really alive. */
6184 if (! NILP (XPROCESS (proc
)->raw_status_low
))
6185 update_status (XPROCESS (proc
));
6186 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6187 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6189 if (CODING_REQUIRE_FLUSHING (coding
))
6191 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6192 send_process (proc
, "", 0, Qnil
);
6196 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6198 if (!NILP (XPROCESS (proc
)->pty_flag
))
6199 send_process (proc
, "\004", 1, Qnil
);
6202 int old_outfd
, new_outfd
;
6204 #ifdef HAVE_SHUTDOWN
6205 /* If this is a network connection, or socketpair is used
6206 for communication with the subprocess, call shutdown to cause EOF.
6207 (In some old system, shutdown to socketpair doesn't work.
6208 Then we just can't win.) */
6209 if (NILP (XPROCESS (proc
)->pid
)
6210 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
6211 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
6212 /* In case of socketpair, outfd == infd, so don't close it. */
6213 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
6214 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6215 #else /* not HAVE_SHUTDOWN */
6216 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6217 #endif /* not HAVE_SHUTDOWN */
6218 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6219 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
6221 if (!proc_encode_coding_system
[new_outfd
])
6222 proc_encode_coding_system
[new_outfd
]
6223 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6224 bcopy (proc_encode_coding_system
[old_outfd
],
6225 proc_encode_coding_system
[new_outfd
],
6226 sizeof (struct coding_system
));
6227 bzero (proc_encode_coding_system
[old_outfd
],
6228 sizeof (struct coding_system
));
6230 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
6236 /* Kill all processes associated with `buffer'.
6237 If `buffer' is nil, kill all processes */
6240 kill_buffer_processes (buffer
)
6243 Lisp_Object tail
, proc
;
6245 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6247 proc
= XCDR (XCAR (tail
));
6248 if (GC_PROCESSP (proc
)
6249 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6251 if (NETCONN_P (proc
))
6252 Fdelete_process (proc
);
6253 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
6254 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6259 /* On receipt of a signal that a child status has changed, loop asking
6260 about children with changed statuses until the system says there
6263 All we do is change the status; we do not run sentinels or print
6264 notifications. That is saved for the next time keyboard input is
6265 done, in order to avoid timing errors.
6267 ** WARNING: this can be called during garbage collection.
6268 Therefore, it must not be fooled by the presence of mark bits in
6271 ** USG WARNING: Although it is not obvious from the documentation
6272 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6273 signal() before executing at least one wait(), otherwise the
6274 handler will be called again, resulting in an infinite loop. The
6275 relevant portion of the documentation reads "SIGCLD signals will be
6276 queued and the signal-catching function will be continually
6277 reentered until the queue is empty". Invoking signal() causes the
6278 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6281 ** Malloc WARNING: This should never call malloc either directly or
6282 indirectly; if it does, that is a bug */
6285 sigchld_handler (signo
)
6288 int old_errno
= errno
;
6290 register struct Lisp_Process
*p
;
6291 extern EMACS_TIME
*input_available_clear_time
;
6293 SIGNAL_THREAD_CHECK (signo
);
6297 sigheld
|= sigbit (SIGCHLD
);
6309 #endif /* no WUNTRACED */
6310 /* Keep trying to get a status until we get a definitive result. */
6314 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6316 while (pid
< 0 && errno
== EINTR
);
6320 /* PID == 0 means no processes found, PID == -1 means a real
6321 failure. We have done all our job, so return. */
6323 /* USG systems forget handlers when they are used;
6324 must reestablish each time */
6325 #if defined (USG) && !defined (POSIX_SIGNALS)
6326 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6329 sigheld
&= ~sigbit (SIGCHLD
);
6337 #endif /* no WNOHANG */
6339 /* Find the process that signaled us, and record its status. */
6342 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6344 proc
= XCDR (XCAR (tail
));
6345 p
= XPROCESS (proc
);
6346 if (GC_EQ (p
->childp
, Qt
) && XINT (p
->pid
) == pid
)
6351 /* Look for an asynchronous process whose pid hasn't been filled
6354 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6356 proc
= XCDR (XCAR (tail
));
6357 p
= XPROCESS (proc
);
6358 if (GC_INTEGERP (p
->pid
) && XINT (p
->pid
) == -1)
6363 /* Change the status of the process that was found. */
6366 union { int i
; WAITTYPE wt
; } u
;
6367 int clear_desc_flag
= 0;
6369 XSETINT (p
->tick
, ++process_tick
);
6371 XSETINT (p
->raw_status_low
, u
.i
& 0xffff);
6372 XSETINT (p
->raw_status_high
, u
.i
>> 16);
6374 /* If process has terminated, stop waiting for its output. */
6375 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6376 && XINT (p
->infd
) >= 0)
6377 clear_desc_flag
= 1;
6379 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6380 if (clear_desc_flag
)
6382 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6383 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6386 /* Tell wait_reading_process_output that it needs to wake up and
6388 if (input_available_clear_time
)
6389 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6392 /* There was no asynchronous process found for that id. Check
6393 if we have a synchronous process. */
6396 synch_process_alive
= 0;
6398 /* Report the status of the synchronous process. */
6400 synch_process_retcode
= WRETCODE (w
);
6401 else if (WIFSIGNALED (w
))
6402 synch_process_termsig
= WTERMSIG (w
);
6404 /* Tell wait_reading_process_output that it needs to wake up and
6406 if (input_available_clear_time
)
6407 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6410 /* On some systems, we must return right away.
6411 If any more processes want to signal us, we will
6413 Otherwise (on systems that have WNOHANG), loop around
6414 to use up all the processes that have something to tell us. */
6415 #if (defined WINDOWSNT \
6416 || (defined USG && !defined GNU_LINUX \
6417 && !(defined HPUX && defined WNOHANG)))
6418 #if defined (USG) && ! defined (POSIX_SIGNALS)
6419 signal (signo
, sigchld_handler
);
6423 #endif /* USG, but not HPUX with WNOHANG */
6429 exec_sentinel_unwind (data
)
6432 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6437 exec_sentinel_error_handler (error
)
6440 cmd_error_internal (error
, "error in process sentinel: ");
6442 update_echo_area ();
6443 Fsleep_for (make_number (2), Qnil
);
6448 exec_sentinel (proc
, reason
)
6449 Lisp_Object proc
, reason
;
6451 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6452 register struct Lisp_Process
*p
= XPROCESS (proc
);
6453 int count
= SPECPDL_INDEX ();
6454 int outer_running_asynch_code
= running_asynch_code
;
6455 int waiting
= waiting_for_user_input_p
;
6457 /* No need to gcpro these, because all we do with them later
6458 is test them for EQness, and none of them should be a string. */
6459 odeactivate
= Vdeactivate_mark
;
6460 XSETBUFFER (obuffer
, current_buffer
);
6461 okeymap
= current_buffer
->keymap
;
6463 sentinel
= p
->sentinel
;
6464 if (NILP (sentinel
))
6467 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6468 assure that it gets restored no matter how the sentinel exits. */
6470 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6471 /* Inhibit quit so that random quits don't screw up a running filter. */
6472 specbind (Qinhibit_quit
, Qt
);
6473 specbind (Qlast_nonmenu_event
, Qt
);
6475 /* In case we get recursively called,
6476 and we already saved the match data nonrecursively,
6477 save the same match data in safely recursive fashion. */
6478 if (outer_running_asynch_code
)
6481 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6482 restore_search_regs ();
6483 record_unwind_save_match_data ();
6484 Fset_match_data (tem
, Qt
);
6487 /* For speed, if a search happens within this code,
6488 save the match data in a special nonrecursive fashion. */
6489 running_asynch_code
= 1;
6491 internal_condition_case_1 (read_process_output_call
,
6493 Fcons (proc
, Fcons (reason
, Qnil
))),
6494 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6495 exec_sentinel_error_handler
);
6497 /* If we saved the match data nonrecursively, restore it now. */
6498 restore_search_regs ();
6499 running_asynch_code
= outer_running_asynch_code
;
6501 Vdeactivate_mark
= odeactivate
;
6503 /* Restore waiting_for_user_input_p as it was
6504 when we were called, in case the filter clobbered it. */
6505 waiting_for_user_input_p
= waiting
;
6508 if (! EQ (Fcurrent_buffer (), obuffer
)
6509 || ! EQ (current_buffer
->keymap
, okeymap
))
6511 /* But do it only if the caller is actually going to read events.
6512 Otherwise there's no need to make him wake up, and it could
6513 cause trouble (for example it would make Fsit_for return). */
6514 if (waiting_for_user_input_p
== -1)
6515 record_asynch_buffer_change ();
6517 unbind_to (count
, Qnil
);
6520 /* Report all recent events of a change in process status
6521 (either run the sentinel or output a message).
6522 This is usually done while Emacs is waiting for keyboard input
6523 but can be done at other times. */
6526 status_notify (deleting_process
)
6527 struct Lisp_Process
*deleting_process
;
6529 register Lisp_Object proc
, buffer
;
6530 Lisp_Object tail
, msg
;
6531 struct gcpro gcpro1
, gcpro2
;
6535 /* We need to gcpro tail; if read_process_output calls a filter
6536 which deletes a process and removes the cons to which tail points
6537 from Vprocess_alist, and then causes a GC, tail is an unprotected
6541 /* Set this now, so that if new processes are created by sentinels
6542 that we run, we get called again to handle their status changes. */
6543 update_tick
= process_tick
;
6545 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6548 register struct Lisp_Process
*p
;
6550 proc
= Fcdr (Fcar (tail
));
6551 p
= XPROCESS (proc
);
6553 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6555 XSETINT (p
->update_tick
, XINT (p
->tick
));
6557 /* If process is still active, read any output that remains. */
6558 while (! EQ (p
->filter
, Qt
)
6559 && ! EQ (p
->status
, Qconnect
)
6560 && ! EQ (p
->status
, Qlisten
)
6561 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6562 && XINT (p
->infd
) >= 0
6563 && p
!= deleting_process
6564 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6568 /* Get the text to use for the message. */
6569 if (!NILP (p
->raw_status_low
))
6571 msg
= status_message (p
);
6573 /* If process is terminated, deactivate it or delete it. */
6575 if (CONSP (p
->status
))
6576 symbol
= XCAR (p
->status
);
6578 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6579 || EQ (symbol
, Qclosed
))
6581 if (delete_exited_processes
)
6582 remove_process (proc
);
6584 deactivate_process (proc
);
6587 /* The actions above may have further incremented p->tick.
6588 So set p->update_tick again
6589 so that an error in the sentinel will not cause
6590 this code to be run again. */
6591 XSETINT (p
->update_tick
, XINT (p
->tick
));
6592 /* Now output the message suitably. */
6593 if (!NILP (p
->sentinel
))
6594 exec_sentinel (proc
, msg
);
6595 /* Don't bother with a message in the buffer
6596 when a process becomes runnable. */
6597 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6599 Lisp_Object ro
, tem
;
6600 struct buffer
*old
= current_buffer
;
6601 int opoint
, opoint_byte
;
6602 int before
, before_byte
;
6604 ro
= XBUFFER (buffer
)->read_only
;
6606 /* Avoid error if buffer is deleted
6607 (probably that's why the process is dead, too) */
6608 if (NILP (XBUFFER (buffer
)->name
))
6610 Fset_buffer (buffer
);
6613 opoint_byte
= PT_BYTE
;
6614 /* Insert new output into buffer
6615 at the current end-of-output marker,
6616 thus preserving logical ordering of input and output. */
6617 if (XMARKER (p
->mark
)->buffer
)
6618 Fgoto_char (p
->mark
);
6620 SET_PT_BOTH (ZV
, ZV_BYTE
);
6623 before_byte
= PT_BYTE
;
6625 tem
= current_buffer
->read_only
;
6626 current_buffer
->read_only
= Qnil
;
6627 insert_string ("\nProcess ");
6628 Finsert (1, &p
->name
);
6629 insert_string (" ");
6631 current_buffer
->read_only
= tem
;
6632 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6634 if (opoint
>= before
)
6635 SET_PT_BOTH (opoint
+ (PT
- before
),
6636 opoint_byte
+ (PT_BYTE
- before_byte
));
6638 SET_PT_BOTH (opoint
, opoint_byte
);
6640 set_buffer_internal (old
);
6645 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6646 redisplay_preserve_echo_area (13);
6652 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6653 Sset_process_coding_system
, 1, 3, 0,
6654 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6655 DECODING will be used to decode subprocess output and ENCODING to
6656 encode subprocess input. */)
6657 (process
, decoding
, encoding
)
6658 register Lisp_Object process
, decoding
, encoding
;
6660 register struct Lisp_Process
*p
;
6662 CHECK_PROCESS (process
);
6663 p
= XPROCESS (process
);
6664 if (XINT (p
->infd
) < 0)
6665 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6666 if (XINT (p
->outfd
) < 0)
6667 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6668 Fcheck_coding_system (decoding
);
6669 Fcheck_coding_system (encoding
);
6671 p
->decode_coding_system
= decoding
;
6672 p
->encode_coding_system
= encoding
;
6673 setup_process_coding_systems (process
);
6678 DEFUN ("process-coding-system",
6679 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6680 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6682 register Lisp_Object process
;
6684 CHECK_PROCESS (process
);
6685 return Fcons (XPROCESS (process
)->decode_coding_system
,
6686 XPROCESS (process
)->encode_coding_system
);
6689 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6690 Sset_process_filter_multibyte
, 2, 2, 0,
6691 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6692 If FLAG is non-nil, the filter is given multibyte strings.
6693 If FLAG is nil, the filter is given unibyte strings. In this case,
6694 all character code conversion except for end-of-line conversion is
6697 Lisp_Object process
, flag
;
6699 register struct Lisp_Process
*p
;
6701 CHECK_PROCESS (process
);
6702 p
= XPROCESS (process
);
6703 p
->filter_multibyte
= flag
;
6704 setup_process_coding_systems (process
);
6709 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6710 Sprocess_filter_multibyte_p
, 1, 1, 0,
6711 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6713 Lisp_Object process
;
6715 register struct Lisp_Process
*p
;
6717 CHECK_PROCESS (process
);
6718 p
= XPROCESS (process
);
6720 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6725 /* Add DESC to the set of keyboard input descriptors. */
6728 add_keyboard_wait_descriptor (desc
)
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 /* Don't do this, it caused infinite select loops. The display
6801 method should call add_keyboard_wait_descriptor on stdin if it
6804 FD_SET (0, &input_wait_mask
);
6807 Vprocess_alist
= Qnil
;
6808 for (i
= 0; i
< MAXDESC
; i
++)
6810 chan_process
[i
] = Qnil
;
6811 proc_buffered_char
[i
] = -1;
6813 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6814 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6815 #ifdef DATAGRAM_SOCKETS
6816 bzero (datagram_address
, sizeof datagram_address
);
6821 Lisp_Object subfeatures
= Qnil
;
6822 struct socket_options
*sopt
;
6824 #define ADD_SUBFEATURE(key, val) \
6825 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6827 #ifdef NON_BLOCKING_CONNECT
6828 ADD_SUBFEATURE (QCnowait
, Qt
);
6830 #ifdef DATAGRAM_SOCKETS
6831 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6833 #ifdef HAVE_LOCAL_SOCKETS
6834 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6836 ADD_SUBFEATURE (QCfamily
, Qipv4
);
6838 ADD_SUBFEATURE (QCfamily
, Qipv6
);
6840 #ifdef HAVE_GETSOCKNAME
6841 ADD_SUBFEATURE (QCservice
, Qt
);
6843 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6844 ADD_SUBFEATURE (QCserver
, Qt
);
6847 for (sopt
= socket_options
; sopt
->name
; sopt
++)
6848 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
6850 Fprovide (intern ("make-network-process"), subfeatures
);
6852 #endif /* HAVE_SOCKETS */
6854 #if defined (DARWIN) || defined (MAC_OSX)
6855 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
6856 processes. As such, we only change the default value. */
6859 char *release
= get_operating_system_release();
6860 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
6861 && release
[1] == '.')) {
6862 Vprocess_connection_type
= Qnil
;
6871 Qprocessp
= intern ("processp");
6872 staticpro (&Qprocessp
);
6873 Qrun
= intern ("run");
6875 Qstop
= intern ("stop");
6877 Qsignal
= intern ("signal");
6878 staticpro (&Qsignal
);
6880 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6883 Qexit = intern ("exit");
6884 staticpro (&Qexit); */
6886 Qopen
= intern ("open");
6888 Qclosed
= intern ("closed");
6889 staticpro (&Qclosed
);
6890 Qconnect
= intern ("connect");
6891 staticpro (&Qconnect
);
6892 Qfailed
= intern ("failed");
6893 staticpro (&Qfailed
);
6894 Qlisten
= intern ("listen");
6895 staticpro (&Qlisten
);
6896 Qlocal
= intern ("local");
6897 staticpro (&Qlocal
);
6898 Qipv4
= intern ("ipv4");
6901 Qipv6
= intern ("ipv6");
6904 Qdatagram
= intern ("datagram");
6905 staticpro (&Qdatagram
);
6907 QCname
= intern (":name");
6908 staticpro (&QCname
);
6909 QCbuffer
= intern (":buffer");
6910 staticpro (&QCbuffer
);
6911 QChost
= intern (":host");
6912 staticpro (&QChost
);
6913 QCservice
= intern (":service");
6914 staticpro (&QCservice
);
6915 QCtype
= intern (":type");
6916 staticpro (&QCtype
);
6917 QClocal
= intern (":local");
6918 staticpro (&QClocal
);
6919 QCremote
= intern (":remote");
6920 staticpro (&QCremote
);
6921 QCcoding
= intern (":coding");
6922 staticpro (&QCcoding
);
6923 QCserver
= intern (":server");
6924 staticpro (&QCserver
);
6925 QCnowait
= intern (":nowait");
6926 staticpro (&QCnowait
);
6927 QCsentinel
= intern (":sentinel");
6928 staticpro (&QCsentinel
);
6929 QClog
= intern (":log");
6931 QCnoquery
= intern (":noquery");
6932 staticpro (&QCnoquery
);
6933 QCstop
= intern (":stop");
6934 staticpro (&QCstop
);
6935 QCoptions
= intern (":options");
6936 staticpro (&QCoptions
);
6937 QCplist
= intern (":plist");
6938 staticpro (&QCplist
);
6939 QCfilter_multibyte
= intern (":filter-multibyte");
6940 staticpro (&QCfilter_multibyte
);
6942 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
6943 staticpro (&Qlast_nonmenu_event
);
6945 staticpro (&Vprocess_alist
);
6947 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
6948 doc
: /* *Non-nil means delete processes immediately when they exit.
6949 nil means don't delete them until `list-processes' is run. */);
6951 delete_exited_processes
= 1;
6953 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
6954 doc
: /* Control type of device used to communicate with subprocesses.
6955 Values are nil to use a pipe, or t or `pty' to use a pty.
6956 The value has no effect if the system has no ptys or if all ptys are busy:
6957 then a pipe is used in any case.
6958 The value takes effect when `start-process' is called. */);
6959 Vprocess_connection_type
= Qt
;
6961 #ifdef ADAPTIVE_READ_BUFFERING
6962 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
6963 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
6964 On some systems, when Emacs reads the output from a subprocess, the output data
6965 is read in very small blocks, potentially resulting in very poor performance.
6966 This behavior can be remedied to some extent by setting this variable to a
6967 non-nil value, as it will automatically delay reading from such processes, to
6968 allowing them to produce more output before Emacs tries to read it.
6969 If the value is t, the delay is reset after each write to the process; any other
6970 non-nil value means that the delay is not reset on write.
6971 The variable takes effect when `start-process' is called. */);
6972 Vprocess_adaptive_read_buffering
= Qt
;
6975 defsubr (&Sprocessp
);
6976 defsubr (&Sget_process
);
6977 defsubr (&Sget_buffer_process
);
6978 defsubr (&Sdelete_process
);
6979 defsubr (&Sprocess_status
);
6980 defsubr (&Sprocess_exit_status
);
6981 defsubr (&Sprocess_id
);
6982 defsubr (&Sprocess_name
);
6983 defsubr (&Sprocess_tty_name
);
6984 defsubr (&Sprocess_command
);
6985 defsubr (&Sset_process_buffer
);
6986 defsubr (&Sprocess_buffer
);
6987 defsubr (&Sprocess_mark
);
6988 defsubr (&Sset_process_filter
);
6989 defsubr (&Sprocess_filter
);
6990 defsubr (&Sset_process_sentinel
);
6991 defsubr (&Sprocess_sentinel
);
6992 defsubr (&Sset_process_window_size
);
6993 defsubr (&Sset_process_inherit_coding_system_flag
);
6994 defsubr (&Sprocess_inherit_coding_system_flag
);
6995 defsubr (&Sset_process_query_on_exit_flag
);
6996 defsubr (&Sprocess_query_on_exit_flag
);
6997 defsubr (&Sprocess_contact
);
6998 defsubr (&Sprocess_plist
);
6999 defsubr (&Sset_process_plist
);
7000 defsubr (&Slist_processes
);
7001 defsubr (&Sprocess_list
);
7002 defsubr (&Sstart_process
);
7004 defsubr (&Sset_network_process_option
);
7005 defsubr (&Smake_network_process
);
7006 defsubr (&Sformat_network_address
);
7007 #endif /* HAVE_SOCKETS */
7008 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7010 defsubr (&Snetwork_interface_list
);
7012 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7013 defsubr (&Snetwork_interface_info
);
7015 #endif /* HAVE_SOCKETS ... */
7016 #ifdef DATAGRAM_SOCKETS
7017 defsubr (&Sprocess_datagram_address
);
7018 defsubr (&Sset_process_datagram_address
);
7020 defsubr (&Saccept_process_output
);
7021 defsubr (&Sprocess_send_region
);
7022 defsubr (&Sprocess_send_string
);
7023 defsubr (&Sinterrupt_process
);
7024 defsubr (&Skill_process
);
7025 defsubr (&Squit_process
);
7026 defsubr (&Sstop_process
);
7027 defsubr (&Scontinue_process
);
7028 defsubr (&Sprocess_running_child_p
);
7029 defsubr (&Sprocess_send_eof
);
7030 defsubr (&Ssignal_process
);
7031 defsubr (&Swaiting_for_user_input_p
);
7032 /* defsubr (&Sprocess_connection); */
7033 defsubr (&Sset_process_coding_system
);
7034 defsubr (&Sprocess_coding_system
);
7035 defsubr (&Sset_process_filter_multibyte
);
7036 defsubr (&Sprocess_filter_multibyte_p
);
7040 #else /* not subprocesses */
7042 #include <sys/types.h>
7046 #include "systime.h"
7047 #include "charset.h"
7049 #include "termopts.h"
7050 #include "sysselect.h"
7052 extern int frame_garbaged
;
7054 extern EMACS_TIME
timer_check ();
7055 extern int timers_run
;
7059 /* As described above, except assuming that there are no subprocesses:
7061 Wait for timeout to elapse and/or keyboard input to be available.
7064 timeout in seconds, or
7065 zero for no limit, or
7066 -1 means gobble data immediately available but don't wait for any.
7068 read_kbd is a Lisp_Object:
7069 0 to ignore keyboard input, or
7070 1 to return when input is available, or
7071 -1 means caller will actually read the input, so don't throw to
7074 see full version for other parameters. We know that wait_proc will
7075 always be NULL, since `subprocesses' isn't defined.
7077 do_display != 0 means redisplay should be done to show subprocess
7078 output that arrives.
7080 Return true iff we received input from any process. */
7083 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
7084 wait_for_cell
, wait_proc
, just_wait_proc
)
7085 int time_limit
, microsecs
, read_kbd
, do_display
;
7086 Lisp_Object wait_for_cell
;
7087 struct Lisp_Process
*wait_proc
;
7091 EMACS_TIME end_time
, timeout
;
7092 SELECT_TYPE waitchannels
;
7095 /* What does time_limit really mean? */
7096 if (time_limit
|| microsecs
)
7098 EMACS_GET_TIME (end_time
);
7099 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
7100 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
7103 /* Turn off periodic alarms (in case they are in use)
7104 and then turn off any other atimers,
7105 because the select emulator uses alarms. */
7107 turn_on_atimers (0);
7111 int timeout_reduced_for_timers
= 0;
7113 /* If calling from keyboard input, do not quit
7114 since we want to return C-g as an input character.
7115 Otherwise, do pending quit if requested. */
7119 /* Exit now if the cell we're waiting for became non-nil. */
7120 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7123 /* Compute time from now till when time limit is up */
7124 /* Exit if already run out */
7125 if (time_limit
== -1)
7127 /* -1 specified for timeout means
7128 gobble output available now
7129 but don't wait at all. */
7131 EMACS_SET_SECS_USECS (timeout
, 0, 0);
7133 else if (time_limit
|| microsecs
)
7135 EMACS_GET_TIME (timeout
);
7136 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
7137 if (EMACS_TIME_NEG_P (timeout
))
7142 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
7145 /* If our caller will not immediately handle keyboard events,
7146 run timer events directly.
7147 (Callers that will immediately read keyboard events
7148 call timer_delay on their own.) */
7149 if (NILP (wait_for_cell
))
7151 EMACS_TIME timer_delay
;
7155 int old_timers_run
= timers_run
;
7156 timer_delay
= timer_check (1);
7157 if (timers_run
!= old_timers_run
&& do_display
)
7158 /* We must retry, since a timer may have requeued itself
7159 and that could alter the time delay. */
7160 redisplay_preserve_echo_area (14);
7164 while (!detect_input_pending ());
7166 /* If there is unread keyboard input, also return. */
7168 && requeued_events_pending_p ())
7171 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
7173 EMACS_TIME difference
;
7174 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
7175 if (EMACS_TIME_NEG_P (difference
))
7177 timeout
= timer_delay
;
7178 timeout_reduced_for_timers
= 1;
7183 /* Cause C-g and alarm signals to take immediate action,
7184 and cause input available signals to zero out timeout. */
7186 set_waiting_for_input (&timeout
);
7188 /* Wait till there is something to do. */
7190 if (! read_kbd
&& NILP (wait_for_cell
))
7191 FD_ZERO (&waitchannels
);
7193 FD_SET (0, &waitchannels
);
7195 /* If a frame has been newly mapped and needs updating,
7196 reprocess its display stuff. */
7197 if (frame_garbaged
&& do_display
)
7199 clear_waiting_for_input ();
7200 redisplay_preserve_echo_area (15);
7202 set_waiting_for_input (&timeout
);
7205 if (read_kbd
&& detect_input_pending ())
7208 FD_ZERO (&waitchannels
);
7211 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7216 /* Make C-g and alarm signals set flags again */
7217 clear_waiting_for_input ();
7219 /* If we woke up due to SIGWINCH, actually change size now. */
7220 do_pending_window_change (0);
7222 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7223 /* We waited the full specified time, so return now. */
7228 /* If the system call was interrupted, then go around the
7230 if (xerrno
== EINTR
)
7231 FD_ZERO (&waitchannels
);
7233 error ("select error: %s", emacs_strerror (xerrno
));
7236 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7237 /* System sometimes fails to deliver SIGIO. */
7238 kill (getpid (), SIGIO
);
7241 if (read_kbd
&& interrupt_input
&& (waitchannels
& 1))
7242 kill (getpid (), SIGIO
);
7245 /* Check for keyboard input */
7248 && detect_input_pending_run_timers (do_display
))
7250 swallow_events (do_display
);
7251 if (detect_input_pending_run_timers (do_display
))
7255 /* If there is unread keyboard input, also return. */
7257 && requeued_events_pending_p ())
7260 /* If wait_for_cell. check for keyboard input
7261 but don't run any timers.
7262 ??? (It seems wrong to me to check for keyboard
7263 input at all when wait_for_cell, but the code
7264 has been this way since July 1994.
7265 Try changing this after version 19.31.) */
7266 if (! NILP (wait_for_cell
)
7267 && detect_input_pending ())
7269 swallow_events (do_display
);
7270 if (detect_input_pending ())
7274 /* Exit now if the cell we're waiting for became non-nil. */
7275 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7285 /* Don't confuse make-docfile by having two doc strings for this function.
7286 make-docfile does not pay attention to #if, for good reason! */
7287 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7290 register Lisp_Object name
;
7295 /* Don't confuse make-docfile by having two doc strings for this function.
7296 make-docfile does not pay attention to #if, for good reason! */
7297 DEFUN ("process-inherit-coding-system-flag",
7298 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7302 register Lisp_Object process
;
7304 /* Ignore the argument and return the value of
7305 inherit-process-coding-system. */
7306 return inherit_process_coding_system
? Qt
: Qnil
;
7309 /* Kill all processes associated with `buffer'.
7310 If `buffer' is nil, kill all processes.
7311 Since we have no subprocesses, this does nothing. */
7314 kill_buffer_processes (buffer
)
7327 QCtype
= intern (":type");
7328 staticpro (&QCtype
);
7330 defsubr (&Sget_buffer_process
);
7331 defsubr (&Sprocess_inherit_coding_system_flag
);
7335 #endif /* not subprocesses */
7337 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7338 (do not change this comment) */