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 */
43 #ifdef HAVE_INTTYPES_H
50 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
53 #endif /* not WINDOWSNT */
55 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
56 #include <sys/socket.h>
58 #include <netinet/in.h>
59 #include <arpa/inet.h>
60 #ifdef NEED_NET_ERRNO_H
61 #include <net/errno.h>
62 #endif /* NEED_NET_ERRNO_H */
64 /* Are local (unix) sockets supported? */
65 #if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
66 #if !defined (AF_LOCAL) && defined (AF_UNIX)
67 #define AF_LOCAL AF_UNIX
70 #define HAVE_LOCAL_SOCKETS
74 #endif /* HAVE_SOCKETS */
76 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
81 /* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
82 #ifdef HAVE_BROKEN_INET_ADDR
83 #define IN_ADDR struct in_addr
84 #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
86 #define IN_ADDR unsigned long
87 #define NUMERIC_ADDR_ERROR (numeric_addr == -1)
90 #if defined(BSD_SYSTEM) || defined(STRIDE)
91 #include <sys/ioctl.h>
92 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
94 #endif /* HAVE_PTYS and no O_NDELAY */
95 #endif /* BSD_SYSTEM || STRIDE */
97 #ifdef BROKEN_O_NONBLOCK
99 #endif /* BROKEN_O_NONBLOCK */
105 /* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
107 #if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
108 /* sys/ioctl.h may have been included already */
110 #include <sys/ioctl.h>
117 #include <sys/sysmacros.h> /* for "minor" */
118 #endif /* not IRIS */
121 #include <sys/wait.h>
124 /* Disable IPv6 support for w32 until someone figures out how to do it
138 #include "character.h"
141 #include "termhooks.h"
142 #include "termopts.h"
143 #include "commands.h"
144 #include "keyboard.h"
146 #include "blockinput.h"
147 #include "dispextern.h"
148 #include "composite.h"
151 Lisp_Object Qprocessp
;
152 Lisp_Object Qrun
, Qstop
, Qsignal
;
153 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
154 Lisp_Object Qlocal
, Qipv4
, Qdatagram
;
158 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
159 Lisp_Object QClocal
, QCremote
, QCcoding
;
160 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
161 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
162 Lisp_Object QCfilter_multibyte
;
163 Lisp_Object Qlast_nonmenu_event
;
164 /* QCfamily is declared and initialized in xfaces.c,
165 QCfilter in keyboard.c. */
166 extern Lisp_Object QCfamily
, QCfilter
;
168 /* Qexit is declared and initialized in eval.c. */
170 /* QCfamily is defined in xfaces.c. */
171 extern Lisp_Object QCfamily
;
172 /* QCfilter is defined in keyboard.c. */
173 extern Lisp_Object QCfilter
;
175 /* a process object is a network connection when its childp field is neither
176 Qt nor Qnil but is instead a property list (KEY VAL ...). */
179 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
180 #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
182 #define NETCONN_P(p) 0
183 #define NETCONN1_P(p) 0
184 #endif /* HAVE_SOCKETS */
186 /* Define first descriptor number available for subprocesses. */
188 #define FIRST_PROC_DESC 1
190 #define FIRST_PROC_DESC 3
193 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
196 #if !defined (SIGCHLD) && defined (SIGCLD)
197 #define SIGCHLD SIGCLD
200 #include "syssignal.h"
204 extern char *get_operating_system_release ();
210 extern char *sys_errlist
[];
217 /* t means use pty, nil means use a pipe,
218 maybe other values to come. */
219 static Lisp_Object Vprocess_connection_type
;
223 #include <sys/socket.h>
227 /* These next two vars are non-static since sysdep.c uses them in the
228 emulation of `select'. */
229 /* Number of events of change of status of a process. */
231 /* Number of events for which the user or sentinel has been notified. */
234 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
236 #ifdef BROKEN_NON_BLOCKING_CONNECT
237 #undef NON_BLOCKING_CONNECT
239 #ifndef NON_BLOCKING_CONNECT
242 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
243 #if defined (O_NONBLOCK) || defined (O_NDELAY)
244 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
245 #define NON_BLOCKING_CONNECT
246 #endif /* EWOULDBLOCK || EINPROGRESS */
247 #endif /* O_NONBLOCK || O_NDELAY */
248 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
249 #endif /* HAVE_SELECT */
250 #endif /* HAVE_SOCKETS */
251 #endif /* NON_BLOCKING_CONNECT */
252 #endif /* BROKEN_NON_BLOCKING_CONNECT */
254 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
255 this system. We need to read full packets, so we need a
256 "non-destructive" select. So we require either native select,
257 or emulation of select using FIONREAD. */
259 #ifdef BROKEN_DATAGRAM_SOCKETS
260 #undef DATAGRAM_SOCKETS
262 #ifndef DATAGRAM_SOCKETS
264 #if defined (HAVE_SELECT) || defined (FIONREAD)
265 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
266 #define DATAGRAM_SOCKETS
267 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
268 #endif /* HAVE_SELECT || FIONREAD */
269 #endif /* HAVE_SOCKETS */
270 #endif /* DATAGRAM_SOCKETS */
271 #endif /* BROKEN_DATAGRAM_SOCKETS */
274 #undef NON_BLOCKING_CONNECT
275 #undef DATAGRAM_SOCKETS
278 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
279 #ifdef EMACS_HAS_USECS
280 #define ADAPTIVE_READ_BUFFERING
284 #ifdef ADAPTIVE_READ_BUFFERING
285 #define READ_OUTPUT_DELAY_INCREMENT 10000
286 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
287 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
289 /* Number of processes which have a non-zero read_output_delay,
290 and therefore might be delayed for adaptive read buffering. */
292 static int process_output_delay_count
;
294 /* Non-zero if any process has non-nil read_output_skip. */
296 static int process_output_skip
;
298 /* Non-nil means to delay reading process output to improve buffering.
299 A value of t means that delay is reset after each send, any other
300 non-nil value does not reset the delay. A value of nil disables
301 adaptive read buffering completely. */
302 static Lisp_Object Vprocess_adaptive_read_buffering
;
304 #define process_output_delay_count 0
308 #include "sysselect.h"
310 static int keyboard_bit_set
P_ ((SELECT_TYPE
*));
311 static void deactivate_process
P_ ((Lisp_Object
));
312 static void status_notify
P_ ((struct Lisp_Process
*));
313 static int read_process_output
P_ ((Lisp_Object
, int));
315 /* If we support a window system, turn on the code to poll periodically
316 to detect C-g. It isn't actually used when doing interrupt input. */
317 #ifdef HAVE_WINDOW_SYSTEM
318 #define POLL_FOR_INPUT
321 /* Mask of bits indicating the descriptors that we wait for input on. */
323 static SELECT_TYPE input_wait_mask
;
325 /* Mask that excludes keyboard input descriptor (s). */
327 static SELECT_TYPE non_keyboard_wait_mask
;
329 /* Mask that excludes process input descriptor (s). */
331 static SELECT_TYPE non_process_wait_mask
;
333 #ifdef NON_BLOCKING_CONNECT
334 /* Mask of bits indicating the descriptors that we wait for connect to
335 complete on. Once they complete, they are removed from this mask
336 and added to the input_wait_mask and non_keyboard_wait_mask. */
338 static SELECT_TYPE connect_wait_mask
;
340 /* Number of bits set in connect_wait_mask. */
341 static int num_pending_connects
;
343 #define IF_NON_BLOCKING_CONNECT(s) s
345 #define IF_NON_BLOCKING_CONNECT(s)
348 /* The largest descriptor currently in use for a process object. */
349 static int max_process_desc
;
351 /* The largest descriptor currently in use for keyboard input. */
352 static int max_keyboard_desc
;
354 /* Nonzero means delete a process right away if it exits. */
355 static int delete_exited_processes
;
357 /* Indexed by descriptor, gives the process (if any) for that descriptor */
358 Lisp_Object chan_process
[MAXDESC
];
360 /* Alist of elements (NAME . PROCESS) */
361 Lisp_Object Vprocess_alist
;
363 /* Buffered-ahead input char from process, indexed by channel.
364 -1 means empty (no char is buffered).
365 Used on sys V where the only way to tell if there is any
366 output from the process is to read at least one char.
367 Always -1 on systems that support FIONREAD. */
369 /* Don't make static; need to access externally. */
370 int proc_buffered_char
[MAXDESC
];
372 /* Table of `struct coding-system' for each process. */
373 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
374 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
376 #ifdef DATAGRAM_SOCKETS
377 /* Table of `partner address' for datagram sockets. */
378 struct sockaddr_and_len
{
381 } datagram_address
[MAXDESC
];
382 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
383 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
385 #define DATAGRAM_CHAN_P(chan) (0)
386 #define DATAGRAM_CONN_P(proc) (0)
389 static Lisp_Object
get_process ();
390 static void exec_sentinel ();
392 extern EMACS_TIME
timer_check ();
393 extern int timers_run
;
395 /* Maximum number of bytes to send to a pty without an eof. */
396 static int pty_max_bytes
;
402 /* The file name of the pty opened by allocate_pty. */
404 static char pty_name
[24];
407 /* Compute the Lisp form of the process status, p->status, from
408 the numeric status that was returned by `wait'. */
410 static Lisp_Object
status_convert ();
414 struct Lisp_Process
*p
;
416 union { int i
; WAITTYPE wt
; } u
;
417 u
.i
= XFASTINT (p
->raw_status_low
) + (XFASTINT (p
->raw_status_high
) << 16);
418 p
->status
= status_convert (u
.wt
);
419 p
->raw_status_low
= Qnil
;
420 p
->raw_status_high
= Qnil
;
423 /* Convert a process status word in Unix format to
424 the list that we use internally. */
431 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
432 else if (WIFEXITED (w
))
433 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
434 WCOREDUMP (w
) ? Qt
: Qnil
));
435 else if (WIFSIGNALED (w
))
436 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
437 WCOREDUMP (w
) ? Qt
: Qnil
));
442 /* Given a status-list, extract the three pieces of information
443 and store them individually through the three pointers. */
446 decode_status (l
, symbol
, code
, coredump
)
464 *code
= XFASTINT (XCAR (tem
));
466 *coredump
= !NILP (tem
);
470 /* Return a string describing a process status list. */
474 struct Lisp_Process
*p
;
476 Lisp_Object status
= p
->status
;
479 Lisp_Object string
, string2
;
481 decode_status (status
, &symbol
, &code
, &coredump
);
483 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
486 synchronize_system_messages_locale ();
487 signame
= strsignal (code
);
490 string
= build_string (signame
);
491 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
492 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
493 return concat2 (string
, string2
);
495 else if (EQ (symbol
, Qexit
))
498 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
500 return build_string ("finished\n");
501 string
= Fnumber_to_string (make_number (code
));
502 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
503 return concat3 (build_string ("exited abnormally with code "),
506 else if (EQ (symbol
, Qfailed
))
508 string
= Fnumber_to_string (make_number (code
));
509 string2
= build_string ("\n");
510 return concat3 (build_string ("failed with code "),
514 return Fcopy_sequence (Fsymbol_name (symbol
));
519 /* Open an available pty, returning a file descriptor.
520 Return -1 on failure.
521 The file name of the terminal corresponding to the pty
522 is left in the variable pty_name. */
533 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
534 for (i
= 0; i
< 16; i
++)
537 struct stat stb
; /* Used in some PTY_OPEN. */
538 #ifdef PTY_NAME_SPRINTF
541 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
542 #endif /* no PTY_NAME_SPRINTF */
546 #else /* no PTY_OPEN */
549 /* Unusual IRIS code */
550 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
553 if (fstat (fd
, &stb
) < 0)
555 # else /* not IRIS */
556 { /* Some systems name their pseudoterminals so that there are gaps in
557 the usual sequence - for example, on HP9000/S700 systems, there
558 are no pseudoterminals with names ending in 'f'. So we wait for
559 three failures in a row before deciding that we've reached the
561 int failed_count
= 0;
563 if (stat (pty_name
, &stb
) < 0)
566 if (failed_count
>= 3)
573 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
575 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
577 # endif /* not IRIS */
579 #endif /* no PTY_OPEN */
583 /* check to make certain that both sides are available
584 this avoids a nasty yet stupid bug in rlogins */
585 #ifdef PTY_TTY_NAME_SPRINTF
588 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
589 #endif /* no PTY_TTY_NAME_SPRINTF */
591 if (access (pty_name
, 6) != 0)
594 # if !defined(IRIS) && !defined(__sgi)
600 #endif /* not UNIPLUS */
607 #endif /* HAVE_PTYS */
613 register Lisp_Object val
, tem
, name1
;
614 register struct Lisp_Process
*p
;
618 p
= allocate_process ();
620 XSETINT (p
->infd
, -1);
621 XSETINT (p
->outfd
, -1);
622 XSETFASTINT (p
->pid
, 0);
623 XSETFASTINT (p
->tick
, 0);
624 XSETFASTINT (p
->update_tick
, 0);
625 p
->raw_status_low
= Qnil
;
626 p
->raw_status_high
= Qnil
;
628 p
->mark
= Fmake_marker ();
630 #ifdef ADAPTIVE_READ_BUFFERING
631 p
->adaptive_read_buffering
= Qnil
;
632 XSETFASTINT (p
->read_output_delay
, 0);
633 p
->read_output_skip
= Qnil
;
636 /* If name is already in use, modify it until it is unused. */
641 tem
= Fget_process (name1
);
642 if (NILP (tem
)) break;
643 sprintf (suffix
, "<%d>", i
);
644 name1
= concat2 (name
, build_string (suffix
));
648 XSETPROCESS (val
, p
);
649 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
654 remove_process (proc
)
655 register Lisp_Object proc
;
657 register Lisp_Object pair
;
659 pair
= Frassq (proc
, Vprocess_alist
);
660 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
662 deactivate_process (proc
);
665 /* Setup coding systems of PROCESS. */
668 setup_process_coding_systems (process
)
671 struct Lisp_Process
*p
= XPROCESS (process
);
672 int inch
= XINT (p
->infd
);
673 int outch
= XINT (p
->outfd
);
674 Lisp_Object coding_system
;
676 if (inch
< 0 || outch
< 0)
679 if (!proc_decode_coding_system
[inch
])
680 proc_decode_coding_system
[inch
]
681 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
682 coding_system
= p
->decode_coding_system
;
683 if (! NILP (p
->filter
))
685 if (NILP (p
->filter_multibyte
))
686 coding_system
= raw_text_coding_system (coding_system
);
688 else if (BUFFERP (p
->buffer
))
690 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
691 coding_system
= raw_text_coding_system (coding_system
);
693 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
695 if (!proc_encode_coding_system
[outch
])
696 proc_encode_coding_system
[outch
]
697 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
698 setup_coding_system (p
->encode_coding_system
,
699 proc_encode_coding_system
[outch
]);
702 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
703 doc
: /* Return t if OBJECT is a process. */)
707 return PROCESSP (object
) ? Qt
: Qnil
;
710 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
711 doc
: /* Return the process named NAME, or nil if there is none. */)
713 register Lisp_Object name
;
718 return Fcdr (Fassoc (name
, Vprocess_alist
));
721 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
722 doc
: /* Return the (or a) process associated with BUFFER.
723 BUFFER may be a buffer or the name of one. */)
725 register Lisp_Object buffer
;
727 register Lisp_Object buf
, tail
, proc
;
729 if (NILP (buffer
)) return Qnil
;
730 buf
= Fget_buffer (buffer
);
731 if (NILP (buf
)) return Qnil
;
733 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
735 proc
= Fcdr (Fcar (tail
));
736 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
742 /* This is how commands for the user decode process arguments. It
743 accepts a process, a process name, a buffer, a buffer name, or nil.
744 Buffers denote the first process in the buffer, and nil denotes the
749 register Lisp_Object name
;
751 register Lisp_Object proc
, obj
;
754 obj
= Fget_process (name
);
756 obj
= Fget_buffer (name
);
758 error ("Process %s does not exist", SDATA (name
));
760 else if (NILP (name
))
761 obj
= Fcurrent_buffer ();
765 /* Now obj should be either a buffer object or a process object.
769 proc
= Fget_buffer_process (obj
);
771 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
781 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
782 doc
: /* Delete PROCESS: kill it and forget about it immediately.
783 PROCESS may be a process, a buffer, the name of a process or buffer, or
784 nil, indicating the current buffer's process. */)
786 register Lisp_Object process
;
788 register struct Lisp_Process
*p
;
790 process
= get_process (process
);
791 p
= XPROCESS (process
);
793 p
->raw_status_low
= Qnil
;
794 p
->raw_status_high
= Qnil
;
797 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
798 XSETINT (p
->tick
, ++process_tick
);
801 else if (XINT (p
->infd
) >= 0)
803 Fkill_process (process
, Qnil
);
804 /* Do this now, since remove_process will make sigchld_handler do nothing. */
806 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
807 XSETINT (p
->tick
, ++process_tick
);
810 remove_process (process
);
814 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
815 doc
: /* Return the status of PROCESS.
816 The returned value is one of the following symbols:
817 run -- for a process that is running.
818 stop -- for a process stopped but continuable.
819 exit -- for a process that has exited.
820 signal -- for a process that has got a fatal signal.
821 open -- for a network stream connection that is open.
822 listen -- for a network stream server that is listening.
823 closed -- for a network stream connection that is closed.
824 connect -- when waiting for a non-blocking connection to complete.
825 failed -- when a non-blocking connection has failed.
826 nil -- if arg is a process name and no such process exists.
827 PROCESS may be a process, a buffer, the name of a process, or
828 nil, indicating the current buffer's process. */)
830 register Lisp_Object process
;
832 register struct Lisp_Process
*p
;
833 register Lisp_Object status
;
835 if (STRINGP (process
))
836 process
= Fget_process (process
);
838 process
= get_process (process
);
843 p
= XPROCESS (process
);
844 if (!NILP (p
->raw_status_low
))
848 status
= XCAR (status
);
851 if (EQ (status
, Qexit
))
853 else if (EQ (p
->command
, Qt
))
855 else if (EQ (status
, Qrun
))
861 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
863 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
864 If PROCESS has not yet exited or died, return 0. */)
866 register Lisp_Object process
;
868 CHECK_PROCESS (process
);
869 if (!NILP (XPROCESS (process
)->raw_status_low
))
870 update_status (XPROCESS (process
));
871 if (CONSP (XPROCESS (process
)->status
))
872 return XCAR (XCDR (XPROCESS (process
)->status
));
873 return make_number (0);
876 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
877 doc
: /* Return the process id of PROCESS.
878 This is the pid of the external process which PROCESS uses or talks to.
879 For a network connection, this value is nil. */)
881 register Lisp_Object process
;
883 CHECK_PROCESS (process
);
884 return XPROCESS (process
)->pid
;
887 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
888 doc
: /* Return the name of PROCESS, as a string.
889 This is the name of the program invoked in PROCESS,
890 possibly modified to make it unique among process names. */)
892 register Lisp_Object process
;
894 CHECK_PROCESS (process
);
895 return XPROCESS (process
)->name
;
898 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
899 doc
: /* Return the command that was executed to start PROCESS.
900 This is a list of strings, the first string being the program executed
901 and the rest of the strings being the arguments given to it.
902 For a non-child channel, this is nil. */)
904 register Lisp_Object process
;
906 CHECK_PROCESS (process
);
907 return XPROCESS (process
)->command
;
910 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
911 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
912 This is the terminal that the process itself reads and writes on,
913 not the name of the pty that Emacs uses to talk with that terminal. */)
915 register Lisp_Object process
;
917 CHECK_PROCESS (process
);
918 return XPROCESS (process
)->tty_name
;
921 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
923 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
925 register Lisp_Object process
, buffer
;
927 struct Lisp_Process
*p
;
929 CHECK_PROCESS (process
);
931 CHECK_BUFFER (buffer
);
932 p
= XPROCESS (process
);
935 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
936 setup_process_coding_systems (process
);
940 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
942 doc
: /* Return the buffer PROCESS is associated with.
943 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
945 register Lisp_Object process
;
947 CHECK_PROCESS (process
);
948 return XPROCESS (process
)->buffer
;
951 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
953 doc
: /* Return the marker for the end of the last output from PROCESS. */)
955 register Lisp_Object process
;
957 CHECK_PROCESS (process
);
958 return XPROCESS (process
)->mark
;
961 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
963 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
964 t means stop accepting output from the process.
966 When a process has a filter, its buffer is not used for output.
967 Instead, each time it does output, the entire string of output is
968 passed to the filter.
970 The filter gets two arguments: the process and the string of output.
971 The string argument is normally a multibyte string, except:
972 - if the process' input coding system is no-conversion or raw-text,
973 it is a unibyte string (the non-converted input), or else
974 - if `default-enable-multibyte-characters' is nil, it is a unibyte
975 string (the result of converting the decoded input multibyte
976 string to unibyte with `string-make-unibyte'). */)
978 register Lisp_Object process
, filter
;
980 struct Lisp_Process
*p
;
982 CHECK_PROCESS (process
);
983 p
= XPROCESS (process
);
985 /* Don't signal an error if the process' input file descriptor
986 is closed. This could make debugging Lisp more difficult,
987 for example when doing something like
989 (setq process (start-process ...))
991 (set-process-filter process ...) */
993 if (XINT (p
->infd
) >= 0)
995 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
997 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
998 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
1000 else if (EQ (p
->filter
, Qt
)
1001 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
1003 FD_SET (XINT (p
->infd
), &input_wait_mask
);
1004 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
1010 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
1011 setup_process_coding_systems (process
);
1015 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1017 doc
: /* Returns the filter function of PROCESS; nil if none.
1018 See `set-process-filter' for more info on filter functions. */)
1020 register Lisp_Object process
;
1022 CHECK_PROCESS (process
);
1023 return XPROCESS (process
)->filter
;
1026 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1028 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1029 The sentinel is called as a function when the process changes state.
1030 It gets two arguments: the process, and a string describing the change. */)
1032 register Lisp_Object process
, sentinel
;
1034 struct Lisp_Process
*p
;
1036 CHECK_PROCESS (process
);
1037 p
= XPROCESS (process
);
1039 p
->sentinel
= sentinel
;
1041 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1045 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1047 doc
: /* Return the sentinel of PROCESS; nil if none.
1048 See `set-process-sentinel' for more info on sentinels. */)
1050 register Lisp_Object process
;
1052 CHECK_PROCESS (process
);
1053 return XPROCESS (process
)->sentinel
;
1056 DEFUN ("set-process-window-size", Fset_process_window_size
,
1057 Sset_process_window_size
, 3, 3, 0,
1058 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1059 (process
, height
, width
)
1060 register Lisp_Object process
, height
, width
;
1062 CHECK_PROCESS (process
);
1063 CHECK_NATNUM (height
);
1064 CHECK_NATNUM (width
);
1066 if (XINT (XPROCESS (process
)->infd
) < 0
1067 || set_window_size (XINT (XPROCESS (process
)->infd
),
1068 XINT (height
), XINT (width
)) <= 0)
1074 DEFUN ("set-process-inherit-coding-system-flag",
1075 Fset_process_inherit_coding_system_flag
,
1076 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1077 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1078 If the second argument FLAG is non-nil, then the variable
1079 `buffer-file-coding-system' of the buffer associated with PROCESS
1080 will be bound to the value of the coding system used to decode
1083 This is useful when the coding system specified for the process buffer
1084 leaves either the character code conversion or the end-of-line conversion
1085 unspecified, or if the coding system used to decode the process output
1086 is more appropriate for saving the process buffer.
1088 Binding the variable `inherit-process-coding-system' to non-nil before
1089 starting the process is an alternative way of setting the inherit flag
1090 for the process which will run. */)
1092 register Lisp_Object process
, flag
;
1094 CHECK_PROCESS (process
);
1095 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
1099 DEFUN ("process-inherit-coding-system-flag",
1100 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1102 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1103 If this flag is t, `buffer-file-coding-system' of the buffer
1104 associated with PROCESS will inherit the coding system used to decode
1105 the process output. */)
1107 register Lisp_Object process
;
1109 CHECK_PROCESS (process
);
1110 return XPROCESS (process
)->inherit_coding_system_flag
;
1113 DEFUN ("set-process-query-on-exit-flag",
1114 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1116 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1117 If the second argument FLAG is non-nil, Emacs will query the user before
1118 exiting if PROCESS is running. */)
1120 register Lisp_Object process
, flag
;
1122 CHECK_PROCESS (process
);
1123 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
1127 DEFUN ("process-query-on-exit-flag",
1128 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1130 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1132 register Lisp_Object process
;
1134 CHECK_PROCESS (process
);
1135 return Fnull (XPROCESS (process
)->kill_without_query
);
1138 #ifdef DATAGRAM_SOCKETS
1139 Lisp_Object
Fprocess_datagram_address ();
1142 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1144 doc
: /* Return the contact info of PROCESS; t for a real child.
1145 For a net connection, the value depends on the optional KEY arg.
1146 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1147 if KEY is t, the complete contact information for the connection is
1148 returned, else the specific value for the keyword KEY is returned.
1149 See `make-network-process' for a list of keywords. */)
1151 register Lisp_Object process
, key
;
1153 Lisp_Object contact
;
1155 CHECK_PROCESS (process
);
1156 contact
= XPROCESS (process
)->childp
;
1158 #ifdef DATAGRAM_SOCKETS
1159 if (DATAGRAM_CONN_P (process
)
1160 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1161 contact
= Fplist_put (contact
, QCremote
,
1162 Fprocess_datagram_address (process
));
1165 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1168 return Fcons (Fplist_get (contact
, QChost
),
1169 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1170 return Fplist_get (contact
, key
);
1173 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1175 doc
: /* Return the plist of PROCESS. */)
1177 register Lisp_Object process
;
1179 CHECK_PROCESS (process
);
1180 return XPROCESS (process
)->plist
;
1183 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1185 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1187 register Lisp_Object process
, plist
;
1189 CHECK_PROCESS (process
);
1192 XPROCESS (process
)->plist
= plist
;
1196 #if 0 /* Turned off because we don't currently record this info
1197 in the process. Perhaps add it. */
1198 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1199 doc
: /* Return the connection type of PROCESS.
1200 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1201 a socket connection. */)
1203 Lisp_Object process
;
1205 return XPROCESS (process
)->type
;
1210 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1212 doc
: /* Convert network ADDRESS from internal format to a string.
1213 A 4 or 5 element vector represents an IPv4 address (with port number).
1214 An 8 or 9 element vector represents an IPv6 address (with port number).
1215 If optional second argument OMIT-PORT is non-nil, don't include a port
1216 number in the string, even when present in ADDRESS.
1217 Returns nil if format of ADDRESS is invalid. */)
1218 (address
, omit_port
)
1219 Lisp_Object address
, omit_port
;
1224 if (STRINGP (address
)) /* AF_LOCAL */
1227 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1229 register struct Lisp_Vector
*p
= XVECTOR (address
);
1230 Lisp_Object args
[6];
1233 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1235 args
[0] = build_string ("%d.%d.%d.%d");
1238 else if (p
->size
== 5)
1240 args
[0] = build_string ("%d.%d.%d.%d:%d");
1243 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1245 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1248 else if (p
->size
== 9)
1250 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1256 for (i
= 0; i
< nargs
; i
++)
1257 args
[i
+1] = p
->contents
[i
];
1258 return Fformat (nargs
+1, args
);
1261 if (CONSP (address
))
1263 Lisp_Object args
[2];
1264 args
[0] = build_string ("<Family %d>");
1265 args
[1] = Fcar (address
);
1266 return Fformat (2, args
);
1275 list_processes_1 (query_only
)
1276 Lisp_Object query_only
;
1278 register Lisp_Object tail
, tem
;
1279 Lisp_Object proc
, minspace
, tem1
;
1280 register struct Lisp_Process
*p
;
1282 int w_proc
, w_buffer
, w_tty
;
1283 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1285 w_proc
= 4; /* Proc */
1286 w_buffer
= 6; /* Buffer */
1287 w_tty
= 0; /* Omit if no ttys */
1289 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1293 proc
= Fcdr (Fcar (tail
));
1294 p
= XPROCESS (proc
);
1295 if (NILP (p
->childp
))
1297 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1299 if (STRINGP (p
->name
)
1300 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1302 if (!NILP (p
->buffer
))
1304 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1305 w_buffer
= 8; /* (Killed) */
1306 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1309 if (STRINGP (p
->tty_name
)
1310 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1314 XSETFASTINT (i_status
, w_proc
+ 1);
1315 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1318 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1319 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1322 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1325 XSETFASTINT (minspace
, 1);
1327 set_buffer_internal (XBUFFER (Vstandard_output
));
1328 current_buffer
->undo_list
= Qt
;
1330 current_buffer
->truncate_lines
= Qt
;
1332 write_string ("Proc", -1);
1333 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1334 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1337 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1339 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1340 write_string ("\n", -1);
1342 write_string ("----", -1);
1343 Findent_to (i_status
, minspace
); write_string ("------", -1);
1344 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1347 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1349 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1350 write_string ("\n", -1);
1352 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1356 proc
= Fcdr (Fcar (tail
));
1357 p
= XPROCESS (proc
);
1358 if (NILP (p
->childp
))
1360 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1363 Finsert (1, &p
->name
);
1364 Findent_to (i_status
, minspace
);
1366 if (!NILP (p
->raw_status_low
))
1369 if (CONSP (p
->status
))
1370 symbol
= XCAR (p
->status
);
1373 if (EQ (symbol
, Qsignal
))
1376 tem
= Fcar (Fcdr (p
->status
));
1378 if (XINT (tem
) < NSIG
)
1379 write_string (sys_errlist
[XINT (tem
)], -1);
1382 Fprinc (symbol
, Qnil
);
1384 else if (NETCONN1_P (p
))
1386 if (EQ (symbol
, Qexit
))
1387 write_string ("closed", -1);
1388 else if (EQ (p
->command
, Qt
))
1389 write_string ("stopped", -1);
1390 else if (EQ (symbol
, Qrun
))
1391 write_string ("open", -1);
1393 Fprinc (symbol
, Qnil
);
1396 Fprinc (symbol
, Qnil
);
1398 if (EQ (symbol
, Qexit
))
1401 tem
= Fcar (Fcdr (p
->status
));
1404 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1405 write_string (tembuf
, -1);
1409 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
1410 remove_process (proc
);
1412 Findent_to (i_buffer
, minspace
);
1413 if (NILP (p
->buffer
))
1414 insert_string ("(none)");
1415 else if (NILP (XBUFFER (p
->buffer
)->name
))
1416 insert_string ("(Killed)");
1418 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1422 Findent_to (i_tty
, minspace
);
1423 if (STRINGP (p
->tty_name
))
1424 Finsert (1, &p
->tty_name
);
1427 Findent_to (i_command
, minspace
);
1429 if (EQ (p
->status
, Qlisten
))
1431 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1432 if (INTEGERP (port
))
1433 port
= Fnumber_to_string (port
);
1435 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1436 sprintf (tembuf
, "(network %s server on %s)\n",
1437 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1438 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1439 insert_string (tembuf
);
1441 else if (NETCONN1_P (p
))
1443 /* For a local socket, there is no host name,
1444 so display service instead. */
1445 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1446 if (!STRINGP (host
))
1448 host
= Fplist_get (p
->childp
, QCservice
);
1449 if (INTEGERP (host
))
1450 host
= Fnumber_to_string (host
);
1453 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1454 sprintf (tembuf
, "(network %s connection to %s)\n",
1455 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1456 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1457 insert_string (tembuf
);
1469 insert_string (" ");
1471 insert_string ("\n");
1477 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1478 doc
: /* Display a list of all processes.
1479 If optional argument QUERY-ONLY is non-nil, only processes with
1480 the query-on-exit flag set will be listed.
1481 Any process listed as exited or signaled is actually eliminated
1482 after the listing is made. */)
1484 Lisp_Object query_only
;
1486 internal_with_output_to_temp_buffer ("*Process List*",
1487 list_processes_1
, query_only
);
1491 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1492 doc
: /* Return a list of all processes. */)
1495 return Fmapcar (Qcdr
, Vprocess_alist
);
1498 /* Starting asynchronous inferior processes. */
1500 static Lisp_Object
start_process_unwind ();
1502 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1503 doc
: /* Start a program in a subprocess. Return the process object for it.
1504 NAME is name for process. It is modified if necessary to make it unique.
1505 BUFFER is the buffer (or buffer name) to associate with the process.
1506 Process output goes at end of that buffer, unless you specify
1507 an output stream or filter function to handle the output.
1508 BUFFER may be also nil, meaning that this process is not associated
1510 PROGRAM is the program file name. It is searched for in PATH.
1511 Remaining arguments are strings to give program as arguments.
1513 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1516 register Lisp_Object
*args
;
1518 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1520 register unsigned char *new_argv
;
1523 register unsigned char **new_argv
;
1526 int count
= SPECPDL_INDEX ();
1530 buffer
= Fget_buffer_create (buffer
);
1532 /* Make sure that the child will be able to chdir to the current
1533 buffer's current directory, or its unhandled equivalent. We
1534 can't just have the child check for an error when it does the
1535 chdir, since it's in a vfork.
1537 We have to GCPRO around this because Fexpand_file_name and
1538 Funhandled_file_name_directory might call a file name handling
1539 function. The argument list is protected by the caller, so all
1540 we really have to worry about is buffer. */
1542 struct gcpro gcpro1
, gcpro2
;
1544 current_dir
= current_buffer
->directory
;
1546 GCPRO2 (buffer
, current_dir
);
1549 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1551 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1552 report_file_error ("Setting current directory",
1553 Fcons (current_buffer
->directory
, Qnil
));
1559 CHECK_STRING (name
);
1563 CHECK_STRING (program
);
1565 proc
= make_process (name
);
1566 /* If an error occurs and we can't start the process, we want to
1567 remove it from the process list. This means that each error
1568 check in create_process doesn't need to call remove_process
1569 itself; it's all taken care of here. */
1570 record_unwind_protect (start_process_unwind
, proc
);
1572 XPROCESS (proc
)->childp
= Qt
;
1573 XPROCESS (proc
)->plist
= Qnil
;
1574 XPROCESS (proc
)->buffer
= buffer
;
1575 XPROCESS (proc
)->sentinel
= Qnil
;
1576 XPROCESS (proc
)->filter
= Qnil
;
1577 XPROCESS (proc
)->filter_multibyte
1578 = buffer_defaults
.enable_multibyte_characters
;
1579 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1581 #ifdef ADAPTIVE_READ_BUFFERING
1582 XPROCESS (proc
)->adaptive_read_buffering
= Vprocess_adaptive_read_buffering
;
1585 /* Make the process marker point into the process buffer (if any). */
1587 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1588 BUF_ZV (XBUFFER (buffer
)),
1589 BUF_ZV_BYTE (XBUFFER (buffer
)));
1592 /* Decide coding systems for communicating with the process. Here
1593 we don't setup the structure coding_system nor pay attention to
1594 unibyte mode. They are done in create_process. */
1596 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1597 Lisp_Object coding_systems
= Qt
;
1598 Lisp_Object val
, *args2
;
1599 struct gcpro gcpro1
, gcpro2
;
1601 val
= Vcoding_system_for_read
;
1604 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1605 args2
[0] = Qstart_process
;
1606 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1607 GCPRO2 (proc
, current_dir
);
1608 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1610 if (CONSP (coding_systems
))
1611 val
= XCAR (coding_systems
);
1612 else if (CONSP (Vdefault_process_coding_system
))
1613 val
= XCAR (Vdefault_process_coding_system
);
1615 XPROCESS (proc
)->decode_coding_system
= val
;
1617 val
= Vcoding_system_for_write
;
1620 if (EQ (coding_systems
, Qt
))
1622 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1623 args2
[0] = Qstart_process
;
1624 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1625 GCPRO2 (proc
, current_dir
);
1626 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1629 if (CONSP (coding_systems
))
1630 val
= XCDR (coding_systems
);
1631 else if (CONSP (Vdefault_process_coding_system
))
1632 val
= XCDR (Vdefault_process_coding_system
);
1634 XPROCESS (proc
)->encode_coding_system
= val
;
1638 /* Make a one member argv with all args concatenated
1639 together separated by a blank. */
1640 len
= SBYTES (program
) + 2;
1641 for (i
= 3; i
< nargs
; i
++)
1645 len
+= SBYTES (tem
) + 1; /* count the blank */
1647 new_argv
= (unsigned char *) alloca (len
);
1648 strcpy (new_argv
, SDATA (program
));
1649 for (i
= 3; i
< nargs
; i
++)
1653 strcat (new_argv
, " ");
1654 strcat (new_argv
, SDATA (tem
));
1656 /* Need to add code here to check for program existence on VMS */
1659 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1661 /* If program file name is not absolute, search our path for it.
1662 Put the name we will really use in TEM. */
1663 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1664 && !(SCHARS (program
) > 1
1665 && IS_DEVICE_SEP (SREF (program
, 1))))
1667 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1670 GCPRO4 (name
, program
, buffer
, current_dir
);
1671 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1674 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1675 tem
= Fexpand_file_name (tem
, Qnil
);
1679 if (!NILP (Ffile_directory_p (program
)))
1680 error ("Specified program for new process is a directory");
1684 /* If program file name starts with /: for quoting a magic name,
1686 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1687 && SREF (tem
, 1) == ':')
1688 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1690 /* Encode the file name and put it in NEW_ARGV.
1691 That's where the child will use it to execute the program. */
1692 tem
= ENCODE_FILE (tem
);
1693 new_argv
[0] = SDATA (tem
);
1695 /* Here we encode arguments by the coding system used for sending
1696 data to the process. We don't support using different coding
1697 systems for encoding arguments and for encoding data sent to the
1700 for (i
= 3; i
< nargs
; i
++)
1704 if (STRING_MULTIBYTE (tem
))
1705 tem
= (code_convert_string_norecord
1706 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1707 new_argv
[i
- 2] = SDATA (tem
);
1709 new_argv
[i
- 2] = 0;
1710 #endif /* not VMS */
1712 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1713 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1714 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1715 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1717 XPROCESS (proc
)->inherit_coding_system_flag
1718 = (NILP (buffer
) || !inherit_process_coding_system
1721 create_process (proc
, (char **) new_argv
, current_dir
);
1723 return unbind_to (count
, proc
);
1726 /* This function is the unwind_protect form for Fstart_process. If
1727 PROC doesn't have its pid set, then we know someone has signaled
1728 an error and the process wasn't started successfully, so we should
1729 remove it from the process list. */
1731 start_process_unwind (proc
)
1734 if (!PROCESSP (proc
))
1737 /* Was PROC started successfully? */
1738 if (XINT (XPROCESS (proc
)->pid
) <= 0)
1739 remove_process (proc
);
1745 create_process_1 (timer
)
1746 struct atimer
*timer
;
1748 /* Nothing to do. */
1752 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1755 /* Mimic blocking of signals on system V, which doesn't really have it. */
1757 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1758 int sigchld_deferred
;
1761 create_process_sigchld ()
1763 signal (SIGCHLD
, create_process_sigchld
);
1765 sigchld_deferred
= 1;
1771 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1773 create_process (process
, new_argv
, current_dir
)
1774 Lisp_Object process
;
1776 Lisp_Object current_dir
;
1778 int pid
, inchannel
, outchannel
;
1780 #ifdef POSIX_SIGNALS
1783 struct sigaction sigint_action
;
1784 struct sigaction sigquit_action
;
1786 struct sigaction sighup_action
;
1788 #else /* !POSIX_SIGNALS */
1791 SIGTYPE (*sigchld
)();
1794 #endif /* !POSIX_SIGNALS */
1795 /* Use volatile to protect variables from being clobbered by longjmp. */
1796 volatile int forkin
, forkout
;
1797 volatile int pty_flag
= 0;
1799 extern char **environ
;
1802 inchannel
= outchannel
= -1;
1805 if (!NILP (Vprocess_connection_type
))
1806 outchannel
= inchannel
= allocate_pty ();
1810 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1811 /* On most USG systems it does not work to open the pty's tty here,
1812 then close it and reopen it in the child. */
1814 /* Don't let this terminal become our controlling terminal
1815 (in case we don't have one). */
1816 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1818 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1821 report_file_error ("Opening pty", Qnil
);
1822 #if defined (RTU) || defined (UNIPLUS) || defined (DONT_REOPEN_PTY)
1823 /* In the case that vfork is defined as fork, the parent process
1824 (Emacs) may send some data before the child process completes
1825 tty options setup. So we setup tty before forking. */
1826 child_setup_tty (forkout
);
1827 #endif /* RTU or UNIPLUS or DONT_REOPEN_PTY */
1829 forkin
= forkout
= -1;
1830 #endif /* not USG, or USG_SUBTTY_WORKS */
1834 #endif /* HAVE_PTYS */
1837 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1838 report_file_error ("Opening socketpair", Qnil
);
1839 outchannel
= inchannel
= sv
[0];
1840 forkout
= forkin
= sv
[1];
1842 #else /* not SKTPAIR */
1847 report_file_error ("Creating pipe", Qnil
);
1853 emacs_close (inchannel
);
1854 emacs_close (forkout
);
1855 report_file_error ("Creating pipe", Qnil
);
1860 #endif /* not SKTPAIR */
1863 /* Replaced by close_process_descs */
1864 set_exclusive_use (inchannel
);
1865 set_exclusive_use (outchannel
);
1868 /* Stride people say it's a mystery why this is needed
1869 as well as the O_NDELAY, but that it fails without this. */
1870 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1873 ioctl (inchannel
, FIONBIO
, &one
);
1878 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1879 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1882 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1883 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1887 /* Record this as an active process, with its channels.
1888 As a result, child_setup will close Emacs's side of the pipes. */
1889 chan_process
[inchannel
] = process
;
1890 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1891 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1893 /* Previously we recorded the tty descriptor used in the subprocess.
1894 It was only used for getting the foreground tty process, so now
1895 we just reopen the device (see emacs_get_tty_pgrp) as this is
1896 more portable (see USG_SUBTTY_WORKS above). */
1898 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1899 XPROCESS (process
)->status
= Qrun
;
1900 setup_process_coding_systems (process
);
1902 /* Delay interrupts until we have a chance to store
1903 the new fork's pid in its process structure */
1904 #ifdef POSIX_SIGNALS
1905 sigemptyset (&blocked
);
1907 sigaddset (&blocked
, SIGCHLD
);
1909 #ifdef HAVE_WORKING_VFORK
1910 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1911 this sets the parent's signal handlers as well as the child's.
1912 So delay all interrupts whose handlers the child might munge,
1913 and record the current handlers so they can be restored later. */
1914 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1915 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1917 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1919 #endif /* HAVE_WORKING_VFORK */
1920 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1921 #else /* !POSIX_SIGNALS */
1925 #else /* not BSD4_1 */
1926 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1927 sigsetmask (sigmask (SIGCHLD
));
1928 #else /* ordinary USG */
1930 sigchld_deferred
= 0;
1931 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1933 #endif /* ordinary USG */
1934 #endif /* not BSD4_1 */
1935 #endif /* SIGCHLD */
1936 #endif /* !POSIX_SIGNALS */
1938 FD_SET (inchannel
, &input_wait_mask
);
1939 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1940 if (inchannel
> max_process_desc
)
1941 max_process_desc
= inchannel
;
1943 /* Until we store the proper pid, enable sigchld_handler
1944 to recognize an unknown pid as standing for this process.
1945 It is very important not to let this `marker' value stay
1946 in the table after this function has returned; if it does
1947 it might cause call-process to hang and subsequent asynchronous
1948 processes to get their return values scrambled. */
1949 XSETINT (XPROCESS (process
)->pid
, -1);
1954 /* child_setup must clobber environ on systems with true vfork.
1955 Protect it from permanent change. */
1956 char **save_environ
= environ
;
1958 current_dir
= ENCODE_FILE (current_dir
);
1963 #endif /* not WINDOWSNT */
1965 int xforkin
= forkin
;
1966 int xforkout
= forkout
;
1968 #if 0 /* This was probably a mistake--it duplicates code later on,
1969 but fails to handle all the cases. */
1970 /* Make sure SIGCHLD is not blocked in the child. */
1971 sigsetmask (SIGEMPTYMASK
);
1974 /* Make the pty be the controlling terminal of the process. */
1976 /* First, disconnect its current controlling terminal. */
1978 /* We tried doing setsid only if pty_flag, but it caused
1979 process_set_signal to fail on SGI when using a pipe. */
1981 /* Make the pty's terminal the controlling terminal. */
1985 /* We ignore the return value
1986 because faith@cs.unc.edu says that is necessary on Linux. */
1987 ioctl (xforkin
, TIOCSCTTY
, 0);
1990 #else /* not HAVE_SETSID */
1992 /* It's very important to call setpgrp here and no time
1993 afterwards. Otherwise, we lose our controlling tty which
1994 is set when we open the pty. */
1997 #endif /* not HAVE_SETSID */
1998 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1999 if (pty_flag
&& xforkin
>= 0)
2002 tcgetattr (xforkin
, &t
);
2004 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
2005 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
2008 #if defined (NTTYDISC) && defined (TIOCSETD)
2009 if (pty_flag
&& xforkin
>= 0)
2011 /* Use new line discipline. */
2012 int ldisc
= NTTYDISC
;
2013 ioctl (xforkin
, TIOCSETD
, &ldisc
);
2018 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2019 can do TIOCSPGRP only to the process's controlling tty. */
2022 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2023 I can't test it since I don't have 4.3. */
2024 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
2025 ioctl (j
, TIOCNOTTY
, 0);
2028 /* In order to get a controlling terminal on some versions
2029 of BSD, it is necessary to put the process in pgrp 0
2030 before it opens the terminal. */
2038 #endif /* TIOCNOTTY */
2040 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2041 /*** There is a suggestion that this ought to be a
2042 conditional on TIOCSPGRP,
2043 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2044 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2045 that system does seem to need this code, even though
2046 both HAVE_SETSID and TIOCSCTTY are defined. */
2047 /* Now close the pty (if we had it open) and reopen it.
2048 This makes the pty the controlling terminal of the subprocess. */
2051 #ifdef SET_CHILD_PTY_PGRP
2052 int pgrp
= getpid ();
2055 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2058 emacs_close (xforkin
);
2059 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2063 emacs_write (1, "Couldn't open the pty terminal ", 31);
2064 emacs_write (1, pty_name
, strlen (pty_name
));
2065 emacs_write (1, "\n", 1);
2069 #ifdef SET_CHILD_PTY_PGRP
2070 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
2071 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
2074 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
2076 #ifdef SETUP_SLAVE_PTY
2081 #endif /* SETUP_SLAVE_PTY */
2083 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2084 Now reenable it in the child, so it will die when we want it to. */
2086 signal (SIGHUP
, SIG_DFL
);
2088 #endif /* HAVE_PTYS */
2090 signal (SIGINT
, SIG_DFL
);
2091 signal (SIGQUIT
, SIG_DFL
);
2093 /* Stop blocking signals in the child. */
2094 #ifdef POSIX_SIGNALS
2095 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2096 #else /* !POSIX_SIGNALS */
2100 #else /* not BSD4_1 */
2101 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2102 sigsetmask (SIGEMPTYMASK
);
2103 #else /* ordinary USG */
2105 signal (SIGCHLD
, sigchld
);
2107 #endif /* ordinary USG */
2108 #endif /* not BSD4_1 */
2109 #endif /* SIGCHLD */
2110 #endif /* !POSIX_SIGNALS */
2112 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2114 child_setup_tty (xforkout
);
2115 #endif /* not RTU and not UNIPLUS and not DONT_REOPEN_PTY */
2117 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2118 new_argv
, 1, current_dir
);
2119 #else /* not WINDOWSNT */
2120 child_setup (xforkin
, xforkout
, xforkout
,
2121 new_argv
, 1, current_dir
);
2122 #endif /* not WINDOWSNT */
2124 environ
= save_environ
;
2129 /* This runs in the Emacs process. */
2133 emacs_close (forkin
);
2134 if (forkin
!= forkout
&& forkout
>= 0)
2135 emacs_close (forkout
);
2139 /* vfork succeeded. */
2140 XSETFASTINT (XPROCESS (process
)->pid
, pid
);
2143 register_child (pid
, inchannel
);
2144 #endif /* WINDOWSNT */
2146 /* If the subfork execv fails, and it exits,
2147 this close hangs. I don't know why.
2148 So have an interrupt jar it loose. */
2150 struct atimer
*timer
;
2154 EMACS_SET_SECS_USECS (offset
, 1, 0);
2155 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2158 emacs_close (forkin
);
2160 cancel_atimer (timer
);
2164 if (forkin
!= forkout
&& forkout
>= 0)
2165 emacs_close (forkout
);
2169 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2172 XPROCESS (process
)->tty_name
= Qnil
;
2175 /* Restore the signal state whether vfork succeeded or not.
2176 (We will signal an error, below, if it failed.) */
2177 #ifdef POSIX_SIGNALS
2178 #ifdef HAVE_WORKING_VFORK
2179 /* Restore the parent's signal handlers. */
2180 sigaction (SIGINT
, &sigint_action
, 0);
2181 sigaction (SIGQUIT
, &sigquit_action
, 0);
2183 sigaction (SIGHUP
, &sighup_action
, 0);
2185 #endif /* HAVE_WORKING_VFORK */
2186 /* Stop blocking signals in the parent. */
2187 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2188 #else /* !POSIX_SIGNALS */
2192 #else /* not BSD4_1 */
2193 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2194 sigsetmask (SIGEMPTYMASK
);
2195 #else /* ordinary USG */
2197 signal (SIGCHLD
, sigchld
);
2198 /* Now really handle any of these signals
2199 that came in during this function. */
2200 if (sigchld_deferred
)
2201 kill (getpid (), SIGCHLD
);
2203 #endif /* ordinary USG */
2204 #endif /* not BSD4_1 */
2205 #endif /* SIGCHLD */
2206 #endif /* !POSIX_SIGNALS */
2208 /* Now generate the error if vfork failed. */
2210 report_file_error ("Doing vfork", Qnil
);
2212 #endif /* not VMS */
2217 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2218 The address family of sa is not included in the result. */
2221 conv_sockaddr_to_lisp (sa
, len
)
2222 struct sockaddr
*sa
;
2225 Lisp_Object address
;
2228 register struct Lisp_Vector
*p
;
2230 switch (sa
->sa_family
)
2234 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2235 len
= sizeof (sin
->sin_addr
) + 1;
2236 address
= Fmake_vector (make_number (len
), Qnil
);
2237 p
= XVECTOR (address
);
2238 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2239 cp
= (unsigned char *)&sin
->sin_addr
;
2245 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2246 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2247 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2248 address
= Fmake_vector (make_number (len
), Qnil
);
2249 p
= XVECTOR (address
);
2250 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2251 for (i
= 0; i
< len
; i
++)
2252 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2256 #ifdef HAVE_LOCAL_SOCKETS
2259 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2260 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2261 if (sockun
->sun_path
[i
] == 0)
2263 return make_unibyte_string (sockun
->sun_path
, i
);
2267 len
-= sizeof (sa
->sa_family
);
2268 address
= Fcons (make_number (sa
->sa_family
),
2269 Fmake_vector (make_number (len
), Qnil
));
2270 p
= XVECTOR (XCDR (address
));
2271 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2277 p
->contents
[i
++] = make_number (*cp
++);
2283 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2286 get_lisp_to_sockaddr_size (address
, familyp
)
2287 Lisp_Object address
;
2290 register struct Lisp_Vector
*p
;
2292 if (VECTORP (address
))
2294 p
= XVECTOR (address
);
2298 return sizeof (struct sockaddr_in
);
2301 else if (p
->size
== 9)
2303 *familyp
= AF_INET6
;
2304 return sizeof (struct sockaddr_in6
);
2308 #ifdef HAVE_LOCAL_SOCKETS
2309 else if (STRINGP (address
))
2311 *familyp
= AF_LOCAL
;
2312 return sizeof (struct sockaddr_un
);
2315 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2317 struct sockaddr
*sa
;
2318 *familyp
= XINT (XCAR (address
));
2319 p
= XVECTOR (XCDR (address
));
2320 return p
->size
+ sizeof (sa
->sa_family
);
2325 /* Convert an address object (vector or string) to an internal sockaddr.
2326 Format of address has already been validated by size_lisp_to_sockaddr. */
2329 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2331 Lisp_Object address
;
2332 struct sockaddr
*sa
;
2335 register struct Lisp_Vector
*p
;
2336 register unsigned char *cp
= NULL
;
2340 sa
->sa_family
= family
;
2342 if (VECTORP (address
))
2344 p
= XVECTOR (address
);
2345 if (family
== AF_INET
)
2347 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2348 len
= sizeof (sin
->sin_addr
) + 1;
2349 i
= XINT (p
->contents
[--len
]);
2350 sin
->sin_port
= htons (i
);
2351 cp
= (unsigned char *)&sin
->sin_addr
;
2354 else if (family
== AF_INET6
)
2356 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2357 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2358 len
= sizeof (sin6
->sin6_addr
) + 1;
2359 i
= XINT (p
->contents
[--len
]);
2360 sin6
->sin6_port
= htons (i
);
2361 for (i
= 0; i
< len
; i
++)
2362 if (INTEGERP (p
->contents
[i
]))
2364 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2371 else if (STRINGP (address
))
2373 #ifdef HAVE_LOCAL_SOCKETS
2374 if (family
== AF_LOCAL
)
2376 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2377 cp
= SDATA (address
);
2378 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2379 sockun
->sun_path
[i
] = *cp
++;
2386 p
= XVECTOR (XCDR (address
));
2387 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2390 for (i
= 0; i
< len
; i
++)
2391 if (INTEGERP (p
->contents
[i
]))
2392 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2395 #ifdef DATAGRAM_SOCKETS
2396 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2398 doc
: /* Get the current datagram address associated with PROCESS. */)
2400 Lisp_Object process
;
2404 CHECK_PROCESS (process
);
2406 if (!DATAGRAM_CONN_P (process
))
2409 channel
= XINT (XPROCESS (process
)->infd
);
2410 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2411 datagram_address
[channel
].len
);
2414 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2416 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2417 Returns nil upon error setting address, ADDRESS otherwise. */)
2419 Lisp_Object process
, address
;
2424 CHECK_PROCESS (process
);
2426 if (!DATAGRAM_CONN_P (process
))
2429 channel
= XINT (XPROCESS (process
)->infd
);
2431 len
= get_lisp_to_sockaddr_size (address
, &family
);
2432 if (datagram_address
[channel
].len
!= len
)
2434 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2440 static struct socket_options
{
2441 /* The name of this option. Should be lowercase version of option
2442 name without SO_ prefix. */
2444 /* Option level SOL_... */
2446 /* Option number SO_... */
2448 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2449 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2450 } socket_options
[] =
2452 #ifdef SO_BINDTODEVICE
2453 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2456 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2459 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2462 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2465 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2468 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2471 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2474 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2476 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2479 /* Set option OPT to value VAL on socket S.
2481 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2482 Signals an error if setting a known option fails.
2486 set_socket_option (s
, opt
, val
)
2488 Lisp_Object opt
, val
;
2491 struct socket_options
*sopt
;
2496 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2497 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2498 if (strcmp (name
, sopt
->name
) == 0)
2501 switch (sopt
->opttype
)
2506 optval
= NILP (val
) ? 0 : 1;
2507 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2508 &optval
, sizeof (optval
));
2516 optval
= XINT (val
);
2518 error ("Bad option value for %s", name
);
2519 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2520 &optval
, sizeof (optval
));
2524 #ifdef SO_BINDTODEVICE
2527 char devname
[IFNAMSIZ
+1];
2529 /* This is broken, at least in the Linux 2.4 kernel.
2530 To unbind, the arg must be a zero integer, not the empty string.
2531 This should work on all systems. KFS. 2003-09-23. */
2532 bzero (devname
, sizeof devname
);
2535 char *arg
= (char *) SDATA (val
);
2536 int len
= min (strlen (arg
), IFNAMSIZ
);
2537 bcopy (arg
, devname
, len
);
2539 else if (!NILP (val
))
2540 error ("Bad option value for %s", name
);
2541 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2550 struct linger linger
;
2553 linger
.l_linger
= 0;
2555 linger
.l_linger
= XINT (val
);
2557 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2558 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2559 &linger
, sizeof (linger
));
2569 report_file_error ("Cannot set network option",
2570 Fcons (opt
, Fcons (val
, Qnil
)));
2571 return (1 << sopt
->optbit
);
2575 DEFUN ("set-network-process-option",
2576 Fset_network_process_option
, Sset_network_process_option
,
2578 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2579 See `make-network-process' for a list of options and values.
2580 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2581 OPTION is not a supported option, return nil instead; otherwise return t. */)
2582 (process
, option
, value
, no_error
)
2583 Lisp_Object process
, option
, value
;
2584 Lisp_Object no_error
;
2587 struct Lisp_Process
*p
;
2589 CHECK_PROCESS (process
);
2590 p
= XPROCESS (process
);
2591 if (!NETCONN1_P (p
))
2592 error ("Process is not a network process");
2596 error ("Process is not running");
2598 if (set_socket_option (s
, option
, value
))
2600 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2604 if (NILP (no_error
))
2605 error ("Unknown or unsupported option");
2611 /* A version of request_sigio suitable for a record_unwind_protect. */
2614 unwind_request_sigio (dummy
)
2617 if (interrupt_input
)
2622 /* Create a network stream/datagram client/server process. Treated
2623 exactly like a normal process when reading and writing. Primary
2624 differences are in status display and process deletion. A network
2625 connection has no PID; you cannot signal it. All you can do is
2626 stop/continue it and deactivate/close it via delete-process */
2628 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2630 doc
: /* Create and return a network server or client process.
2632 In Emacs, network connections are represented by process objects, so
2633 input and output work as for subprocesses and `delete-process' closes
2634 a network connection. However, a network process has no process id,
2635 it cannot be signaled, and the status codes are different from normal
2638 Arguments are specified as keyword/argument pairs. The following
2639 arguments are defined:
2641 :name NAME -- NAME is name for process. It is modified if necessary
2644 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2645 with the process. Process output goes at end of that buffer, unless
2646 you specify an output stream or filter function to handle the output.
2647 BUFFER may be also nil, meaning that this process is not associated
2650 :host HOST -- HOST is name of the host to connect to, or its IP
2651 address. The symbol `local' specifies the local host. If specified
2652 for a server process, it must be a valid name or address for the local
2653 host, and only clients connecting to that address will be accepted.
2655 :service SERVICE -- SERVICE is name of the service desired, or an
2656 integer specifying a port number to connect to. If SERVICE is t,
2657 a random port number is selected for the server.
2659 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2660 stream type connection, `datagram' creates a datagram type connection.
2662 :family FAMILY -- FAMILY is the address (and protocol) family for the
2663 service specified by HOST and SERVICE. The default (nil) is to use
2664 whatever address family (IPv4 or IPv6) that is defined for the host
2665 and port number specified by HOST and SERVICE. Other address families
2667 local -- for a local (i.e. UNIX) address specified by SERVICE.
2668 ipv4 -- use IPv4 address family only.
2669 ipv6 -- use IPv6 address family only.
2671 :local ADDRESS -- ADDRESS is the local address used for the connection.
2672 This parameter is ignored when opening a client process. When specified
2673 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2675 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2676 connection. This parameter is ignored when opening a stream server
2677 process. For a datagram server process, it specifies the initial
2678 setting of the remote datagram address. When specified for a client
2679 process, the FAMILY, HOST, and SERVICE args are ignored.
2681 The format of ADDRESS depends on the address family:
2682 - An IPv4 address is represented as an vector of integers [A B C D P]
2683 corresponding to numeric IP address A.B.C.D and port number P.
2684 - A local address is represented as a string with the address in the
2685 local address space.
2686 - An "unsupported family" address is represented by a cons (F . AV)
2687 where F is the family number and AV is a vector containing the socket
2688 address data with one element per address data byte. Do not rely on
2689 this format in portable code, as it may depend on implementation
2690 defined constants, data sizes, and data structure alignment.
2692 :coding CODING -- If CODING is a symbol, it specifies the coding
2693 system used for both reading and writing for this process. If CODING
2694 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2695 ENCODING is used for writing.
2697 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2698 return without waiting for the connection to complete; instead, the
2699 sentinel function will be called with second arg matching "open" (if
2700 successful) or "failed" when the connect completes. Default is to use
2701 a blocking connect (i.e. wait) for stream type connections.
2703 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2704 running when Emacs is exited.
2706 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2707 In the stopped state, a server process does not accept new
2708 connections, and a client process does not handle incoming traffic.
2709 The stopped state is cleared by `continue-process' and set by
2712 :filter FILTER -- Install FILTER as the process filter.
2714 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2715 process filter are multibyte, otherwise they are unibyte.
2716 If this keyword is not specified, the strings are multibyte iff
2717 `default-enable-multibyte-characters' is non-nil.
2719 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2721 :log LOG -- Install LOG as the server process log function. This
2722 function is called when the server accepts a network connection from a
2723 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2724 is the server process, CLIENT is the new process for the connection,
2725 and MESSAGE is a string.
2727 :plist PLIST -- Install PLIST as the new process' initial plist.
2729 :server QLEN -- if QLEN is non-nil, create a server process for the
2730 specified FAMILY, SERVICE, and connection type (stream or datagram).
2731 If QLEN is an integer, it is used as the max. length of the server's
2732 pending connection queue (also known as the backlog); the default
2733 queue length is 5. Default is to create a client process.
2735 The following network options can be specified for this connection:
2737 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2738 :dontroute BOOL -- Only send to directly connected hosts.
2739 :keepalive BOOL -- Send keep-alive messages on network stream.
2740 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2741 :oobinline BOOL -- Place out-of-band data in receive data stream.
2742 :priority INT -- Set protocol defined priority for sent packets.
2743 :reuseaddr BOOL -- Allow reusing a recently used local address
2744 (this is allowed by default for a server process).
2745 :bindtodevice NAME -- bind to interface NAME. Using this may require
2746 special privileges on some systems.
2748 Consult the relevant system programmer's manual pages for more
2749 information on using these options.
2752 A server process will listen for and accept connections from clients.
2753 When a client connection is accepted, a new network process is created
2754 for the connection with the following parameters:
2756 - The client's process name is constructed by concatenating the server
2757 process' NAME and a client identification string.
2758 - If the FILTER argument is non-nil, the client process will not get a
2759 separate process buffer; otherwise, the client's process buffer is a newly
2760 created buffer named after the server process' BUFFER name or process
2761 NAME concatenated with the client identification string.
2762 - The connection type and the process filter and sentinel parameters are
2763 inherited from the server process' TYPE, FILTER and SENTINEL.
2764 - The client process' contact info is set according to the client's
2765 addressing information (typically an IP address and a port number).
2766 - The client process' plist is initialized from the server's plist.
2768 Notice that the FILTER and SENTINEL args are never used directly by
2769 the server process. Also, the BUFFER argument is not used directly by
2770 the server process, but via the optional :log function, accepted (and
2771 failed) connections may be logged in the server process' buffer.
2773 The original argument list, modified with the actual connection
2774 information, is available via the `process-contact' function.
2776 usage: (make-network-process &rest ARGS) */)
2782 Lisp_Object contact
;
2783 struct Lisp_Process
*p
;
2784 #ifdef HAVE_GETADDRINFO
2785 struct addrinfo ai
, *res
, *lres
;
2786 struct addrinfo hints
;
2787 char *portstring
, portbuf
[128];
2788 #else /* HAVE_GETADDRINFO */
2789 struct _emacs_addrinfo
2795 struct sockaddr
*ai_addr
;
2796 struct _emacs_addrinfo
*ai_next
;
2798 #endif /* HAVE_GETADDRINFO */
2799 struct sockaddr_in address_in
;
2800 #ifdef HAVE_LOCAL_SOCKETS
2801 struct sockaddr_un address_un
;
2806 int s
= -1, outch
, inch
;
2807 struct gcpro gcpro1
;
2808 int count
= SPECPDL_INDEX ();
2810 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2812 Lisp_Object name
, buffer
, host
, service
, address
;
2813 Lisp_Object filter
, sentinel
;
2814 int is_non_blocking_client
= 0;
2815 int is_server
= 0, backlog
= 5;
2822 /* Save arguments for process-contact and clone-process. */
2823 contact
= Flist (nargs
, args
);
2827 /* Ensure socket support is loaded if available. */
2828 init_winsock (TRUE
);
2831 /* :type TYPE (nil: stream, datagram */
2832 tem
= Fplist_get (contact
, QCtype
);
2834 socktype
= SOCK_STREAM
;
2835 #ifdef DATAGRAM_SOCKETS
2836 else if (EQ (tem
, Qdatagram
))
2837 socktype
= SOCK_DGRAM
;
2840 error ("Unsupported connection type");
2843 tem
= Fplist_get (contact
, QCserver
);
2846 /* Don't support network sockets when non-blocking mode is
2847 not available, since a blocked Emacs is not useful. */
2848 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2849 error ("Network servers not supported");
2853 backlog
= XINT (tem
);
2857 /* Make QCaddress an alias for :local (server) or :remote (client). */
2858 QCaddress
= is_server
? QClocal
: QCremote
;
2861 if (!is_server
&& socktype
== SOCK_STREAM
2862 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2864 #ifndef NON_BLOCKING_CONNECT
2865 error ("Non-blocking connect not supported");
2867 is_non_blocking_client
= 1;
2871 name
= Fplist_get (contact
, QCname
);
2872 buffer
= Fplist_get (contact
, QCbuffer
);
2873 filter
= Fplist_get (contact
, QCfilter
);
2874 sentinel
= Fplist_get (contact
, QCsentinel
);
2876 CHECK_STRING (name
);
2879 /* Let's handle TERM before things get complicated ... */
2880 host
= Fplist_get (contact
, QChost
);
2881 CHECK_STRING (host
);
2883 service
= Fplist_get (contact
, QCservice
);
2884 if (INTEGERP (service
))
2885 port
= htons ((unsigned short) XINT (service
));
2888 struct servent
*svc_info
;
2889 CHECK_STRING (service
);
2890 svc_info
= getservbyname (SDATA (service
), "tcp");
2892 error ("Unknown service: %s", SDATA (service
));
2893 port
= svc_info
->s_port
;
2896 s
= connect_server (0);
2898 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2899 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2900 send_command (s
, C_DUMB
, 1, 0);
2902 #else /* not TERM */
2904 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2905 ai
.ai_socktype
= socktype
;
2910 /* :local ADDRESS or :remote ADDRESS */
2911 address
= Fplist_get (contact
, QCaddress
);
2912 if (!NILP (address
))
2914 host
= service
= Qnil
;
2916 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2917 error ("Malformed :address");
2918 ai
.ai_family
= family
;
2919 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2920 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2924 /* :family FAMILY -- nil (for Inet), local, or integer. */
2925 tem
= Fplist_get (contact
, QCfamily
);
2928 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
2934 #ifdef HAVE_LOCAL_SOCKETS
2935 else if (EQ (tem
, Qlocal
))
2939 else if (EQ (tem
, Qipv6
))
2942 else if (EQ (tem
, Qipv4
))
2944 else if (INTEGERP (tem
))
2945 family
= XINT (tem
);
2947 error ("Unknown address family");
2949 ai
.ai_family
= family
;
2951 /* :service SERVICE -- string, integer (port number), or t (random port). */
2952 service
= Fplist_get (contact
, QCservice
);
2954 #ifdef HAVE_LOCAL_SOCKETS
2955 if (family
== AF_LOCAL
)
2957 /* Host is not used. */
2959 CHECK_STRING (service
);
2960 bzero (&address_un
, sizeof address_un
);
2961 address_un
.sun_family
= AF_LOCAL
;
2962 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
2963 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
2964 ai
.ai_addrlen
= sizeof address_un
;
2969 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2970 host
= Fplist_get (contact
, QChost
);
2973 if (EQ (host
, Qlocal
))
2974 host
= build_string ("localhost");
2975 CHECK_STRING (host
);
2978 /* Slow down polling to every ten seconds.
2979 Some kernels have a bug which causes retrying connect to fail
2980 after a connect. Polling can interfere with gethostbyname too. */
2981 #ifdef POLL_FOR_INPUT
2982 if (socktype
== SOCK_STREAM
)
2984 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
2985 bind_polling_period (10);
2989 #ifdef HAVE_GETADDRINFO
2990 /* If we have a host, use getaddrinfo to resolve both host and service.
2991 Otherwise, use getservbyname to lookup the service. */
2995 /* SERVICE can either be a string or int.
2996 Convert to a C string for later use by getaddrinfo. */
2997 if (EQ (service
, Qt
))
2999 else if (INTEGERP (service
))
3001 sprintf (portbuf
, "%ld", (long) XINT (service
));
3002 portstring
= portbuf
;
3006 CHECK_STRING (service
);
3007 portstring
= SDATA (service
);
3012 memset (&hints
, 0, sizeof (hints
));
3014 hints
.ai_family
= family
;
3015 hints
.ai_socktype
= socktype
;
3016 hints
.ai_protocol
= 0;
3017 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3019 #ifdef HAVE_GAI_STRERROR
3020 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
3022 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3028 #endif /* HAVE_GETADDRINFO */
3030 /* We end up here if getaddrinfo is not defined, or in case no hostname
3031 has been specified (e.g. for a local server process). */
3033 if (EQ (service
, Qt
))
3035 else if (INTEGERP (service
))
3036 port
= htons ((unsigned short) XINT (service
));
3039 struct servent
*svc_info
;
3040 CHECK_STRING (service
);
3041 svc_info
= getservbyname (SDATA (service
),
3042 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3044 error ("Unknown service: %s", SDATA (service
));
3045 port
= svc_info
->s_port
;
3048 bzero (&address_in
, sizeof address_in
);
3049 address_in
.sin_family
= family
;
3050 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3051 address_in
.sin_port
= port
;
3053 #ifndef HAVE_GETADDRINFO
3056 struct hostent
*host_info_ptr
;
3058 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3059 as it may `hang' Emacs for a very long time. */
3062 host_info_ptr
= gethostbyname (SDATA (host
));
3067 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
3068 host_info_ptr
->h_length
);
3069 family
= host_info_ptr
->h_addrtype
;
3070 address_in
.sin_family
= family
;
3073 /* Attempt to interpret host as numeric inet address */
3075 IN_ADDR numeric_addr
;
3076 numeric_addr
= inet_addr ((char *) SDATA (host
));
3077 if (NUMERIC_ADDR_ERROR
)
3078 error ("Unknown host \"%s\"", SDATA (host
));
3080 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
3081 sizeof (address_in
.sin_addr
));
3085 #endif /* not HAVE_GETADDRINFO */
3087 ai
.ai_family
= family
;
3088 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3089 ai
.ai_addrlen
= sizeof address_in
;
3093 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
3094 when connect is interrupted. So let's not let it get interrupted.
3095 Note we do not turn off polling, because polling is only used
3096 when not interrupt_input, and thus not normally used on the systems
3097 which have this bug. On systems which use polling, there's no way
3098 to quit if polling is turned off. */
3100 && !is_server
&& socktype
== SOCK_STREAM
)
3102 /* Comment from KFS: The original open-network-stream code
3103 didn't unwind protect this, but it seems like the proper
3104 thing to do. In any case, I don't see how it could harm to
3105 do this -- and it makes cleanup (using unbind_to) easier. */
3106 record_unwind_protect (unwind_request_sigio
, Qnil
);
3110 /* Do this in case we never enter the for-loop below. */
3111 count1
= SPECPDL_INDEX ();
3114 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3120 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3127 #ifdef DATAGRAM_SOCKETS
3128 if (!is_server
&& socktype
== SOCK_DGRAM
)
3130 #endif /* DATAGRAM_SOCKETS */
3132 #ifdef NON_BLOCKING_CONNECT
3133 if (is_non_blocking_client
)
3136 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3138 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3150 /* Make us close S if quit. */
3151 record_unwind_protect (close_file_unwind
, make_number (s
));
3153 /* Parse network options in the arg list.
3154 We simply ignore anything which isn't a known option (including other keywords).
3155 An error is signalled if setting a known option fails. */
3156 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3157 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3161 /* Configure as a server socket. */
3163 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3164 explicit :reuseaddr key to override this. */
3165 #ifdef HAVE_LOCAL_SOCKETS
3166 if (family
!= AF_LOCAL
)
3168 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3171 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3172 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3175 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3176 report_file_error ("Cannot bind server socket", Qnil
);
3178 #ifdef HAVE_GETSOCKNAME
3179 if (EQ (service
, Qt
))
3181 struct sockaddr_in sa1
;
3182 int len1
= sizeof (sa1
);
3183 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3185 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3186 service
= make_number (ntohs (sa1
.sin_port
));
3187 contact
= Fplist_put (contact
, QCservice
, service
);
3192 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3193 report_file_error ("Cannot listen on server socket", Qnil
);
3201 /* This turns off all alarm-based interrupts; the
3202 bind_polling_period call above doesn't always turn all the
3203 short-interval ones off, especially if interrupt_input is
3206 It'd be nice to be able to control the connect timeout
3207 though. Would non-blocking connect calls be portable?
3209 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3211 turn_on_atimers (0);
3213 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3216 turn_on_atimers (1);
3218 if (ret
== 0 || xerrno
== EISCONN
)
3220 /* The unwind-protect will be discarded afterwards.
3221 Likewise for immediate_quit. */
3225 #ifdef NON_BLOCKING_CONNECT
3227 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3231 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3239 /* Discard the unwind protect closing S. */
3240 specpdl_ptr
= specpdl
+ count1
;
3244 if (xerrno
== EINTR
)
3250 #ifdef DATAGRAM_SOCKETS
3251 if (socktype
== SOCK_DGRAM
)
3253 if (datagram_address
[s
].sa
)
3255 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3256 datagram_address
[s
].len
= lres
->ai_addrlen
;
3260 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3261 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3264 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3265 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3266 conv_lisp_to_sockaddr (rfamily
, remote
,
3267 datagram_address
[s
].sa
, rlen
);
3271 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3274 contact
= Fplist_put (contact
, QCaddress
,
3275 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3276 #ifdef HAVE_GETSOCKNAME
3279 struct sockaddr_in sa1
;
3280 int len1
= sizeof (sa1
);
3281 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3282 contact
= Fplist_put (contact
, QClocal
,
3283 conv_sockaddr_to_lisp (&sa1
, len1
));
3288 #ifdef HAVE_GETADDRINFO
3295 /* Discard the unwind protect for closing S, if any. */
3296 specpdl_ptr
= specpdl
+ count1
;
3298 /* Unwind bind_polling_period and request_sigio. */
3299 unbind_to (count
, Qnil
);
3303 /* If non-blocking got this far - and failed - assume non-blocking is
3304 not supported after all. This is probably a wrong assumption, but
3305 the normal blocking calls to open-network-stream handles this error
3307 if (is_non_blocking_client
)
3312 report_file_error ("make server process failed", contact
);
3314 report_file_error ("make client process failed", contact
);
3317 #endif /* not TERM */
3323 buffer
= Fget_buffer_create (buffer
);
3324 proc
= make_process (name
);
3326 chan_process
[inch
] = proc
;
3329 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3332 fcntl (inch
, F_SETFL
, O_NDELAY
);
3336 p
= XPROCESS (proc
);
3338 p
->childp
= contact
;
3339 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3342 p
->sentinel
= sentinel
;
3344 p
->filter_multibyte
= buffer_defaults
.enable_multibyte_characters
;
3345 /* Override the above only if :filter-multibyte is specified. */
3346 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3347 p
->filter_multibyte
= Fplist_get (contact
, QCfilter_multibyte
);
3348 p
->log
= Fplist_get (contact
, QClog
);
3349 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3350 p
->kill_without_query
= Qt
;
3351 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3354 XSETINT (p
->infd
, inch
);
3355 XSETINT (p
->outfd
, outch
);
3356 if (is_server
&& socktype
== SOCK_STREAM
)
3357 p
->status
= Qlisten
;
3359 #ifdef NON_BLOCKING_CONNECT
3360 if (is_non_blocking_client
)
3362 /* We may get here if connect did succeed immediately. However,
3363 in that case, we still need to signal this like a non-blocking
3365 p
->status
= Qconnect
;
3366 if (!FD_ISSET (inch
, &connect_wait_mask
))
3368 FD_SET (inch
, &connect_wait_mask
);
3369 num_pending_connects
++;
3374 /* A server may have a client filter setting of Qt, but it must
3375 still listen for incoming connects unless it is stopped. */
3376 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3377 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3379 FD_SET (inch
, &input_wait_mask
);
3380 FD_SET (inch
, &non_keyboard_wait_mask
);
3383 if (inch
> max_process_desc
)
3384 max_process_desc
= inch
;
3386 tem
= Fplist_member (contact
, QCcoding
);
3387 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3388 tem
= Qnil
; /* No error message (too late!). */
3391 /* Setup coding systems for communicating with the network stream. */
3392 struct gcpro gcpro1
;
3393 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3394 Lisp_Object coding_systems
= Qt
;
3395 Lisp_Object args
[5], val
;
3399 val
= XCAR (XCDR (tem
));
3403 else if (!NILP (Vcoding_system_for_read
))
3404 val
= Vcoding_system_for_read
;
3405 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3406 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3407 /* We dare not decode end-of-line format by setting VAL to
3408 Qraw_text, because the existing Emacs Lisp libraries
3409 assume that they receive bare code including a sequene of
3414 if (NILP (host
) || NILP (service
))
3415 coding_systems
= Qnil
;
3418 args
[0] = Qopen_network_stream
, args
[1] = name
,
3419 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3421 coding_systems
= Ffind_operation_coding_system (5, args
);
3424 if (CONSP (coding_systems
))
3425 val
= XCAR (coding_systems
);
3426 else if (CONSP (Vdefault_process_coding_system
))
3427 val
= XCAR (Vdefault_process_coding_system
);
3431 p
->decode_coding_system
= val
;
3435 val
= XCAR (XCDR (tem
));
3439 else if (!NILP (Vcoding_system_for_write
))
3440 val
= Vcoding_system_for_write
;
3441 else if (NILP (current_buffer
->enable_multibyte_characters
))
3445 if (EQ (coding_systems
, Qt
))
3447 if (NILP (host
) || NILP (service
))
3448 coding_systems
= Qnil
;
3451 args
[0] = Qopen_network_stream
, args
[1] = name
,
3452 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3454 coding_systems
= Ffind_operation_coding_system (5, args
);
3458 if (CONSP (coding_systems
))
3459 val
= XCDR (coding_systems
);
3460 else if (CONSP (Vdefault_process_coding_system
))
3461 val
= XCDR (Vdefault_process_coding_system
);
3465 p
->encode_coding_system
= val
;
3467 setup_process_coding_systems (proc
);
3469 p
->decoding_buf
= make_uninit_string (0);
3470 p
->decoding_carryover
= make_number (0);
3471 p
->encoding_buf
= make_uninit_string (0);
3472 p
->encoding_carryover
= make_number (0);
3474 p
->inherit_coding_system_flag
3475 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3481 #endif /* HAVE_SOCKETS */
3484 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3487 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3488 doc
: /* Return an alist of all network interfaces and their network address.
3489 Each element is a cons, the car of which is a string containing the
3490 interface name, and the cdr is the network address in internal
3491 format; see the description of ADDRESS in `make-network-process'. */)
3494 struct ifconf ifconf
;
3495 struct ifreq
*ifreqs
= NULL
;
3500 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3506 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3507 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3514 ifconf
.ifc_len
= buf_size
;
3515 ifconf
.ifc_req
= ifreqs
;
3516 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3522 if (ifconf
.ifc_len
== buf_size
)
3526 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3529 while (--ifaces
>= 0)
3531 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3532 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3533 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3535 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3536 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3537 res
= Fcons (Fcons (build_string (namebuf
),
3538 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3539 sizeof (struct sockaddr
))),
3545 #endif /* SIOCGIFCONF */
3547 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3554 static struct ifflag_def ifflag_table
[] = {
3558 #ifdef IFF_BROADCAST
3559 { IFF_BROADCAST
, "broadcast" },
3562 { IFF_DEBUG
, "debug" },
3565 { IFF_LOOPBACK
, "loopback" },
3567 #ifdef IFF_POINTOPOINT
3568 { IFF_POINTOPOINT
, "pointopoint" },
3571 { IFF_RUNNING
, "running" },
3574 { IFF_NOARP
, "noarp" },
3577 { IFF_PROMISC
, "promisc" },
3579 #ifdef IFF_NOTRAILERS
3580 { IFF_NOTRAILERS
, "notrailers" },
3583 { IFF_ALLMULTI
, "allmulti" },
3586 { IFF_MASTER
, "master" },
3589 { IFF_SLAVE
, "slave" },
3591 #ifdef IFF_MULTICAST
3592 { IFF_MULTICAST
, "multicast" },
3595 { IFF_PORTSEL
, "portsel" },
3597 #ifdef IFF_AUTOMEDIA
3598 { IFF_AUTOMEDIA
, "automedia" },
3601 { IFF_DYNAMIC
, "dynamic" },
3604 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3607 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3610 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3613 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3616 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3621 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3622 doc
: /* Return information about network interface named IFNAME.
3623 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3624 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3625 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3626 FLAGS is the current flags of the interface. */)
3631 Lisp_Object res
= Qnil
;
3636 CHECK_STRING (ifname
);
3638 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3639 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3641 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3646 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3647 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3649 int flags
= rq
.ifr_flags
;
3650 struct ifflag_def
*fp
;
3654 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3656 if (flags
& fp
->flag_bit
)
3658 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3659 flags
-= fp
->flag_bit
;
3662 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3664 if (flags
& (1 << fnum
))
3666 elt
= Fcons (make_number (fnum
), elt
);
3671 res
= Fcons (elt
, res
);
3674 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3675 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3677 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3678 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3682 for (n
= 0; n
< 6; n
++)
3683 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3684 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3687 res
= Fcons (elt
, res
);
3690 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
3691 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3694 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3695 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3697 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3701 res
= Fcons (elt
, res
);
3704 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3705 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3708 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3711 res
= Fcons (elt
, res
);
3714 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3715 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3718 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3721 res
= Fcons (elt
, res
);
3725 return any
? res
: Qnil
;
3728 #endif /* HAVE_SOCKETS */
3730 /* Turn off input and output for process PROC. */
3733 deactivate_process (proc
)
3736 register int inchannel
, outchannel
;
3737 register struct Lisp_Process
*p
= XPROCESS (proc
);
3739 inchannel
= XINT (p
->infd
);
3740 outchannel
= XINT (p
->outfd
);
3742 #ifdef ADAPTIVE_READ_BUFFERING
3743 if (XINT (p
->read_output_delay
) > 0)
3745 if (--process_output_delay_count
< 0)
3746 process_output_delay_count
= 0;
3747 XSETINT (p
->read_output_delay
, 0);
3748 p
->read_output_skip
= Qnil
;
3754 /* Beware SIGCHLD hereabouts. */
3755 flush_pending_output (inchannel
);
3758 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3759 sys$
dassgn (outchannel
);
3760 vs
= get_vms_process_pointer (p
->pid
);
3762 give_back_vms_process_stuff (vs
);
3765 emacs_close (inchannel
);
3766 if (outchannel
>= 0 && outchannel
!= inchannel
)
3767 emacs_close (outchannel
);
3770 XSETINT (p
->infd
, -1);
3771 XSETINT (p
->outfd
, -1);
3772 #ifdef DATAGRAM_SOCKETS
3773 if (DATAGRAM_CHAN_P (inchannel
))
3775 xfree (datagram_address
[inchannel
].sa
);
3776 datagram_address
[inchannel
].sa
= 0;
3777 datagram_address
[inchannel
].len
= 0;
3780 chan_process
[inchannel
] = Qnil
;
3781 FD_CLR (inchannel
, &input_wait_mask
);
3782 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3783 #ifdef NON_BLOCKING_CONNECT
3784 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3786 FD_CLR (inchannel
, &connect_wait_mask
);
3787 if (--num_pending_connects
< 0)
3791 if (inchannel
== max_process_desc
)
3794 /* We just closed the highest-numbered process input descriptor,
3795 so recompute the highest-numbered one now. */
3796 max_process_desc
= 0;
3797 for (i
= 0; i
< MAXDESC
; i
++)
3798 if (!NILP (chan_process
[i
]))
3799 max_process_desc
= i
;
3804 /* Close all descriptors currently in use for communication
3805 with subprocess. This is used in a newly-forked subprocess
3806 to get rid of irrelevant descriptors. */
3809 close_process_descs ()
3813 for (i
= 0; i
< MAXDESC
; i
++)
3815 Lisp_Object process
;
3816 process
= chan_process
[i
];
3817 if (!NILP (process
))
3819 int in
= XINT (XPROCESS (process
)->infd
);
3820 int out
= XINT (XPROCESS (process
)->outfd
);
3823 if (out
>= 0 && in
!= out
)
3830 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3832 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3833 It is read into the process' buffers or given to their filter functions.
3834 Non-nil arg PROCESS means do not return until some output has been received
3836 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of
3837 seconds and microseconds to wait; return after that much time whether
3838 or not there is input.
3839 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3840 from PROCESS, suspending reading output from other processes.
3841 If JUST-THIS-ONE is an integer, don't run any timers either.
3842 Return non-nil iff we received any output before the timeout expired. */)
3843 (process
, timeout
, timeout_msecs
, just_this_one
)
3844 register Lisp_Object process
, timeout
, timeout_msecs
, just_this_one
;
3849 if (! NILP (process
))
3850 CHECK_PROCESS (process
);
3852 just_this_one
= Qnil
;
3854 if (! NILP (timeout_msecs
))
3856 CHECK_NUMBER (timeout_msecs
);
3857 useconds
= XINT (timeout_msecs
);
3858 if (!INTEGERP (timeout
))
3859 XSETINT (timeout
, 0);
3862 int carry
= useconds
/ 1000000;
3864 XSETINT (timeout
, XINT (timeout
) + carry
);
3865 useconds
-= carry
* 1000000;
3867 /* I think this clause is necessary because C doesn't
3868 guarantee a particular rounding direction for negative
3872 XSETINT (timeout
, XINT (timeout
) - 1);
3873 useconds
+= 1000000;
3880 if (! NILP (timeout
))
3882 CHECK_NUMBER (timeout
);
3883 seconds
= XINT (timeout
);
3884 if (seconds
< 0 || (seconds
== 0 && useconds
== 0))
3888 seconds
= NILP (process
) ? -1 : 0;
3891 (wait_reading_process_output (seconds
, useconds
, 0, 0,
3893 !NILP (process
) ? XPROCESS (process
) : NULL
,
3894 NILP (just_this_one
) ? 0 :
3895 !INTEGERP (just_this_one
) ? 1 : -1)
3899 /* Accept a connection for server process SERVER on CHANNEL. */
3901 static int connect_counter
= 0;
3904 server_accept_connection (server
, channel
)
3908 Lisp_Object proc
, caller
, name
, buffer
;
3909 Lisp_Object contact
, host
, service
;
3910 struct Lisp_Process
*ps
= XPROCESS (server
);
3911 struct Lisp_Process
*p
;
3915 struct sockaddr_in in
;
3917 struct sockaddr_in6 in6
;
3919 #ifdef HAVE_LOCAL_SOCKETS
3920 struct sockaddr_un un
;
3923 int len
= sizeof saddr
;
3925 s
= accept (channel
, &saddr
.sa
, &len
);
3934 if (code
== EWOULDBLOCK
)
3938 if (!NILP (ps
->log
))
3939 call3 (ps
->log
, server
, Qnil
,
3940 concat3 (build_string ("accept failed with code"),
3941 Fnumber_to_string (make_number (code
)),
3942 build_string ("\n")));
3948 /* Setup a new process to handle the connection. */
3950 /* Generate a unique identification of the caller, and build contact
3951 information for this process. */
3954 switch (saddr
.sa
.sa_family
)
3958 Lisp_Object args
[5];
3959 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
3960 args
[0] = build_string ("%d.%d.%d.%d");
3961 args
[1] = make_number (*ip
++);
3962 args
[2] = make_number (*ip
++);
3963 args
[3] = make_number (*ip
++);
3964 args
[4] = make_number (*ip
++);
3965 host
= Fformat (5, args
);
3966 service
= make_number (ntohs (saddr
.in
.sin_port
));
3968 args
[0] = build_string (" <%s:%d>");
3971 caller
= Fformat (3, args
);
3978 Lisp_Object args
[9];
3979 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
3981 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
3982 for (i
= 0; i
< 8; i
++)
3983 args
[i
+1] = make_number (ntohs(ip6
[i
]));
3984 host
= Fformat (9, args
);
3985 service
= make_number (ntohs (saddr
.in
.sin_port
));
3987 args
[0] = build_string (" <[%s]:%d>");
3990 caller
= Fformat (3, args
);
3995 #ifdef HAVE_LOCAL_SOCKETS
3999 caller
= Fnumber_to_string (make_number (connect_counter
));
4000 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
4004 /* Create a new buffer name for this process if it doesn't have a
4005 filter. The new buffer name is based on the buffer name or
4006 process name of the server process concatenated with the caller
4009 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4013 buffer
= ps
->buffer
;
4015 buffer
= Fbuffer_name (buffer
);
4020 buffer
= concat2 (buffer
, caller
);
4021 buffer
= Fget_buffer_create (buffer
);
4025 /* Generate a unique name for the new server process. Combine the
4026 server process name with the caller identification. */
4028 name
= concat2 (ps
->name
, caller
);
4029 proc
= make_process (name
);
4031 chan_process
[s
] = proc
;
4034 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4037 fcntl (s
, F_SETFL
, O_NDELAY
);
4041 p
= XPROCESS (proc
);
4043 /* Build new contact information for this setup. */
4044 contact
= Fcopy_sequence (ps
->childp
);
4045 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4046 contact
= Fplist_put (contact
, QChost
, host
);
4047 if (!NILP (service
))
4048 contact
= Fplist_put (contact
, QCservice
, service
);
4049 contact
= Fplist_put (contact
, QCremote
,
4050 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4051 #ifdef HAVE_GETSOCKNAME
4053 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4054 contact
= Fplist_put (contact
, QClocal
,
4055 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4058 p
->childp
= contact
;
4059 p
->plist
= Fcopy_sequence (ps
->plist
);
4062 p
->sentinel
= ps
->sentinel
;
4063 p
->filter
= ps
->filter
;
4066 XSETINT (p
->infd
, s
);
4067 XSETINT (p
->outfd
, s
);
4070 /* Client processes for accepted connections are not stopped initially. */
4071 if (!EQ (p
->filter
, Qt
))
4073 FD_SET (s
, &input_wait_mask
);
4074 FD_SET (s
, &non_keyboard_wait_mask
);
4077 if (s
> max_process_desc
)
4078 max_process_desc
= s
;
4080 /* Setup coding system for new process based on server process.
4081 This seems to be the proper thing to do, as the coding system
4082 of the new process should reflect the settings at the time the
4083 server socket was opened; not the current settings. */
4085 p
->decode_coding_system
= ps
->decode_coding_system
;
4086 p
->encode_coding_system
= ps
->encode_coding_system
;
4087 setup_process_coding_systems (proc
);
4089 p
->decoding_buf
= make_uninit_string (0);
4090 p
->decoding_carryover
= make_number (0);
4091 p
->encoding_buf
= make_uninit_string (0);
4092 p
->encoding_carryover
= make_number (0);
4094 p
->inherit_coding_system_flag
4095 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
4097 if (!NILP (ps
->log
))
4098 call3 (ps
->log
, server
, proc
,
4099 concat3 (build_string ("accept from "),
4100 (STRINGP (host
) ? host
: build_string ("-")),
4101 build_string ("\n")));
4103 if (!NILP (p
->sentinel
))
4104 exec_sentinel (proc
,
4105 concat3 (build_string ("open from "),
4106 (STRINGP (host
) ? host
: build_string ("-")),
4107 build_string ("\n")));
4110 /* This variable is different from waiting_for_input in keyboard.c.
4111 It is used to communicate to a lisp process-filter/sentinel (via the
4112 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4113 for user-input when that process-filter was called.
4114 waiting_for_input cannot be used as that is by definition 0 when
4115 lisp code is being evalled.
4116 This is also used in record_asynch_buffer_change.
4117 For that purpose, this must be 0
4118 when not inside wait_reading_process_output. */
4119 static int waiting_for_user_input_p
;
4121 /* This is here so breakpoints can be put on it. */
4123 wait_reading_process_output_1 ()
4127 /* Read and dispose of subprocess output while waiting for timeout to
4128 elapse and/or keyboard input to be available.
4131 timeout in seconds, or
4132 zero for no limit, or
4133 -1 means gobble data immediately available but don't wait for any.
4136 an additional duration to wait, measured in microseconds.
4137 If this is nonzero and time_limit is 0, then the timeout
4138 consists of MICROSECS only.
4140 READ_KBD is a lisp value:
4141 0 to ignore keyboard input, or
4142 1 to return when input is available, or
4143 -1 meaning caller will actually read the input, so don't throw to
4144 the quit handler, or
4146 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4147 output that arrives.
4149 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4150 (and gobble terminal input into the buffer if any arrives).
4152 If WAIT_PROC is specified, wait until something arrives from that
4153 process. The return value is true iff we read some input from
4156 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4157 (suspending output from other processes). A negative value
4158 means don't run any timers either.
4160 If WAIT_PROC is specified, then the function returns true iff we
4161 received input from that process before the timeout elapsed.
4162 Otherwise, return true iff we received input from any process. */
4165 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
4166 wait_for_cell
, wait_proc
, just_wait_proc
)
4167 int time_limit
, microsecs
, read_kbd
, do_display
;
4168 Lisp_Object wait_for_cell
;
4169 struct Lisp_Process
*wait_proc
;
4172 register int channel
, nfds
;
4173 SELECT_TYPE Available
;
4174 #ifdef NON_BLOCKING_CONNECT
4175 SELECT_TYPE Connecting
;
4178 int check_delay
, no_avail
;
4181 EMACS_TIME timeout
, end_time
;
4182 int wait_channel
= -1;
4183 int got_some_input
= 0;
4184 /* Either nil or a cons cell, the car of which is of interest and
4185 may be changed outside of this routine. */
4186 int saved_waiting_for_user_input_p
= waiting_for_user_input_p
;
4188 FD_ZERO (&Available
);
4189 #ifdef NON_BLOCKING_CONNECT
4190 FD_ZERO (&Connecting
);
4193 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4194 if (wait_proc
!= NULL
)
4195 wait_channel
= XINT (wait_proc
->infd
);
4197 waiting_for_user_input_p
= read_kbd
;
4199 /* Since we may need to wait several times,
4200 compute the absolute time to return at. */
4201 if (time_limit
|| microsecs
)
4203 EMACS_GET_TIME (end_time
);
4204 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4205 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4207 #ifdef POLL_INTERRUPTED_SYS_CALL
4208 /* AlainF 5-Jul-1996
4209 HP-UX 10.10 seem to have problems with signals coming in
4210 Causes "poll: interrupted system call" messages when Emacs is run
4212 Turn off periodic alarms (in case they are in use),
4213 and then turn off any other atimers. */
4215 turn_on_atimers (0);
4216 #endif /* POLL_INTERRUPTED_SYS_CALL */
4220 int timeout_reduced_for_timers
= 0;
4222 /* If calling from keyboard input, do not quit
4223 since we want to return C-g as an input character.
4224 Otherwise, do pending quit if requested. */
4228 else if (interrupt_input_pending
)
4229 handle_async_input ();
4232 /* Exit now if the cell we're waiting for became non-nil. */
4233 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4236 /* Compute time from now till when time limit is up */
4237 /* Exit if already run out */
4238 if (time_limit
== -1)
4240 /* -1 specified for timeout means
4241 gobble output available now
4242 but don't wait at all. */
4244 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4246 else if (time_limit
|| microsecs
)
4248 EMACS_GET_TIME (timeout
);
4249 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4250 if (EMACS_TIME_NEG_P (timeout
))
4255 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4258 /* Normally we run timers here.
4259 But not if wait_for_cell; in those cases,
4260 the wait is supposed to be short,
4261 and those callers cannot handle running arbitrary Lisp code here. */
4262 if (NILP (wait_for_cell
)
4263 && just_wait_proc
>= 0)
4265 EMACS_TIME timer_delay
;
4269 int old_timers_run
= timers_run
;
4270 struct buffer
*old_buffer
= current_buffer
;
4272 timer_delay
= timer_check (1);
4274 /* If a timer has run, this might have changed buffers
4275 an alike. Make read_key_sequence aware of that. */
4276 if (timers_run
!= old_timers_run
4277 && old_buffer
!= current_buffer
4278 && waiting_for_user_input_p
== -1)
4279 record_asynch_buffer_change ();
4281 if (timers_run
!= old_timers_run
&& do_display
)
4282 /* We must retry, since a timer may have requeued itself
4283 and that could alter the time_delay. */
4284 redisplay_preserve_echo_area (9);
4288 while (!detect_input_pending ());
4290 /* If there is unread keyboard input, also return. */
4292 && requeued_events_pending_p ())
4295 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4297 EMACS_TIME difference
;
4298 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4299 if (EMACS_TIME_NEG_P (difference
))
4301 timeout
= timer_delay
;
4302 timeout_reduced_for_timers
= 1;
4305 /* If time_limit is -1, we are not going to wait at all. */
4306 else if (time_limit
!= -1)
4308 /* This is so a breakpoint can be put here. */
4309 wait_reading_process_output_1 ();
4313 /* Cause C-g and alarm signals to take immediate action,
4314 and cause input available signals to zero out timeout.
4316 It is important that we do this before checking for process
4317 activity. If we get a SIGCHLD after the explicit checks for
4318 process activity, timeout is the only way we will know. */
4320 set_waiting_for_input (&timeout
);
4322 /* If status of something has changed, and no input is
4323 available, notify the user of the change right away. After
4324 this explicit check, we'll let the SIGCHLD handler zap
4325 timeout to get our attention. */
4326 if (update_tick
!= process_tick
&& do_display
)
4329 #ifdef NON_BLOCKING_CONNECT
4333 Atemp
= input_wait_mask
;
4335 /* On Mac OS X 10.0, the SELECT system call always says input is
4336 present (for reading) at stdin, even when none is. This
4337 causes the call to SELECT below to return 1 and
4338 status_notify not to be called. As a result output of
4339 subprocesses are incorrectly discarded.
4343 IF_NON_BLOCKING_CONNECT (Ctemp
= connect_wait_mask
);
4345 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4346 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
4348 #ifdef NON_BLOCKING_CONNECT
4349 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4353 (SELECT_TYPE
*)0, &timeout
)
4356 /* It's okay for us to do this and then continue with
4357 the loop, since timeout has already been zeroed out. */
4358 clear_waiting_for_input ();
4359 status_notify (NULL
);
4363 /* Don't wait for output from a non-running process. Just
4364 read whatever data has already been received. */
4365 if (wait_proc
!= 0 && !NILP (wait_proc
->raw_status_low
))
4366 update_status (wait_proc
);
4368 && ! EQ (wait_proc
->status
, Qrun
)
4369 && ! EQ (wait_proc
->status
, Qconnect
))
4371 int nread
, total_nread
= 0;
4373 clear_waiting_for_input ();
4374 XSETPROCESS (proc
, wait_proc
);
4376 /* Read data from the process, until we exhaust it. */
4377 while (XINT (wait_proc
->infd
) >= 0)
4379 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
4385 total_nread
+= nread
;
4387 else if (nread
== -1 && EIO
== errno
)
4391 else if (nread
== -1 && EAGAIN
== errno
)
4395 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4399 if (total_nread
> 0 && do_display
)
4400 redisplay_preserve_echo_area (10);
4405 /* Wait till there is something to do */
4407 if (wait_proc
&& just_wait_proc
)
4409 if (XINT (wait_proc
->infd
) < 0) /* Terminated */
4411 FD_SET (XINT (wait_proc
->infd
), &Available
);
4413 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4415 else if (!NILP (wait_for_cell
))
4417 Available
= non_process_wait_mask
;
4419 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4424 Available
= non_keyboard_wait_mask
;
4426 Available
= input_wait_mask
;
4427 IF_NON_BLOCKING_CONNECT (check_connect
= (num_pending_connects
> 0));
4428 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4431 /* If frame size has changed or the window is newly mapped,
4432 redisplay now, before we start to wait. There is a race
4433 condition here; if a SIGIO arrives between now and the select
4434 and indicates that a frame is trashed, the select may block
4435 displaying a trashed screen. */
4436 if (frame_garbaged
&& do_display
)
4438 clear_waiting_for_input ();
4439 redisplay_preserve_echo_area (11);
4441 set_waiting_for_input (&timeout
);
4445 if (read_kbd
&& detect_input_pending ())
4452 #ifdef NON_BLOCKING_CONNECT
4454 Connecting
= connect_wait_mask
;
4457 #ifdef ADAPTIVE_READ_BUFFERING
4458 /* Set the timeout for adaptive read buffering if any
4459 process has non-nil read_output_skip and non-zero
4460 read_output_delay, and we are not reading output for a
4461 specific wait_channel. It is not executed if
4462 Vprocess_adaptive_read_buffering is nil. */
4463 if (process_output_skip
&& check_delay
> 0)
4465 int usecs
= EMACS_USECS (timeout
);
4466 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4467 usecs
= READ_OUTPUT_DELAY_MAX
;
4468 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4470 proc
= chan_process
[channel
];
4473 /* Find minimum non-zero read_output_delay among the
4474 processes with non-nil read_output_skip. */
4475 if (XINT (XPROCESS (proc
)->read_output_delay
) > 0)
4478 if (NILP (XPROCESS (proc
)->read_output_skip
))
4480 FD_CLR (channel
, &Available
);
4481 XPROCESS (proc
)->read_output_skip
= Qnil
;
4482 if (XINT (XPROCESS (proc
)->read_output_delay
) < usecs
)
4483 usecs
= XINT (XPROCESS (proc
)->read_output_delay
);
4486 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4487 process_output_skip
= 0;
4491 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4493 #ifdef NON_BLOCKING_CONNECT
4494 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4498 (SELECT_TYPE
*)0, &timeout
);
4503 /* Make C-g and alarm signals set flags again */
4504 clear_waiting_for_input ();
4506 /* If we woke up due to SIGWINCH, actually change size now. */
4507 do_pending_window_change (0);
4509 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4510 /* We wanted the full specified time, so return now. */
4514 if (xerrno
== EINTR
)
4517 /* Ultrix select seems to return ENOMEM when it is
4518 interrupted. Treat it just like EINTR. Bleah. Note
4519 that we want to test for the "ultrix" CPP symbol, not
4520 "__ultrix__"; the latter is only defined under GCC, but
4521 not by DEC's bundled CC. -JimB */
4522 else if (xerrno
== ENOMEM
)
4526 /* This happens for no known reason on ALLIANT.
4527 I am guessing that this is the right response. -- RMS. */
4528 else if (xerrno
== EFAULT
)
4531 else if (xerrno
== EBADF
)
4534 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4535 the child's closure of the pts gives the parent a SIGHUP, and
4536 the ptc file descriptor is automatically closed,
4537 yielding EBADF here or at select() call above.
4538 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4539 in m/ibmrt-aix.h), and here we just ignore the select error.
4540 Cleanup occurs c/o status_notify after SIGCLD. */
4541 no_avail
= 1; /* Cannot depend on values returned */
4547 error ("select error: %s", emacs_strerror (xerrno
));
4552 FD_ZERO (&Available
);
4553 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4556 #if defined(sun) && !defined(USG5_4)
4557 if (nfds
> 0 && keyboard_bit_set (&Available
)
4559 /* System sometimes fails to deliver SIGIO.
4561 David J. Mackenzie says that Emacs doesn't compile under
4562 Solaris if this code is enabled, thus the USG5_4 in the CPP
4563 conditional. "I haven't noticed any ill effects so far.
4564 If you find a Solaris expert somewhere, they might know
4566 kill (getpid (), SIGIO
);
4569 #if 0 /* When polling is used, interrupt_input is 0,
4570 so get_input_pending should read the input.
4571 So this should not be needed. */
4572 /* If we are using polling for input,
4573 and we see input available, make it get read now.
4574 Otherwise it might not actually get read for a second.
4575 And on hpux, since we turn off polling in wait_reading_process_output,
4576 it might never get read at all if we don't spend much time
4577 outside of wait_reading_process_output. */
4578 if (read_kbd
&& interrupt_input
4579 && keyboard_bit_set (&Available
)
4580 && input_polling_used ())
4581 kill (getpid (), SIGALRM
);
4584 /* Check for keyboard input */
4585 /* If there is any, return immediately
4586 to give it higher priority than subprocesses */
4590 int old_timers_run
= timers_run
;
4591 struct buffer
*old_buffer
= current_buffer
;
4594 if (detect_input_pending_run_timers (do_display
))
4596 swallow_events (do_display
);
4597 if (detect_input_pending_run_timers (do_display
))
4601 /* If a timer has run, this might have changed buffers
4602 an alike. Make read_key_sequence aware of that. */
4603 if (timers_run
!= old_timers_run
4604 && waiting_for_user_input_p
== -1
4605 && old_buffer
!= current_buffer
)
4606 record_asynch_buffer_change ();
4612 /* If there is unread keyboard input, also return. */
4614 && requeued_events_pending_p ())
4617 /* If we are not checking for keyboard input now,
4618 do process events (but don't run any timers).
4619 This is so that X events will be processed.
4620 Otherwise they may have to wait until polling takes place.
4621 That would causes delays in pasting selections, for example.
4623 (We used to do this only if wait_for_cell.) */
4624 if (read_kbd
== 0 && detect_input_pending ())
4626 swallow_events (do_display
);
4627 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4628 if (detect_input_pending ())
4633 /* Exit now if the cell we're waiting for became non-nil. */
4634 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4638 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4639 go read it. This can happen with X on BSD after logging out.
4640 In that case, there really is no input and no SIGIO,
4641 but select says there is input. */
4643 if (read_kbd
&& interrupt_input
4644 && keyboard_bit_set (&Available
) && ! noninteractive
)
4645 kill (getpid (), SIGIO
);
4649 got_some_input
|= nfds
> 0;
4651 /* If checking input just got us a size-change event from X,
4652 obey it now if we should. */
4653 if (read_kbd
|| ! NILP (wait_for_cell
))
4654 do_pending_window_change (0);
4656 /* Check for data from a process. */
4657 if (no_avail
|| nfds
== 0)
4660 /* Really FIRST_PROC_DESC should be 0 on Unix,
4661 but this is safer in the short run. */
4662 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4664 if (FD_ISSET (channel
, &Available
)
4665 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4669 /* If waiting for this channel, arrange to return as
4670 soon as no more input to be processed. No more
4672 if (wait_channel
== channel
)
4678 proc
= chan_process
[channel
];
4682 /* If this is a server stream socket, accept connection. */
4683 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4685 server_accept_connection (proc
, channel
);
4689 /* Read data from the process, starting with our
4690 buffered-ahead character if we have one. */
4692 nread
= read_process_output (proc
, channel
);
4695 /* Since read_process_output can run a filter,
4696 which can call accept-process-output,
4697 don't try to read from any other processes
4698 before doing the select again. */
4699 FD_ZERO (&Available
);
4702 redisplay_preserve_echo_area (12);
4705 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4708 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4709 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4711 else if (nread
== -1 && errno
== EAGAIN
)
4715 else if (nread
== -1 && errno
== EAGAIN
)
4717 /* Note that we cannot distinguish between no input
4718 available now and a closed pipe.
4719 With luck, a closed pipe will be accompanied by
4720 subprocess termination and SIGCHLD. */
4721 else if (nread
== 0 && !NETCONN_P (proc
))
4723 #endif /* O_NDELAY */
4724 #endif /* O_NONBLOCK */
4726 /* On some OSs with ptys, when the process on one end of
4727 a pty exits, the other end gets an error reading with
4728 errno = EIO instead of getting an EOF (0 bytes read).
4729 Therefore, if we get an error reading and errno =
4730 EIO, just continue, because the child process has
4731 exited and should clean itself up soon (e.g. when we
4734 However, it has been known to happen that the SIGCHLD
4735 got lost. So raise the signl again just in case.
4737 else if (nread
== -1 && errno
== EIO
)
4738 kill (getpid (), SIGCHLD
);
4739 #endif /* HAVE_PTYS */
4740 /* If we can detect process termination, don't consider the process
4741 gone just because its pipe is closed. */
4743 else if (nread
== 0 && !NETCONN_P (proc
))
4748 /* Preserve status of processes already terminated. */
4749 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4750 deactivate_process (proc
);
4751 if (!NILP (XPROCESS (proc
)->raw_status_low
))
4752 update_status (XPROCESS (proc
));
4753 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4754 XPROCESS (proc
)->status
4755 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4758 #ifdef NON_BLOCKING_CONNECT
4759 if (check_connect
&& FD_ISSET (channel
, &Connecting
)
4760 && FD_ISSET (channel
, &connect_wait_mask
))
4762 struct Lisp_Process
*p
;
4764 FD_CLR (channel
, &connect_wait_mask
);
4765 if (--num_pending_connects
< 0)
4768 proc
= chan_process
[channel
];
4772 p
= XPROCESS (proc
);
4775 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4776 So only use it on systems where it is known to work. */
4778 int xlen
= sizeof(xerrno
);
4779 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4784 struct sockaddr pname
;
4785 int pnamelen
= sizeof(pname
);
4787 /* If connection failed, getpeername will fail. */
4789 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4791 /* Obtain connect failure code through error slippage. */
4794 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4801 XSETINT (p
->tick
, ++process_tick
);
4802 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4803 deactivate_process (proc
);
4808 /* Execute the sentinel here. If we had relied on
4809 status_notify to do it later, it will read input
4810 from the process before calling the sentinel. */
4811 exec_sentinel (proc
, build_string ("open\n"));
4812 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4814 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4815 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4819 #endif /* NON_BLOCKING_CONNECT */
4820 } /* end for each file descriptor */
4821 } /* end while exit conditions not met */
4823 waiting_for_user_input_p
= saved_waiting_for_user_input_p
;
4825 /* If calling from keyboard input, do not quit
4826 since we want to return C-g as an input character.
4827 Otherwise, do pending quit if requested. */
4830 /* Prevent input_pending from remaining set if we quit. */
4831 clear_input_pending ();
4834 #ifdef POLL_INTERRUPTED_SYS_CALL
4835 /* AlainF 5-Jul-1996
4836 HP-UX 10.10 seems to have problems with signals coming in
4837 Causes "poll: interrupted system call" messages when Emacs is run
4839 Turn periodic alarms back on */
4841 #endif /* POLL_INTERRUPTED_SYS_CALL */
4843 return got_some_input
;
4846 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4849 read_process_output_call (fun_and_args
)
4850 Lisp_Object fun_and_args
;
4852 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4856 read_process_output_error_handler (error
)
4859 cmd_error_internal (error
, "error in process filter: ");
4861 update_echo_area ();
4862 Fsleep_for (make_number (2), Qnil
);
4866 /* Read pending output from the process channel,
4867 starting with our buffered-ahead character if we have one.
4868 Yield number of decoded characters read.
4870 This function reads at most 4096 characters.
4871 If you want to read all available subprocess output,
4872 you must call it repeatedly until it returns zero.
4874 The characters read are decoded according to PROC's coding-system
4878 read_process_output (proc
, channel
)
4880 register int channel
;
4882 register int nbytes
;
4884 register Lisp_Object outstream
;
4885 register struct buffer
*old
= current_buffer
;
4886 register struct Lisp_Process
*p
= XPROCESS (proc
);
4887 register int opoint
;
4888 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4889 int carryover
= XINT (p
->decoding_carryover
);
4893 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4895 vs
= get_vms_process_pointer (p
->pid
);
4899 return (0); /* Really weird if it does this */
4900 if (!(vs
->iosb
[0] & 1))
4901 return -1; /* I/O error */
4904 error ("Could not get VMS process pointer");
4905 chars
= vs
->inputBuffer
;
4906 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4909 start_vms_process_read (vs
); /* Crank up the next read on the process */
4910 return 1; /* Nothing worth printing, say we got 1 */
4914 /* The data carried over in the previous decoding (which are at
4915 the tail of decoding buffer) should be prepended to the new
4916 data read to decode all together. */
4917 chars
= (char *) alloca (nbytes
+ carryover
);
4918 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4919 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4923 chars
= (char *) alloca (carryover
+ readmax
);
4925 /* See the comment above. */
4926 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
4928 #ifdef DATAGRAM_SOCKETS
4929 /* We have a working select, so proc_buffered_char is always -1. */
4930 if (DATAGRAM_CHAN_P (channel
))
4932 int len
= datagram_address
[channel
].len
;
4933 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
4934 0, datagram_address
[channel
].sa
, &len
);
4938 if (proc_buffered_char
[channel
] < 0)
4940 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
4941 #ifdef ADAPTIVE_READ_BUFFERING
4942 if (nbytes
> 0 && !NILP (p
->adaptive_read_buffering
))
4944 int delay
= XINT (p
->read_output_delay
);
4947 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
4950 process_output_delay_count
++;
4951 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
4954 else if (delay
> 0 && (nbytes
== readmax
))
4956 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
4958 process_output_delay_count
--;
4960 XSETINT (p
->read_output_delay
, delay
);
4963 p
->read_output_skip
= Qt
;
4964 process_output_skip
= 1;
4971 chars
[carryover
] = proc_buffered_char
[channel
];
4972 proc_buffered_char
[channel
] = -1;
4973 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
4977 nbytes
= nbytes
+ 1;
4979 #endif /* not VMS */
4981 XSETINT (p
->decoding_carryover
, 0);
4983 /* At this point, NBYTES holds number of bytes just received
4984 (including the one in proc_buffered_char[channel]). */
4987 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
4989 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4992 /* Now set NBYTES how many bytes we must decode. */
4993 nbytes
+= carryover
;
4995 /* Read and dispose of the process output. */
4996 outstream
= p
->filter
;
4997 if (!NILP (outstream
))
4999 /* We inhibit quit here instead of just catching it so that
5000 hitting ^G when a filter happens to be running won't screw
5002 int count
= SPECPDL_INDEX ();
5003 Lisp_Object odeactivate
;
5004 Lisp_Object obuffer
, okeymap
;
5006 int outer_running_asynch_code
= running_asynch_code
;
5007 int waiting
= waiting_for_user_input_p
;
5009 /* No need to gcpro these, because all we do with them later
5010 is test them for EQness, and none of them should be a string. */
5011 odeactivate
= Vdeactivate_mark
;
5012 XSETBUFFER (obuffer
, current_buffer
);
5013 okeymap
= current_buffer
->keymap
;
5015 specbind (Qinhibit_quit
, Qt
);
5016 specbind (Qlast_nonmenu_event
, Qt
);
5018 /* In case we get recursively called,
5019 and we already saved the match data nonrecursively,
5020 save the same match data in safely recursive fashion. */
5021 if (outer_running_asynch_code
)
5024 /* Don't clobber the CURRENT match data, either! */
5025 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5026 restore_search_regs ();
5027 record_unwind_save_match_data ();
5028 Fset_match_data (tem
, Qt
);
5031 /* For speed, if a search happens within this code,
5032 save the match data in a special nonrecursive fashion. */
5033 running_asynch_code
= 1;
5035 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
5036 text
= coding
->dst_object
;
5037 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5038 /* A new coding system might be found. */
5039 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5041 p
->decode_coding_system
= Vlast_coding_system_used
;
5043 /* Don't call setup_coding_system for
5044 proc_decode_coding_system[channel] here. It is done in
5045 detect_coding called via decode_coding above. */
5047 /* If a coding system for encoding is not yet decided, we set
5048 it as the same as coding-system for decoding.
5050 But, before doing that we must check if
5051 proc_encode_coding_system[p->outfd] surely points to a
5052 valid memory because p->outfd will be changed once EOF is
5053 sent to the process. */
5054 if (NILP (p
->encode_coding_system
)
5055 && proc_encode_coding_system
[XINT (p
->outfd
)])
5057 p
->encode_coding_system
= Vlast_coding_system_used
;
5058 setup_coding_system (p
->encode_coding_system
,
5059 proc_encode_coding_system
[XINT (p
->outfd
)]);
5063 if (coding
->carryover_bytes
> 0)
5065 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5066 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5067 bcopy (coding
->carryover
, SDATA (p
->decoding_buf
),
5068 coding
->carryover_bytes
);
5069 XSETINT (p
->decoding_carryover
, coding
->carryover_bytes
);
5071 /* Adjust the multibyteness of TEXT to that of the filter. */
5072 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
5073 text
= (STRING_MULTIBYTE (text
)
5074 ? Fstring_as_unibyte (text
)
5075 : Fstring_to_multibyte (text
));
5076 if (SBYTES (text
) > 0)
5077 internal_condition_case_1 (read_process_output_call
,
5079 Fcons (proc
, Fcons (text
, Qnil
))),
5080 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5081 read_process_output_error_handler
);
5083 /* If we saved the match data nonrecursively, restore it now. */
5084 restore_search_regs ();
5085 running_asynch_code
= outer_running_asynch_code
;
5087 /* Handling the process output should not deactivate the mark. */
5088 Vdeactivate_mark
= odeactivate
;
5090 /* Restore waiting_for_user_input_p as it was
5091 when we were called, in case the filter clobbered it. */
5092 waiting_for_user_input_p
= waiting
;
5094 #if 0 /* Call record_asynch_buffer_change unconditionally,
5095 because we might have changed minor modes or other things
5096 that affect key bindings. */
5097 if (! EQ (Fcurrent_buffer (), obuffer
)
5098 || ! EQ (current_buffer
->keymap
, okeymap
))
5100 /* But do it only if the caller is actually going to read events.
5101 Otherwise there's no need to make him wake up, and it could
5102 cause trouble (for example it would make Fsit_for return). */
5103 if (waiting_for_user_input_p
== -1)
5104 record_asynch_buffer_change ();
5107 start_vms_process_read (vs
);
5109 unbind_to (count
, Qnil
);
5113 /* If no filter, write into buffer if it isn't dead. */
5114 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5116 Lisp_Object old_read_only
;
5117 int old_begv
, old_zv
;
5118 int old_begv_byte
, old_zv_byte
;
5119 Lisp_Object odeactivate
;
5120 int before
, before_byte
;
5125 odeactivate
= Vdeactivate_mark
;
5127 Fset_buffer (p
->buffer
);
5129 opoint_byte
= PT_BYTE
;
5130 old_read_only
= current_buffer
->read_only
;
5133 old_begv_byte
= BEGV_BYTE
;
5134 old_zv_byte
= ZV_BYTE
;
5136 current_buffer
->read_only
= Qnil
;
5138 /* Insert new output into buffer
5139 at the current end-of-output marker,
5140 thus preserving logical ordering of input and output. */
5141 if (XMARKER (p
->mark
)->buffer
)
5142 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5143 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5146 SET_PT_BOTH (ZV
, ZV_BYTE
);
5148 before_byte
= PT_BYTE
;
5150 /* If the output marker is outside of the visible region, save
5151 the restriction and widen. */
5152 if (! (BEGV
<= PT
&& PT
<= ZV
))
5155 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
5156 text
= coding
->dst_object
;
5157 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5158 /* A new coding system might be found. See the comment in the
5159 similar code in the previous `if' block. */
5160 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5162 p
->decode_coding_system
= Vlast_coding_system_used
;
5163 if (NILP (p
->encode_coding_system
)
5164 && proc_encode_coding_system
[XINT (p
->outfd
)])
5166 p
->encode_coding_system
= Vlast_coding_system_used
;
5167 setup_coding_system (p
->encode_coding_system
,
5168 proc_encode_coding_system
[XINT (p
->outfd
)]);
5171 if (coding
->carryover_bytes
> 0)
5173 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5174 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5175 bcopy (coding
->carryover
, SDATA (p
->decoding_buf
),
5176 coding
->carryover_bytes
);
5177 XSETINT (p
->decoding_carryover
, coding
->carryover_bytes
);
5179 /* Adjust the multibyteness of TEXT to that of the buffer. */
5180 if (NILP (current_buffer
->enable_multibyte_characters
)
5181 != ! STRING_MULTIBYTE (text
))
5182 text
= (STRING_MULTIBYTE (text
)
5183 ? Fstring_as_unibyte (text
)
5184 : Fstring_to_multibyte (text
));
5185 /* Insert before markers in case we are inserting where
5186 the buffer's mark is, and the user's next command is Meta-y. */
5187 insert_from_string_before_markers (text
, 0, 0,
5188 SCHARS (text
), SBYTES (text
), 0);
5190 /* Make sure the process marker's position is valid when the
5191 process buffer is changed in the signal_after_change above.
5192 W3 is known to do that. */
5193 if (BUFFERP (p
->buffer
)
5194 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5195 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5197 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5199 update_mode_lines
++;
5201 /* Make sure opoint and the old restrictions
5202 float ahead of any new text just as point would. */
5203 if (opoint
>= before
)
5205 opoint
+= PT
- before
;
5206 opoint_byte
+= PT_BYTE
- before_byte
;
5208 if (old_begv
> before
)
5210 old_begv
+= PT
- before
;
5211 old_begv_byte
+= PT_BYTE
- before_byte
;
5213 if (old_zv
>= before
)
5215 old_zv
+= PT
- before
;
5216 old_zv_byte
+= PT_BYTE
- before_byte
;
5219 /* If the restriction isn't what it should be, set it. */
5220 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5221 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5223 /* Handling the process output should not deactivate the mark. */
5224 Vdeactivate_mark
= odeactivate
;
5226 current_buffer
->read_only
= old_read_only
;
5227 SET_PT_BOTH (opoint
, opoint_byte
);
5228 set_buffer_internal (old
);
5231 start_vms_process_read (vs
);
5236 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5238 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5239 This is intended for use by asynchronous process output filters and sentinels. */)
5242 return (waiting_for_user_input_p
? Qt
: Qnil
);
5245 /* Sending data to subprocess */
5247 jmp_buf send_process_frame
;
5248 Lisp_Object process_sent_to
;
5251 send_process_trap ()
5253 SIGNAL_THREAD_CHECK (SIGPIPE
);
5258 sigunblock (sigmask (SIGPIPE
));
5259 longjmp (send_process_frame
, 1);
5262 /* Send some data to process PROC.
5263 BUF is the beginning of the data; LEN is the number of characters.
5264 OBJECT is the Lisp object that the data comes from. If OBJECT is
5265 nil or t, it means that the data comes from C string.
5267 If OBJECT is not nil, the data is encoded by PROC's coding-system
5268 for encoding before it is sent.
5270 This function can evaluate Lisp code and can garbage collect. */
5273 send_process (proc
, buf
, len
, object
)
5274 volatile Lisp_Object proc
;
5275 unsigned char *volatile buf
;
5277 volatile Lisp_Object object
;
5279 /* Use volatile to protect variables from being clobbered by longjmp. */
5280 struct Lisp_Process
*p
= XPROCESS (proc
);
5282 struct coding_system
*coding
;
5283 struct gcpro gcpro1
;
5284 SIGTYPE (*volatile old_sigpipe
) ();
5289 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5292 if (! NILP (p
->raw_status_low
))
5294 if (! EQ (p
->status
, Qrun
))
5295 error ("Process %s not running", SDATA (p
->name
));
5296 if (XINT (p
->outfd
) < 0)
5297 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5299 coding
= proc_encode_coding_system
[XINT (p
->outfd
)];
5300 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5302 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5303 || (BUFFERP (object
)
5304 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5307 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
5308 /* The coding system for encoding was changed to raw-text
5309 because we sent a unibyte text previously. Now we are
5310 sending a multibyte text, thus we must encode it by the
5311 original coding system specified for the current process. */
5312 setup_coding_system (p
->encode_coding_system
, coding
);
5313 coding
->src_multibyte
= 1;
5317 /* For sending a unibyte text, character code conversion should
5318 not take place but EOL conversion should. So, setup raw-text
5319 or one of the subsidiary if we have not yet done it. */
5320 if (CODING_REQUIRE_ENCODING (coding
))
5322 if (CODING_REQUIRE_FLUSHING (coding
))
5324 /* But, before changing the coding, we must flush out data. */
5325 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5326 send_process (proc
, "", 0, Qt
);
5327 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
5329 setup_coding_system (raw_text_coding_system
5330 (Vlast_coding_system_used
),
5332 coding
->src_multibyte
= 0;
5335 coding
->dst_multibyte
= 0;
5337 if (CODING_REQUIRE_ENCODING (coding
))
5339 coding
->dst_object
= Qt
;
5340 if (BUFFERP (object
))
5342 int from_byte
, from
, to
;
5343 int save_pt
, save_pt_byte
;
5344 struct buffer
*cur
= current_buffer
;
5346 set_buffer_internal (XBUFFER (object
));
5347 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
5349 from_byte
= PTR_BYTE_POS (buf
);
5350 from
= BYTE_TO_CHAR (from_byte
);
5351 to
= BYTE_TO_CHAR (from_byte
+ len
);
5352 TEMP_SET_PT_BOTH (from
, from_byte
);
5353 encode_coding_object (coding
, object
, from
, from_byte
,
5354 to
, from_byte
+ len
, Qt
);
5355 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
5356 set_buffer_internal (cur
);
5358 else if (STRINGP (object
))
5360 encode_coding_string (coding
, object
, 1);
5364 coding
->dst_object
= make_unibyte_string (buf
, len
);
5365 coding
->produced
= len
;
5368 len
= coding
->produced
;
5369 buf
= SDATA (coding
->dst_object
);
5373 vs
= get_vms_process_pointer (p
->pid
);
5375 error ("Could not find this process: %x", p
->pid
);
5376 else if (write_to_vms_process (vs
, buf
, len
))
5380 if (pty_max_bytes
== 0)
5382 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5383 pty_max_bytes
= fpathconf (XFASTINT (p
->outfd
), _PC_MAX_CANON
);
5384 if (pty_max_bytes
< 0)
5385 pty_max_bytes
= 250;
5387 pty_max_bytes
= 250;
5389 /* Deduct one, to leave space for the eof. */
5393 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5394 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5395 when returning with longjmp despite being declared volatile. */
5396 if (!setjmp (send_process_frame
))
5398 process_sent_to
= proc
;
5403 /* Decide how much data we can send in one batch.
5404 Long lines need to be split into multiple batches. */
5405 if (!NILP (p
->pty_flag
))
5407 /* Starting this at zero is always correct when not the first
5408 iteration because the previous iteration ended by sending C-d.
5409 It may not be correct for the first iteration
5410 if a partial line was sent in a separate send_process call.
5411 If that proves worth handling, we need to save linepos
5412 in the process object. */
5414 unsigned char *ptr
= (unsigned char *) buf
;
5415 unsigned char *end
= (unsigned char *) buf
+ len
;
5417 /* Scan through this text for a line that is too long. */
5418 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5426 /* If we found one, break the line there
5427 and put in a C-d to force the buffer through. */
5431 /* Send this batch, using one or more write calls. */
5434 int outfd
= XINT (p
->outfd
);
5435 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5436 #ifdef DATAGRAM_SOCKETS
5437 if (DATAGRAM_CHAN_P (outfd
))
5439 rv
= sendto (outfd
, (char *) buf
, this,
5440 0, datagram_address
[outfd
].sa
,
5441 datagram_address
[outfd
].len
);
5442 if (rv
< 0 && errno
== EMSGSIZE
)
5444 signal (SIGPIPE
, old_sigpipe
);
5445 report_file_error ("sending datagram",
5446 Fcons (proc
, Qnil
));
5452 rv
= emacs_write (outfd
, (char *) buf
, this);
5453 #ifdef ADAPTIVE_READ_BUFFERING
5454 if (XINT (p
->read_output_delay
) > 0
5455 && EQ (p
->adaptive_read_buffering
, Qt
))
5457 XSETFASTINT (p
->read_output_delay
, 0);
5458 process_output_delay_count
--;
5459 p
->read_output_skip
= Qnil
;
5463 signal (SIGPIPE
, old_sigpipe
);
5469 || errno
== EWOULDBLOCK
5475 /* Buffer is full. Wait, accepting input;
5476 that may allow the program
5477 to finish doing output and read more. */
5481 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5482 /* A gross hack to work around a bug in FreeBSD.
5483 In the following sequence, read(2) returns
5487 write(2) 954 bytes, get EAGAIN
5488 read(2) 1024 bytes in process_read_output
5489 read(2) 11 bytes in process_read_output
5491 That is, read(2) returns more bytes than have
5492 ever been written successfully. The 1033 bytes
5493 read are the 1022 bytes written successfully
5494 after processing (for example with CRs added if
5495 the terminal is set up that way which it is
5496 here). The same bytes will be seen again in a
5497 later read(2), without the CRs. */
5499 if (errno
== EAGAIN
)
5502 ioctl (XINT (p
->outfd
), TIOCFLUSH
, &flags
);
5504 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5506 /* Running filters might relocate buffers or strings.
5507 Arrange to relocate BUF. */
5508 if (BUFFERP (object
))
5509 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5510 else if (STRINGP (object
))
5511 offset
= buf
- SDATA (object
);
5513 #ifdef EMACS_HAS_USECS
5514 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5516 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5519 if (BUFFERP (object
))
5520 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5521 else if (STRINGP (object
))
5522 buf
= offset
+ SDATA (object
);
5527 /* This is a real error. */
5528 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5535 /* If we sent just part of the string, put in an EOF
5536 to force it through, before we send the rest. */
5538 Fprocess_send_eof (proc
);
5541 #endif /* not VMS */
5544 signal (SIGPIPE
, old_sigpipe
);
5546 proc
= process_sent_to
;
5547 p
= XPROCESS (proc
);
5549 p
->raw_status_low
= Qnil
;
5550 p
->raw_status_high
= Qnil
;
5551 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5552 XSETINT (p
->tick
, ++process_tick
);
5553 deactivate_process (proc
);
5555 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5557 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5564 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5566 doc
: /* Send current contents of region as input to PROCESS.
5567 PROCESS may be a process, a buffer, the name of a process or buffer, or
5568 nil, indicating the current buffer's process.
5569 Called from program, takes three arguments, PROCESS, START and END.
5570 If the region is more than 500 characters long,
5571 it is sent in several bunches. This may happen even for shorter regions.
5572 Output from processes can arrive in between bunches. */)
5573 (process
, start
, end
)
5574 Lisp_Object process
, start
, end
;
5579 proc
= get_process (process
);
5580 validate_region (&start
, &end
);
5582 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5583 move_gap (XINT (start
));
5585 start1
= CHAR_TO_BYTE (XINT (start
));
5586 end1
= CHAR_TO_BYTE (XINT (end
));
5587 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5588 Fcurrent_buffer ());
5593 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5595 doc
: /* Send PROCESS the contents of STRING as input.
5596 PROCESS may be a process, a buffer, the name of a process or buffer, or
5597 nil, indicating the current buffer's process.
5598 If STRING is more than 500 characters long,
5599 it is sent in several bunches. This may happen even for shorter strings.
5600 Output from processes can arrive in between bunches. */)
5602 Lisp_Object process
, string
;
5605 CHECK_STRING (string
);
5606 proc
= get_process (process
);
5607 send_process (proc
, SDATA (string
),
5608 SBYTES (string
), string
);
5612 /* Return the foreground process group for the tty/pty that
5613 the process P uses. */
5615 emacs_get_tty_pgrp (p
)
5616 struct Lisp_Process
*p
;
5621 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5624 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5625 master side. Try the slave side. */
5626 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5630 ioctl (fd
, TIOCGPGRP
, &gid
);
5634 #endif /* defined (TIOCGPGRP ) */
5639 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5640 Sprocess_running_child_p
, 0, 1, 0,
5641 doc
: /* Return t if PROCESS has given the terminal to a child.
5642 If the operating system does not make it possible to find out,
5643 return t unconditionally. */)
5645 Lisp_Object process
;
5647 /* Initialize in case ioctl doesn't exist or gives an error,
5648 in a way that will cause returning t. */
5651 struct Lisp_Process
*p
;
5653 proc
= get_process (process
);
5654 p
= XPROCESS (proc
);
5656 if (!EQ (p
->childp
, Qt
))
5657 error ("Process %s is not a subprocess",
5659 if (XINT (p
->infd
) < 0)
5660 error ("Process %s is not active",
5663 gid
= emacs_get_tty_pgrp (p
);
5665 if (gid
== XFASTINT (p
->pid
))
5670 /* send a signal number SIGNO to PROCESS.
5671 If CURRENT_GROUP is t, that means send to the process group
5672 that currently owns the terminal being used to communicate with PROCESS.
5673 This is used for various commands in shell mode.
5674 If CURRENT_GROUP is lambda, that means send to the process group
5675 that currently owns the terminal, but only if it is NOT the shell itself.
5677 If NOMSG is zero, insert signal-announcements into process's buffers
5680 If we can, we try to signal PROCESS by sending control characters
5681 down the pty. This allows us to signal inferiors who have changed
5682 their uid, for which killpg would return an EPERM error. */
5685 process_send_signal (process
, signo
, current_group
, nomsg
)
5686 Lisp_Object process
;
5688 Lisp_Object current_group
;
5692 register struct Lisp_Process
*p
;
5696 proc
= get_process (process
);
5697 p
= XPROCESS (proc
);
5699 if (!EQ (p
->childp
, Qt
))
5700 error ("Process %s is not a subprocess",
5702 if (XINT (p
->infd
) < 0)
5703 error ("Process %s is not active",
5706 if (NILP (p
->pty_flag
))
5707 current_group
= Qnil
;
5709 /* If we are using pgrps, get a pgrp number and make it negative. */
5710 if (NILP (current_group
))
5711 /* Send the signal to the shell's process group. */
5712 gid
= XFASTINT (p
->pid
);
5715 #ifdef SIGNALS_VIA_CHARACTERS
5716 /* If possible, send signals to the entire pgrp
5717 by sending an input character to it. */
5719 /* TERMIOS is the latest and bestest, and seems most likely to
5720 work. If the system has it, use it. */
5723 cc_t
*sig_char
= NULL
;
5725 tcgetattr (XINT (p
->infd
), &t
);
5730 sig_char
= &t
.c_cc
[VINTR
];
5734 sig_char
= &t
.c_cc
[VQUIT
];
5738 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5739 sig_char
= &t
.c_cc
[VSWTCH
];
5741 sig_char
= &t
.c_cc
[VSUSP
];
5746 if (sig_char
&& *sig_char
!= CDISABLE
)
5748 send_process (proc
, sig_char
, 1, Qnil
);
5751 /* If we can't send the signal with a character,
5752 fall through and send it another way. */
5753 #else /* ! HAVE_TERMIOS */
5755 /* On Berkeley descendants, the following IOCTL's retrieve the
5756 current control characters. */
5757 #if defined (TIOCGLTC) && defined (TIOCGETC)
5765 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5766 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5769 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5770 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5774 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5775 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5777 #endif /* ! defined (SIGTSTP) */
5780 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5782 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5789 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5790 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5793 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5794 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5798 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5799 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5801 #endif /* ! defined (SIGTSTP) */
5803 #else /* ! defined (TCGETA) */
5804 Your configuration files are messed up
.
5805 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5806 you'd better be using one of the alternatives above! */
5807 #endif /* ! defined (TCGETA) */
5808 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5809 /* In this case, the code above should alway returns. */
5811 #endif /* ! defined HAVE_TERMIOS */
5813 /* The code above may fall through if it can't
5814 handle the signal. */
5815 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5818 /* Get the current pgrp using the tty itself, if we have that.
5819 Otherwise, use the pty to get the pgrp.
5820 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5821 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5822 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5823 His patch indicates that if TIOCGPGRP returns an error, then
5824 we should just assume that p->pid is also the process group id. */
5826 gid
= emacs_get_tty_pgrp (p
);
5829 /* If we can't get the information, assume
5830 the shell owns the tty. */
5831 gid
= XFASTINT (p
->pid
);
5833 /* It is not clear whether anything really can set GID to -1.
5834 Perhaps on some system one of those ioctls can or could do so.
5835 Or perhaps this is vestigial. */
5838 #else /* ! defined (TIOCGPGRP ) */
5839 /* Can't select pgrps on this system, so we know that
5840 the child itself heads the pgrp. */
5841 gid
= XFASTINT (p
->pid
);
5842 #endif /* ! defined (TIOCGPGRP ) */
5844 /* If current_group is lambda, and the shell owns the terminal,
5845 don't send any signal. */
5846 if (EQ (current_group
, Qlambda
) && gid
== XFASTINT (p
->pid
))
5854 p
->raw_status_low
= Qnil
;
5855 p
->raw_status_high
= Qnil
;
5857 XSETINT (p
->tick
, ++process_tick
);
5859 status_notify (NULL
);
5861 #endif /* ! defined (SIGCONT) */
5864 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5869 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5874 sys$
forcex (&(XFASTINT (p
->pid
)), 0, 1);
5877 flush_pending_output (XINT (p
->infd
));
5881 /* If we don't have process groups, send the signal to the immediate
5882 subprocess. That isn't really right, but it's better than any
5883 obvious alternative. */
5886 kill (XFASTINT (p
->pid
), signo
);
5890 /* gid may be a pid, or minus a pgrp's number */
5892 if (!NILP (current_group
))
5894 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
5895 EMACS_KILLPG (gid
, signo
);
5899 gid
= - XFASTINT (p
->pid
);
5902 #else /* ! defined (TIOCSIGSEND) */
5903 EMACS_KILLPG (gid
, signo
);
5904 #endif /* ! defined (TIOCSIGSEND) */
5907 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5908 doc
: /* Interrupt process PROCESS.
5909 PROCESS may be a process, a buffer, or the name of a process or buffer.
5910 No arg or nil means current buffer's process.
5911 Second arg CURRENT-GROUP non-nil means send signal to
5912 the current process-group of the process's controlling terminal
5913 rather than to the process's own process group.
5914 If the process is a shell, this means interrupt current subjob
5915 rather than the shell.
5917 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5918 don't send the signal. */)
5919 (process
, current_group
)
5920 Lisp_Object process
, current_group
;
5922 process_send_signal (process
, SIGINT
, current_group
, 0);
5926 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5927 doc
: /* Kill process PROCESS. May be process or name of one.
5928 See function `interrupt-process' for more details on usage. */)
5929 (process
, current_group
)
5930 Lisp_Object process
, current_group
;
5932 process_send_signal (process
, SIGKILL
, current_group
, 0);
5936 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5937 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5938 See function `interrupt-process' for more details on usage. */)
5939 (process
, current_group
)
5940 Lisp_Object process
, current_group
;
5942 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5946 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5947 doc
: /* Stop process PROCESS. May be process or name of one.
5948 See function `interrupt-process' for more details on usage.
5949 If PROCESS is a network process, inhibit handling of incoming traffic. */)
5950 (process
, current_group
)
5951 Lisp_Object process
, current_group
;
5954 if (PROCESSP (process
) && NETCONN_P (process
))
5956 struct Lisp_Process
*p
;
5958 p
= XPROCESS (process
);
5959 if (NILP (p
->command
)
5960 && XINT (p
->infd
) >= 0)
5962 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5963 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5970 error ("No SIGTSTP support");
5972 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5977 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5978 doc
: /* Continue process PROCESS. May be process or name of one.
5979 See function `interrupt-process' for more details on usage.
5980 If PROCESS is a network process, resume handling of incoming traffic. */)
5981 (process
, current_group
)
5982 Lisp_Object process
, current_group
;
5985 if (PROCESSP (process
) && NETCONN_P (process
))
5987 struct Lisp_Process
*p
;
5989 p
= XPROCESS (process
);
5990 if (EQ (p
->command
, Qt
)
5991 && XINT (p
->infd
) >= 0
5992 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
5994 FD_SET (XINT (p
->infd
), &input_wait_mask
);
5995 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
6002 process_send_signal (process
, SIGCONT
, current_group
, 0);
6004 error ("No SIGCONT support");
6009 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6010 2, 2, "sProcess (name or number): \nnSignal code: ",
6011 doc
: /* Send PROCESS the signal with code SIGCODE.
6012 PROCESS may also be an integer specifying the process id of the
6013 process to signal; in this case, the process need not be a child of
6015 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6017 Lisp_Object process
, sigcode
;
6021 if (INTEGERP (process
))
6027 if (STRINGP (process
))
6030 if (tem
= Fget_process (process
), NILP (tem
))
6032 pid
= Fstring_to_number (process
, make_number (10));
6033 if (XINT (pid
) != 0)
6039 process
= get_process (process
);
6044 CHECK_PROCESS (process
);
6045 pid
= XPROCESS (process
)->pid
;
6046 if (!INTEGERP (pid
) || XINT (pid
) <= 0)
6047 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6051 #define handle_signal(NAME, VALUE) \
6052 else if (!strcmp (name, NAME)) \
6053 XSETINT (sigcode, VALUE)
6055 if (INTEGERP (sigcode
))
6059 unsigned char *name
;
6061 CHECK_SYMBOL (sigcode
);
6062 name
= SDATA (SYMBOL_NAME (sigcode
));
6064 if (!strncmp(name
, "SIG", 3))
6070 handle_signal ("HUP", SIGHUP
);
6073 handle_signal ("INT", SIGINT
);
6076 handle_signal ("QUIT", SIGQUIT
);
6079 handle_signal ("ILL", SIGILL
);
6082 handle_signal ("ABRT", SIGABRT
);
6085 handle_signal ("EMT", SIGEMT
);
6088 handle_signal ("KILL", SIGKILL
);
6091 handle_signal ("FPE", SIGFPE
);
6094 handle_signal ("BUS", SIGBUS
);
6097 handle_signal ("SEGV", SIGSEGV
);
6100 handle_signal ("SYS", SIGSYS
);
6103 handle_signal ("PIPE", SIGPIPE
);
6106 handle_signal ("ALRM", SIGALRM
);
6109 handle_signal ("TERM", SIGTERM
);
6112 handle_signal ("URG", SIGURG
);
6115 handle_signal ("STOP", SIGSTOP
);
6118 handle_signal ("TSTP", SIGTSTP
);
6121 handle_signal ("CONT", SIGCONT
);
6124 handle_signal ("CHLD", SIGCHLD
);
6127 handle_signal ("TTIN", SIGTTIN
);
6130 handle_signal ("TTOU", SIGTTOU
);
6133 handle_signal ("IO", SIGIO
);
6136 handle_signal ("XCPU", SIGXCPU
);
6139 handle_signal ("XFSZ", SIGXFSZ
);
6142 handle_signal ("VTALRM", SIGVTALRM
);
6145 handle_signal ("PROF", SIGPROF
);
6148 handle_signal ("WINCH", SIGWINCH
);
6151 handle_signal ("INFO", SIGINFO
);
6154 handle_signal ("USR1", SIGUSR1
);
6157 handle_signal ("USR2", SIGUSR2
);
6160 error ("Undefined signal name %s", name
);
6163 #undef handle_signal
6165 return make_number (kill (XINT (pid
), XINT (sigcode
)));
6168 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6169 doc
: /* Make PROCESS see end-of-file in its input.
6170 EOF comes after any text already sent to it.
6171 PROCESS may be a process, a buffer, the name of a process or buffer, or
6172 nil, indicating the current buffer's process.
6173 If PROCESS is a network connection, or is a process communicating
6174 through a pipe (as opposed to a pty), then you cannot send any more
6175 text to PROCESS after you call this function. */)
6177 Lisp_Object process
;
6180 struct coding_system
*coding
;
6182 if (DATAGRAM_CONN_P (process
))
6185 proc
= get_process (process
);
6186 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
6188 /* Make sure the process is really alive. */
6189 if (! NILP (XPROCESS (proc
)->raw_status_low
))
6190 update_status (XPROCESS (proc
));
6191 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6192 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6194 if (CODING_REQUIRE_FLUSHING (coding
))
6196 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6197 send_process (proc
, "", 0, Qnil
);
6201 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6203 if (!NILP (XPROCESS (proc
)->pty_flag
))
6204 send_process (proc
, "\004", 1, Qnil
);
6207 int old_outfd
, new_outfd
;
6209 #ifdef HAVE_SHUTDOWN
6210 /* If this is a network connection, or socketpair is used
6211 for communication with the subprocess, call shutdown to cause EOF.
6212 (In some old system, shutdown to socketpair doesn't work.
6213 Then we just can't win.) */
6214 if (NILP (XPROCESS (proc
)->pid
)
6215 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
6216 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
6217 /* In case of socketpair, outfd == infd, so don't close it. */
6218 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
6219 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6220 #else /* not HAVE_SHUTDOWN */
6221 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6222 #endif /* not HAVE_SHUTDOWN */
6223 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6224 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
6226 if (!proc_encode_coding_system
[new_outfd
])
6227 proc_encode_coding_system
[new_outfd
]
6228 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6229 bcopy (proc_encode_coding_system
[old_outfd
],
6230 proc_encode_coding_system
[new_outfd
],
6231 sizeof (struct coding_system
));
6232 bzero (proc_encode_coding_system
[old_outfd
],
6233 sizeof (struct coding_system
));
6235 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
6241 /* Kill all processes associated with `buffer'.
6242 If `buffer' is nil, kill all processes */
6245 kill_buffer_processes (buffer
)
6248 Lisp_Object tail
, proc
;
6250 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6252 proc
= XCDR (XCAR (tail
));
6253 if (GC_PROCESSP (proc
)
6254 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6256 if (NETCONN_P (proc
))
6257 Fdelete_process (proc
);
6258 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
6259 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6264 /* On receipt of a signal that a child status has changed, loop asking
6265 about children with changed statuses until the system says there
6268 All we do is change the status; we do not run sentinels or print
6269 notifications. That is saved for the next time keyboard input is
6270 done, in order to avoid timing errors.
6272 ** WARNING: this can be called during garbage collection.
6273 Therefore, it must not be fooled by the presence of mark bits in
6276 ** USG WARNING: Although it is not obvious from the documentation
6277 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6278 signal() before executing at least one wait(), otherwise the
6279 handler will be called again, resulting in an infinite loop. The
6280 relevant portion of the documentation reads "SIGCLD signals will be
6281 queued and the signal-catching function will be continually
6282 reentered until the queue is empty". Invoking signal() causes the
6283 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6286 ** Malloc WARNING: This should never call malloc either directly or
6287 indirectly; if it does, that is a bug */
6290 sigchld_handler (signo
)
6293 int old_errno
= errno
;
6295 register struct Lisp_Process
*p
;
6296 extern EMACS_TIME
*input_available_clear_time
;
6298 SIGNAL_THREAD_CHECK (signo
);
6302 sigheld
|= sigbit (SIGCHLD
);
6314 #endif /* no WUNTRACED */
6315 /* Keep trying to get a status until we get a definitive result. */
6319 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6321 while (pid
< 0 && errno
== EINTR
);
6325 /* PID == 0 means no processes found, PID == -1 means a real
6326 failure. We have done all our job, so return. */
6328 /* USG systems forget handlers when they are used;
6329 must reestablish each time */
6330 #if defined (USG) && !defined (POSIX_SIGNALS)
6331 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6334 sigheld
&= ~sigbit (SIGCHLD
);
6342 #endif /* no WNOHANG */
6344 /* Find the process that signaled us, and record its status. */
6347 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6349 proc
= XCDR (XCAR (tail
));
6350 p
= XPROCESS (proc
);
6351 if (GC_EQ (p
->childp
, Qt
) && XINT (p
->pid
) == pid
)
6356 /* Look for an asynchronous process whose pid hasn't been filled
6359 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6361 proc
= XCDR (XCAR (tail
));
6362 p
= XPROCESS (proc
);
6363 if (GC_INTEGERP (p
->pid
) && XINT (p
->pid
) == -1)
6368 /* Change the status of the process that was found. */
6371 union { int i
; WAITTYPE wt
; } u
;
6372 int clear_desc_flag
= 0;
6374 XSETINT (p
->tick
, ++process_tick
);
6376 XSETINT (p
->raw_status_low
, u
.i
& 0xffff);
6377 XSETINT (p
->raw_status_high
, u
.i
>> 16);
6379 /* If process has terminated, stop waiting for its output. */
6380 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6381 && XINT (p
->infd
) >= 0)
6382 clear_desc_flag
= 1;
6384 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6385 if (clear_desc_flag
)
6387 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6388 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6391 /* Tell wait_reading_process_output that it needs to wake up and
6393 if (input_available_clear_time
)
6394 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6397 /* There was no asynchronous process found for that id. Check
6398 if we have a synchronous process. */
6401 synch_process_alive
= 0;
6403 /* Report the status of the synchronous process. */
6405 synch_process_retcode
= WRETCODE (w
);
6406 else if (WIFSIGNALED (w
))
6407 synch_process_termsig
= WTERMSIG (w
);
6409 /* Tell wait_reading_process_output that it needs to wake up and
6411 if (input_available_clear_time
)
6412 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6415 /* On some systems, we must return right away.
6416 If any more processes want to signal us, we will
6418 Otherwise (on systems that have WNOHANG), loop around
6419 to use up all the processes that have something to tell us. */
6420 #if (defined WINDOWSNT \
6421 || (defined USG && !defined GNU_LINUX \
6422 && !(defined HPUX && defined WNOHANG)))
6423 #if defined (USG) && ! defined (POSIX_SIGNALS)
6424 signal (signo
, sigchld_handler
);
6428 #endif /* USG, but not HPUX with WNOHANG */
6434 exec_sentinel_unwind (data
)
6437 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6442 exec_sentinel_error_handler (error
)
6445 cmd_error_internal (error
, "error in process sentinel: ");
6447 update_echo_area ();
6448 Fsleep_for (make_number (2), Qnil
);
6453 exec_sentinel (proc
, reason
)
6454 Lisp_Object proc
, reason
;
6456 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6457 register struct Lisp_Process
*p
= XPROCESS (proc
);
6458 int count
= SPECPDL_INDEX ();
6459 int outer_running_asynch_code
= running_asynch_code
;
6460 int waiting
= waiting_for_user_input_p
;
6462 /* No need to gcpro these, because all we do with them later
6463 is test them for EQness, and none of them should be a string. */
6464 odeactivate
= Vdeactivate_mark
;
6465 XSETBUFFER (obuffer
, current_buffer
);
6466 okeymap
= current_buffer
->keymap
;
6468 sentinel
= p
->sentinel
;
6469 if (NILP (sentinel
))
6472 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6473 assure that it gets restored no matter how the sentinel exits. */
6475 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6476 /* Inhibit quit so that random quits don't screw up a running filter. */
6477 specbind (Qinhibit_quit
, Qt
);
6478 specbind (Qlast_nonmenu_event
, Qt
);
6480 /* In case we get recursively called,
6481 and we already saved the match data nonrecursively,
6482 save the same match data in safely recursive fashion. */
6483 if (outer_running_asynch_code
)
6486 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6487 restore_search_regs ();
6488 record_unwind_save_match_data ();
6489 Fset_match_data (tem
, Qt
);
6492 /* For speed, if a search happens within this code,
6493 save the match data in a special nonrecursive fashion. */
6494 running_asynch_code
= 1;
6496 internal_condition_case_1 (read_process_output_call
,
6498 Fcons (proc
, Fcons (reason
, Qnil
))),
6499 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6500 exec_sentinel_error_handler
);
6502 /* If we saved the match data nonrecursively, restore it now. */
6503 restore_search_regs ();
6504 running_asynch_code
= outer_running_asynch_code
;
6506 Vdeactivate_mark
= odeactivate
;
6508 /* Restore waiting_for_user_input_p as it was
6509 when we were called, in case the filter clobbered it. */
6510 waiting_for_user_input_p
= waiting
;
6513 if (! EQ (Fcurrent_buffer (), obuffer
)
6514 || ! EQ (current_buffer
->keymap
, okeymap
))
6516 /* But do it only if the caller is actually going to read events.
6517 Otherwise there's no need to make him wake up, and it could
6518 cause trouble (for example it would make Fsit_for return). */
6519 if (waiting_for_user_input_p
== -1)
6520 record_asynch_buffer_change ();
6522 unbind_to (count
, Qnil
);
6525 /* Report all recent events of a change in process status
6526 (either run the sentinel or output a message).
6527 This is usually done while Emacs is waiting for keyboard input
6528 but can be done at other times. */
6531 status_notify (deleting_process
)
6532 struct Lisp_Process
*deleting_process
;
6534 register Lisp_Object proc
, buffer
;
6535 Lisp_Object tail
, msg
;
6536 struct gcpro gcpro1
, gcpro2
;
6540 /* We need to gcpro tail; if read_process_output calls a filter
6541 which deletes a process and removes the cons to which tail points
6542 from Vprocess_alist, and then causes a GC, tail is an unprotected
6546 /* Set this now, so that if new processes are created by sentinels
6547 that we run, we get called again to handle their status changes. */
6548 update_tick
= process_tick
;
6550 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6553 register struct Lisp_Process
*p
;
6555 proc
= Fcdr (Fcar (tail
));
6556 p
= XPROCESS (proc
);
6558 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6560 XSETINT (p
->update_tick
, XINT (p
->tick
));
6562 /* If process is still active, read any output that remains. */
6563 while (! EQ (p
->filter
, Qt
)
6564 && ! EQ (p
->status
, Qconnect
)
6565 && ! EQ (p
->status
, Qlisten
)
6566 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6567 && XINT (p
->infd
) >= 0
6568 && p
!= deleting_process
6569 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6573 /* Get the text to use for the message. */
6574 if (!NILP (p
->raw_status_low
))
6576 msg
= status_message (p
);
6578 /* If process is terminated, deactivate it or delete it. */
6580 if (CONSP (p
->status
))
6581 symbol
= XCAR (p
->status
);
6583 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6584 || EQ (symbol
, Qclosed
))
6586 if (delete_exited_processes
)
6587 remove_process (proc
);
6589 deactivate_process (proc
);
6592 /* The actions above may have further incremented p->tick.
6593 So set p->update_tick again
6594 so that an error in the sentinel will not cause
6595 this code to be run again. */
6596 XSETINT (p
->update_tick
, XINT (p
->tick
));
6597 /* Now output the message suitably. */
6598 if (!NILP (p
->sentinel
))
6599 exec_sentinel (proc
, msg
);
6600 /* Don't bother with a message in the buffer
6601 when a process becomes runnable. */
6602 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6604 Lisp_Object ro
, tem
;
6605 struct buffer
*old
= current_buffer
;
6606 int opoint
, opoint_byte
;
6607 int before
, before_byte
;
6609 ro
= XBUFFER (buffer
)->read_only
;
6611 /* Avoid error if buffer is deleted
6612 (probably that's why the process is dead, too) */
6613 if (NILP (XBUFFER (buffer
)->name
))
6615 Fset_buffer (buffer
);
6618 opoint_byte
= PT_BYTE
;
6619 /* Insert new output into buffer
6620 at the current end-of-output marker,
6621 thus preserving logical ordering of input and output. */
6622 if (XMARKER (p
->mark
)->buffer
)
6623 Fgoto_char (p
->mark
);
6625 SET_PT_BOTH (ZV
, ZV_BYTE
);
6628 before_byte
= PT_BYTE
;
6630 tem
= current_buffer
->read_only
;
6631 current_buffer
->read_only
= Qnil
;
6632 insert_string ("\nProcess ");
6633 Finsert (1, &p
->name
);
6634 insert_string (" ");
6636 current_buffer
->read_only
= tem
;
6637 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6639 if (opoint
>= before
)
6640 SET_PT_BOTH (opoint
+ (PT
- before
),
6641 opoint_byte
+ (PT_BYTE
- before_byte
));
6643 SET_PT_BOTH (opoint
, opoint_byte
);
6645 set_buffer_internal (old
);
6650 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6651 redisplay_preserve_echo_area (13);
6657 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6658 Sset_process_coding_system
, 1, 3, 0,
6659 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6660 DECODING will be used to decode subprocess output and ENCODING to
6661 encode subprocess input. */)
6662 (process
, decoding
, encoding
)
6663 register Lisp_Object process
, decoding
, encoding
;
6665 register struct Lisp_Process
*p
;
6667 CHECK_PROCESS (process
);
6668 p
= XPROCESS (process
);
6669 if (XINT (p
->infd
) < 0)
6670 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6671 if (XINT (p
->outfd
) < 0)
6672 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6673 Fcheck_coding_system (decoding
);
6674 Fcheck_coding_system (encoding
);
6676 p
->decode_coding_system
= decoding
;
6677 p
->encode_coding_system
= encoding
;
6678 setup_process_coding_systems (process
);
6683 DEFUN ("process-coding-system",
6684 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6685 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6687 register Lisp_Object process
;
6689 CHECK_PROCESS (process
);
6690 return Fcons (XPROCESS (process
)->decode_coding_system
,
6691 XPROCESS (process
)->encode_coding_system
);
6694 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6695 Sset_process_filter_multibyte
, 2, 2, 0,
6696 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6697 If FLAG is non-nil, the filter is given multibyte strings.
6698 If FLAG is nil, the filter is given unibyte strings. In this case,
6699 all character code conversion except for end-of-line conversion is
6702 Lisp_Object process
, flag
;
6704 register struct Lisp_Process
*p
;
6706 CHECK_PROCESS (process
);
6707 p
= XPROCESS (process
);
6708 p
->filter_multibyte
= flag
;
6709 setup_process_coding_systems (process
);
6714 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6715 Sprocess_filter_multibyte_p
, 1, 1, 0,
6716 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6718 Lisp_Object process
;
6720 register struct Lisp_Process
*p
;
6722 CHECK_PROCESS (process
);
6723 p
= XPROCESS (process
);
6725 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6730 /* The first time this is called, assume keyboard input comes from DESC
6731 instead of from where we used to expect it.
6732 Subsequent calls mean assume input keyboard can come from DESC
6733 in addition to other places. */
6735 static int add_keyboard_wait_descriptor_called_flag
;
6738 add_keyboard_wait_descriptor (desc
)
6741 if (! add_keyboard_wait_descriptor_called_flag
)
6742 FD_CLR (0, &input_wait_mask
);
6743 add_keyboard_wait_descriptor_called_flag
= 1;
6744 FD_SET (desc
, &input_wait_mask
);
6745 FD_SET (desc
, &non_process_wait_mask
);
6746 if (desc
> max_keyboard_desc
)
6747 max_keyboard_desc
= desc
;
6750 /* From now on, do not expect DESC to give keyboard input. */
6753 delete_keyboard_wait_descriptor (desc
)
6757 int lim
= max_keyboard_desc
;
6759 FD_CLR (desc
, &input_wait_mask
);
6760 FD_CLR (desc
, &non_process_wait_mask
);
6762 if (desc
== max_keyboard_desc
)
6763 for (fd
= 0; fd
< lim
; fd
++)
6764 if (FD_ISSET (fd
, &input_wait_mask
)
6765 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6766 max_keyboard_desc
= fd
;
6769 /* Return nonzero if *MASK has a bit set
6770 that corresponds to one of the keyboard input descriptors. */
6773 keyboard_bit_set (mask
)
6778 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6779 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6780 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6793 if (! noninteractive
|| initialized
)
6795 signal (SIGCHLD
, sigchld_handler
);
6798 FD_ZERO (&input_wait_mask
);
6799 FD_ZERO (&non_keyboard_wait_mask
);
6800 FD_ZERO (&non_process_wait_mask
);
6801 max_process_desc
= 0;
6803 #ifdef NON_BLOCKING_CONNECT
6804 FD_ZERO (&connect_wait_mask
);
6805 num_pending_connects
= 0;
6808 #ifdef ADAPTIVE_READ_BUFFERING
6809 process_output_delay_count
= 0;
6810 process_output_skip
= 0;
6813 FD_SET (0, &input_wait_mask
);
6815 Vprocess_alist
= Qnil
;
6816 for (i
= 0; i
< MAXDESC
; i
++)
6818 chan_process
[i
] = Qnil
;
6819 proc_buffered_char
[i
] = -1;
6821 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6822 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6823 #ifdef DATAGRAM_SOCKETS
6824 bzero (datagram_address
, sizeof datagram_address
);
6829 Lisp_Object subfeatures
= Qnil
;
6830 struct socket_options
*sopt
;
6832 #define ADD_SUBFEATURE(key, val) \
6833 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6835 #ifdef NON_BLOCKING_CONNECT
6836 ADD_SUBFEATURE (QCnowait
, Qt
);
6838 #ifdef DATAGRAM_SOCKETS
6839 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6841 #ifdef HAVE_LOCAL_SOCKETS
6842 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6844 ADD_SUBFEATURE (QCfamily
, Qipv4
);
6846 ADD_SUBFEATURE (QCfamily
, Qipv6
);
6848 #ifdef HAVE_GETSOCKNAME
6849 ADD_SUBFEATURE (QCservice
, Qt
);
6851 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6852 ADD_SUBFEATURE (QCserver
, Qt
);
6855 for (sopt
= socket_options
; sopt
->name
; sopt
++)
6856 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
6858 Fprovide (intern ("make-network-process"), subfeatures
);
6860 #endif /* HAVE_SOCKETS */
6862 #if defined (DARWIN) || defined (MAC_OSX)
6863 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
6864 processes. As such, we only change the default value. */
6867 char *release
= get_operating_system_release();
6868 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
6869 && release
[1] == '.')) {
6870 Vprocess_connection_type
= Qnil
;
6879 Qprocessp
= intern ("processp");
6880 staticpro (&Qprocessp
);
6881 Qrun
= intern ("run");
6883 Qstop
= intern ("stop");
6885 Qsignal
= intern ("signal");
6886 staticpro (&Qsignal
);
6888 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6891 Qexit = intern ("exit");
6892 staticpro (&Qexit); */
6894 Qopen
= intern ("open");
6896 Qclosed
= intern ("closed");
6897 staticpro (&Qclosed
);
6898 Qconnect
= intern ("connect");
6899 staticpro (&Qconnect
);
6900 Qfailed
= intern ("failed");
6901 staticpro (&Qfailed
);
6902 Qlisten
= intern ("listen");
6903 staticpro (&Qlisten
);
6904 Qlocal
= intern ("local");
6905 staticpro (&Qlocal
);
6906 Qipv4
= intern ("ipv4");
6909 Qipv6
= intern ("ipv6");
6912 Qdatagram
= intern ("datagram");
6913 staticpro (&Qdatagram
);
6915 QCname
= intern (":name");
6916 staticpro (&QCname
);
6917 QCbuffer
= intern (":buffer");
6918 staticpro (&QCbuffer
);
6919 QChost
= intern (":host");
6920 staticpro (&QChost
);
6921 QCservice
= intern (":service");
6922 staticpro (&QCservice
);
6923 QCtype
= intern (":type");
6924 staticpro (&QCtype
);
6925 QClocal
= intern (":local");
6926 staticpro (&QClocal
);
6927 QCremote
= intern (":remote");
6928 staticpro (&QCremote
);
6929 QCcoding
= intern (":coding");
6930 staticpro (&QCcoding
);
6931 QCserver
= intern (":server");
6932 staticpro (&QCserver
);
6933 QCnowait
= intern (":nowait");
6934 staticpro (&QCnowait
);
6935 QCsentinel
= intern (":sentinel");
6936 staticpro (&QCsentinel
);
6937 QClog
= intern (":log");
6939 QCnoquery
= intern (":noquery");
6940 staticpro (&QCnoquery
);
6941 QCstop
= intern (":stop");
6942 staticpro (&QCstop
);
6943 QCoptions
= intern (":options");
6944 staticpro (&QCoptions
);
6945 QCplist
= intern (":plist");
6946 staticpro (&QCplist
);
6947 QCfilter_multibyte
= intern (":filter-multibyte");
6948 staticpro (&QCfilter_multibyte
);
6950 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
6951 staticpro (&Qlast_nonmenu_event
);
6953 staticpro (&Vprocess_alist
);
6955 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
6956 doc
: /* *Non-nil means delete processes immediately when they exit.
6957 nil means don't delete them until `list-processes' is run. */);
6959 delete_exited_processes
= 1;
6961 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
6962 doc
: /* Control type of device used to communicate with subprocesses.
6963 Values are nil to use a pipe, or t or `pty' to use a pty.
6964 The value has no effect if the system has no ptys or if all ptys are busy:
6965 then a pipe is used in any case.
6966 The value takes effect when `start-process' is called. */);
6967 Vprocess_connection_type
= Qt
;
6969 #ifdef ADAPTIVE_READ_BUFFERING
6970 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
6971 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
6972 On some systems, when Emacs reads the output from a subprocess, the output data
6973 is read in very small blocks, potentially resulting in very poor performance.
6974 This behavior can be remedied to some extent by setting this variable to a
6975 non-nil value, as it will automatically delay reading from such processes, to
6976 allowing them to produce more output before Emacs tries to read it.
6977 If the value is t, the delay is reset after each write to the process; any other
6978 non-nil value means that the delay is not reset on write.
6979 The variable takes effect when `start-process' is called. */);
6980 Vprocess_adaptive_read_buffering
= Qt
;
6983 defsubr (&Sprocessp
);
6984 defsubr (&Sget_process
);
6985 defsubr (&Sget_buffer_process
);
6986 defsubr (&Sdelete_process
);
6987 defsubr (&Sprocess_status
);
6988 defsubr (&Sprocess_exit_status
);
6989 defsubr (&Sprocess_id
);
6990 defsubr (&Sprocess_name
);
6991 defsubr (&Sprocess_tty_name
);
6992 defsubr (&Sprocess_command
);
6993 defsubr (&Sset_process_buffer
);
6994 defsubr (&Sprocess_buffer
);
6995 defsubr (&Sprocess_mark
);
6996 defsubr (&Sset_process_filter
);
6997 defsubr (&Sprocess_filter
);
6998 defsubr (&Sset_process_sentinel
);
6999 defsubr (&Sprocess_sentinel
);
7000 defsubr (&Sset_process_window_size
);
7001 defsubr (&Sset_process_inherit_coding_system_flag
);
7002 defsubr (&Sprocess_inherit_coding_system_flag
);
7003 defsubr (&Sset_process_query_on_exit_flag
);
7004 defsubr (&Sprocess_query_on_exit_flag
);
7005 defsubr (&Sprocess_contact
);
7006 defsubr (&Sprocess_plist
);
7007 defsubr (&Sset_process_plist
);
7008 defsubr (&Slist_processes
);
7009 defsubr (&Sprocess_list
);
7010 defsubr (&Sstart_process
);
7012 defsubr (&Sset_network_process_option
);
7013 defsubr (&Smake_network_process
);
7014 defsubr (&Sformat_network_address
);
7015 #endif /* HAVE_SOCKETS */
7016 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7018 defsubr (&Snetwork_interface_list
);
7020 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7021 defsubr (&Snetwork_interface_info
);
7023 #endif /* HAVE_SOCKETS ... */
7024 #ifdef DATAGRAM_SOCKETS
7025 defsubr (&Sprocess_datagram_address
);
7026 defsubr (&Sset_process_datagram_address
);
7028 defsubr (&Saccept_process_output
);
7029 defsubr (&Sprocess_send_region
);
7030 defsubr (&Sprocess_send_string
);
7031 defsubr (&Sinterrupt_process
);
7032 defsubr (&Skill_process
);
7033 defsubr (&Squit_process
);
7034 defsubr (&Sstop_process
);
7035 defsubr (&Scontinue_process
);
7036 defsubr (&Sprocess_running_child_p
);
7037 defsubr (&Sprocess_send_eof
);
7038 defsubr (&Ssignal_process
);
7039 defsubr (&Swaiting_for_user_input_p
);
7040 /* defsubr (&Sprocess_connection); */
7041 defsubr (&Sset_process_coding_system
);
7042 defsubr (&Sprocess_coding_system
);
7043 defsubr (&Sset_process_filter_multibyte
);
7044 defsubr (&Sprocess_filter_multibyte_p
);
7048 #else /* not subprocesses */
7050 #include <sys/types.h>
7054 #include "systime.h"
7055 #include "character.h"
7057 #include "termopts.h"
7058 #include "sysselect.h"
7060 extern int frame_garbaged
;
7062 extern EMACS_TIME
timer_check ();
7063 extern int timers_run
;
7067 /* As described above, except assuming that there are no subprocesses:
7069 Wait for timeout to elapse and/or keyboard input to be available.
7072 timeout in seconds, or
7073 zero for no limit, or
7074 -1 means gobble data immediately available but don't wait for any.
7076 read_kbd is a Lisp_Object:
7077 0 to ignore keyboard input, or
7078 1 to return when input is available, or
7079 -1 means caller will actually read the input, so don't throw to
7082 see full version for other parameters. We know that wait_proc will
7083 always be NULL, since `subprocesses' isn't defined.
7085 do_display != 0 means redisplay should be done to show subprocess
7086 output that arrives.
7088 Return true iff we received input from any process. */
7091 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
7092 wait_for_cell
, wait_proc
, just_wait_proc
)
7093 int time_limit
, microsecs
, read_kbd
, do_display
;
7094 Lisp_Object wait_for_cell
;
7095 struct Lisp_Process
*wait_proc
;
7099 EMACS_TIME end_time
, timeout
;
7100 SELECT_TYPE waitchannels
;
7103 /* What does time_limit really mean? */
7104 if (time_limit
|| microsecs
)
7106 EMACS_GET_TIME (end_time
);
7107 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
7108 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
7111 /* Turn off periodic alarms (in case they are in use)
7112 and then turn off any other atimers,
7113 because the select emulator uses alarms. */
7115 turn_on_atimers (0);
7119 int timeout_reduced_for_timers
= 0;
7121 /* If calling from keyboard input, do not quit
7122 since we want to return C-g as an input character.
7123 Otherwise, do pending quit if requested. */
7127 /* Exit now if the cell we're waiting for became non-nil. */
7128 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7131 /* Compute time from now till when time limit is up */
7132 /* Exit if already run out */
7133 if (time_limit
== -1)
7135 /* -1 specified for timeout means
7136 gobble output available now
7137 but don't wait at all. */
7139 EMACS_SET_SECS_USECS (timeout
, 0, 0);
7141 else if (time_limit
|| microsecs
)
7143 EMACS_GET_TIME (timeout
);
7144 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
7145 if (EMACS_TIME_NEG_P (timeout
))
7150 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
7153 /* If our caller will not immediately handle keyboard events,
7154 run timer events directly.
7155 (Callers that will immediately read keyboard events
7156 call timer_delay on their own.) */
7157 if (NILP (wait_for_cell
))
7159 EMACS_TIME timer_delay
;
7163 int old_timers_run
= timers_run
;
7164 timer_delay
= timer_check (1);
7165 if (timers_run
!= old_timers_run
&& do_display
)
7166 /* We must retry, since a timer may have requeued itself
7167 and that could alter the time delay. */
7168 redisplay_preserve_echo_area (14);
7172 while (!detect_input_pending ());
7174 /* If there is unread keyboard input, also return. */
7176 && requeued_events_pending_p ())
7179 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
7181 EMACS_TIME difference
;
7182 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
7183 if (EMACS_TIME_NEG_P (difference
))
7185 timeout
= timer_delay
;
7186 timeout_reduced_for_timers
= 1;
7191 /* Cause C-g and alarm signals to take immediate action,
7192 and cause input available signals to zero out timeout. */
7194 set_waiting_for_input (&timeout
);
7196 /* Wait till there is something to do. */
7198 if (! read_kbd
&& NILP (wait_for_cell
))
7199 FD_ZERO (&waitchannels
);
7201 FD_SET (0, &waitchannels
);
7203 /* If a frame has been newly mapped and needs updating,
7204 reprocess its display stuff. */
7205 if (frame_garbaged
&& do_display
)
7207 clear_waiting_for_input ();
7208 redisplay_preserve_echo_area (15);
7210 set_waiting_for_input (&timeout
);
7213 if (read_kbd
&& detect_input_pending ())
7216 FD_ZERO (&waitchannels
);
7219 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7224 /* Make C-g and alarm signals set flags again */
7225 clear_waiting_for_input ();
7227 /* If we woke up due to SIGWINCH, actually change size now. */
7228 do_pending_window_change (0);
7230 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7231 /* We waited the full specified time, so return now. */
7236 /* If the system call was interrupted, then go around the
7238 if (xerrno
== EINTR
)
7239 FD_ZERO (&waitchannels
);
7241 error ("select error: %s", emacs_strerror (xerrno
));
7244 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7245 /* System sometimes fails to deliver SIGIO. */
7246 kill (getpid (), SIGIO
);
7249 if (read_kbd
&& interrupt_input
&& (waitchannels
& 1))
7250 kill (getpid (), SIGIO
);
7253 /* Check for keyboard input */
7256 && detect_input_pending_run_timers (do_display
))
7258 swallow_events (do_display
);
7259 if (detect_input_pending_run_timers (do_display
))
7263 /* If there is unread keyboard input, also return. */
7265 && requeued_events_pending_p ())
7268 /* If wait_for_cell. check for keyboard input
7269 but don't run any timers.
7270 ??? (It seems wrong to me to check for keyboard
7271 input at all when wait_for_cell, but the code
7272 has been this way since July 1994.
7273 Try changing this after version 19.31.) */
7274 if (! NILP (wait_for_cell
)
7275 && detect_input_pending ())
7277 swallow_events (do_display
);
7278 if (detect_input_pending ())
7282 /* Exit now if the cell we're waiting for became non-nil. */
7283 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7293 /* Don't confuse make-docfile by having two doc strings for this function.
7294 make-docfile does not pay attention to #if, for good reason! */
7295 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7298 register Lisp_Object name
;
7303 /* Don't confuse make-docfile by having two doc strings for this function.
7304 make-docfile does not pay attention to #if, for good reason! */
7305 DEFUN ("process-inherit-coding-system-flag",
7306 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7310 register Lisp_Object process
;
7312 /* Ignore the argument and return the value of
7313 inherit-process-coding-system. */
7314 return inherit_process_coding_system
? Qt
: Qnil
;
7317 /* Kill all processes associated with `buffer'.
7318 If `buffer' is nil, kill all processes.
7319 Since we have no subprocesses, this does nothing. */
7322 kill_buffer_processes (buffer
)
7335 QCtype
= intern (":type");
7336 staticpro (&QCtype
);
7338 defsubr (&Sget_buffer_process
);
7339 defsubr (&Sprocess_inherit_coding_system_flag
);
7343 #endif /* not subprocesses */
7345 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7346 (do not change this comment) */