1 /* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
3 1996, 1998, 1999, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008 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 3 of the License, or
11 (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>. */
25 /* This file is split into two parts by the following preprocessor
26 conditional. The 'then' clause contains all of the support for
27 asynchronous subprocesses. The 'else' clause contains stub
28 versions of some of the asynchronous subprocess routines that are
29 often called elsewhere in Emacs, so we don't have to #ifdef the
30 sections that call them. */
38 #include <sys/types.h> /* some typedefs are used in sys/file.h */
41 #ifdef HAVE_INTTYPES_H
48 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
51 #endif /* not WINDOWSNT */
53 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
54 #include <sys/socket.h>
56 #include <netinet/in.h>
57 #include <arpa/inet.h>
59 /* Are local (unix) sockets supported? */
60 #if defined (HAVE_SYS_UN_H)
61 #if !defined (AF_LOCAL) && defined (AF_UNIX)
62 #define AF_LOCAL AF_UNIX
65 #define HAVE_LOCAL_SOCKETS
69 #endif /* HAVE_SOCKETS */
71 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
76 #if defined(BSD_SYSTEM)
77 #include <sys/ioctl.h>
78 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
80 #endif /* HAVE_PTYS and no O_NDELAY */
81 #endif /* BSD_SYSTEM */
83 #ifdef BROKEN_O_NONBLOCK
85 #endif /* BROKEN_O_NONBLOCK */
91 /* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
93 #if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
94 /* sys/ioctl.h may have been included already */
96 #include <sys/ioctl.h>
103 #include <sys/sysmacros.h> /* for "minor" */
104 #endif /* not IRIS */
107 #include <sys/wait.h>
111 #include <netinet/in.h>
112 #include <arpa/nameser.h>
122 #include "character.h"
126 #include "termhooks.h"
127 #include "termopts.h"
128 #include "commands.h"
129 #include "keyboard.h"
130 #include "blockinput.h"
131 #include "dispextern.h"
132 #include "composite.h"
135 Lisp_Object Qprocessp
;
136 Lisp_Object Qrun
, Qstop
, Qsignal
;
137 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
138 Lisp_Object Qlocal
, Qipv4
, Qdatagram
;
142 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
143 Lisp_Object QClocal
, QCremote
, QCcoding
;
144 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
145 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
146 Lisp_Object Qlast_nonmenu_event
;
147 /* QCfamily is declared and initialized in xfaces.c,
148 QCfilter in keyboard.c. */
149 extern Lisp_Object QCfamily
, QCfilter
;
151 /* Qexit is declared and initialized in eval.c. */
153 /* QCfamily is defined in xfaces.c. */
154 extern Lisp_Object QCfamily
;
155 /* QCfilter is defined in keyboard.c. */
156 extern Lisp_Object QCfilter
;
158 /* a process object is a network connection when its childp field is neither
159 Qt nor Qnil but is instead a property list (KEY VAL ...). */
162 #define NETCONN_P(p) (CONSP (XPROCESS (p)->childp))
163 #define NETCONN1_P(p) (CONSP ((p)->childp))
165 #define NETCONN_P(p) 0
166 #define NETCONN1_P(p) 0
167 #endif /* HAVE_SOCKETS */
169 /* Define first descriptor number available for subprocesses. */
171 #define FIRST_PROC_DESC 1
173 #define FIRST_PROC_DESC 3
176 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
179 #if !defined (SIGCHLD) && defined (SIGCLD)
180 #define SIGCHLD SIGCLD
183 #include "syssignal.h"
187 extern char *get_operating_system_release ();
193 extern char *sys_errlist
[];
200 /* t means use pty, nil means use a pipe,
201 maybe other values to come. */
202 static Lisp_Object Vprocess_connection_type
;
204 /* These next two vars are non-static since sysdep.c uses them in the
205 emulation of `select'. */
206 /* Number of events of change of status of a process. */
208 /* Number of events for which the user or sentinel has been notified. */
211 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
213 #ifdef BROKEN_NON_BLOCKING_CONNECT
214 #undef NON_BLOCKING_CONNECT
216 #ifndef NON_BLOCKING_CONNECT
219 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
220 #if defined (O_NONBLOCK) || defined (O_NDELAY)
221 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
222 #define NON_BLOCKING_CONNECT
223 #endif /* EWOULDBLOCK || EINPROGRESS */
224 #endif /* O_NONBLOCK || O_NDELAY */
225 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
226 #endif /* HAVE_SELECT */
227 #endif /* HAVE_SOCKETS */
228 #endif /* NON_BLOCKING_CONNECT */
229 #endif /* BROKEN_NON_BLOCKING_CONNECT */
231 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
232 this system. We need to read full packets, so we need a
233 "non-destructive" select. So we require either native select,
234 or emulation of select using FIONREAD. */
236 #ifdef BROKEN_DATAGRAM_SOCKETS
237 #undef DATAGRAM_SOCKETS
239 #ifndef DATAGRAM_SOCKETS
241 #if defined (HAVE_SELECT) || defined (FIONREAD)
242 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
243 #define DATAGRAM_SOCKETS
244 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
245 #endif /* HAVE_SELECT || FIONREAD */
246 #endif /* HAVE_SOCKETS */
247 #endif /* DATAGRAM_SOCKETS */
248 #endif /* BROKEN_DATAGRAM_SOCKETS */
251 #undef NON_BLOCKING_CONNECT
252 #undef DATAGRAM_SOCKETS
255 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
256 #ifdef EMACS_HAS_USECS
257 #define ADAPTIVE_READ_BUFFERING
261 #ifdef ADAPTIVE_READ_BUFFERING
262 #define READ_OUTPUT_DELAY_INCREMENT 10000
263 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
264 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
266 /* Number of processes which have a non-zero read_output_delay,
267 and therefore might be delayed for adaptive read buffering. */
269 static int process_output_delay_count
;
271 /* Non-zero if any process has non-nil read_output_skip. */
273 static int process_output_skip
;
275 /* Non-nil means to delay reading process output to improve buffering.
276 A value of t means that delay is reset after each send, any other
277 non-nil value does not reset the delay. A value of nil disables
278 adaptive read buffering completely. */
279 static Lisp_Object Vprocess_adaptive_read_buffering
;
281 #define process_output_delay_count 0
285 #include "sysselect.h"
287 static int keyboard_bit_set
P_ ((SELECT_TYPE
*));
288 static void deactivate_process
P_ ((Lisp_Object
));
289 static void status_notify
P_ ((struct Lisp_Process
*));
290 static int read_process_output
P_ ((Lisp_Object
, int));
292 /* If we support a window system, turn on the code to poll periodically
293 to detect C-g. It isn't actually used when doing interrupt input. */
294 #ifdef HAVE_WINDOW_SYSTEM
295 #define POLL_FOR_INPUT
298 static Lisp_Object
get_process ();
299 static void exec_sentinel ();
301 extern EMACS_TIME
timer_check ();
302 extern int timers_run
;
304 /* Mask of bits indicating the descriptors that we wait for input on. */
306 static SELECT_TYPE input_wait_mask
;
308 /* Mask that excludes keyboard input descriptor(s). */
310 static SELECT_TYPE non_keyboard_wait_mask
;
312 /* Mask that excludes process input descriptor(s). */
314 static SELECT_TYPE non_process_wait_mask
;
316 /* Mask for the gpm mouse input descriptor. */
318 static SELECT_TYPE gpm_wait_mask
;
320 #ifdef NON_BLOCKING_CONNECT
321 /* Mask of bits indicating the descriptors that we wait for connect to
322 complete on. Once they complete, they are removed from this mask
323 and added to the input_wait_mask and non_keyboard_wait_mask. */
325 static SELECT_TYPE connect_wait_mask
;
327 /* Number of bits set in connect_wait_mask. */
328 static int num_pending_connects
;
330 #define IF_NON_BLOCKING_CONNECT(s) s
332 #define IF_NON_BLOCKING_CONNECT(s)
335 /* The largest descriptor currently in use for a process object. */
336 static int max_process_desc
;
338 /* The largest descriptor currently in use for keyboard input. */
339 static int max_keyboard_desc
;
341 /* The largest descriptor currently in use for gpm mouse input. */
342 static int max_gpm_desc
;
344 /* Nonzero means delete a process right away if it exits. */
345 static int delete_exited_processes
;
347 /* Indexed by descriptor, gives the process (if any) for that descriptor */
348 Lisp_Object chan_process
[MAXDESC
];
350 /* Alist of elements (NAME . PROCESS) */
351 Lisp_Object Vprocess_alist
;
353 /* Buffered-ahead input char from process, indexed by channel.
354 -1 means empty (no char is buffered).
355 Used on sys V where the only way to tell if there is any
356 output from the process is to read at least one char.
357 Always -1 on systems that support FIONREAD. */
359 /* Don't make static; need to access externally. */
360 int proc_buffered_char
[MAXDESC
];
362 /* Table of `struct coding-system' for each process. */
363 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
364 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
366 #ifdef DATAGRAM_SOCKETS
367 /* Table of `partner address' for datagram sockets. */
368 struct sockaddr_and_len
{
371 } datagram_address
[MAXDESC
];
372 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
373 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
375 #define DATAGRAM_CHAN_P(chan) (0)
376 #define DATAGRAM_CONN_P(proc) (0)
379 /* Maximum number of bytes to send to a pty without an eof. */
380 static int pty_max_bytes
;
382 /* Nonzero means don't run process sentinels. This is used
384 int inhibit_sentinels
;
390 /* The file name of the pty opened by allocate_pty. */
392 static char pty_name
[24];
395 /* Compute the Lisp form of the process status, p->status, from
396 the numeric status that was returned by `wait'. */
398 static Lisp_Object
status_convert ();
402 struct Lisp_Process
*p
;
404 union { int i
; WAITTYPE wt
; } u
;
405 eassert (p
->raw_status_new
);
407 p
->status
= status_convert (u
.wt
);
408 p
->raw_status_new
= 0;
411 /* Convert a process status word in Unix format to
412 the list that we use internally. */
419 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
420 else if (WIFEXITED (w
))
421 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
422 WCOREDUMP (w
) ? Qt
: Qnil
));
423 else if (WIFSIGNALED (w
))
424 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
425 WCOREDUMP (w
) ? Qt
: Qnil
));
430 /* Given a status-list, extract the three pieces of information
431 and store them individually through the three pointers. */
434 decode_status (l
, symbol
, code
, coredump
)
452 *code
= XFASTINT (XCAR (tem
));
454 *coredump
= !NILP (tem
);
458 /* Return a string describing a process status list. */
462 struct Lisp_Process
*p
;
464 Lisp_Object status
= p
->status
;
467 Lisp_Object string
, string2
;
469 decode_status (status
, &symbol
, &code
, &coredump
);
471 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
474 synchronize_system_messages_locale ();
475 signame
= strsignal (code
);
478 string
= build_string (signame
);
479 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
480 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
481 return concat2 (string
, string2
);
483 else if (EQ (symbol
, Qexit
))
486 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
488 return build_string ("finished\n");
489 string
= Fnumber_to_string (make_number (code
));
490 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
491 return concat3 (build_string ("exited abnormally with code "),
494 else if (EQ (symbol
, Qfailed
))
496 string
= Fnumber_to_string (make_number (code
));
497 string2
= build_string ("\n");
498 return concat3 (build_string ("failed with code "),
502 return Fcopy_sequence (Fsymbol_name (symbol
));
507 /* Open an available pty, returning a file descriptor.
508 Return -1 on failure.
509 The file name of the terminal corresponding to the pty
510 is left in the variable pty_name. */
521 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
522 for (i
= 0; i
< 16; i
++)
525 struct stat stb
; /* Used in some PTY_OPEN. */
526 #ifdef PTY_NAME_SPRINTF
529 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
530 #endif /* no PTY_NAME_SPRINTF */
534 #else /* no PTY_OPEN */
537 /* Unusual IRIS code */
538 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
541 if (fstat (fd
, &stb
) < 0)
543 # else /* not IRIS */
544 { /* Some systems name their pseudoterminals so that there are gaps in
545 the usual sequence - for example, on HP9000/S700 systems, there
546 are no pseudoterminals with names ending in 'f'. So we wait for
547 three failures in a row before deciding that we've reached the
549 int failed_count
= 0;
551 if (stat (pty_name
, &stb
) < 0)
554 if (failed_count
>= 3)
561 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
563 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
565 # endif /* not IRIS */
567 #endif /* no PTY_OPEN */
571 /* check to make certain that both sides are available
572 this avoids a nasty yet stupid bug in rlogins */
573 #ifdef PTY_TTY_NAME_SPRINTF
576 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
577 #endif /* no PTY_TTY_NAME_SPRINTF */
578 if (access (pty_name
, 6) != 0)
581 # if !defined(IRIS) && !defined(__sgi)
593 #endif /* HAVE_PTYS */
599 register Lisp_Object val
, tem
, name1
;
600 register struct Lisp_Process
*p
;
604 p
= allocate_process ();
612 p
->raw_status_new
= 0;
614 p
->mark
= Fmake_marker ();
616 #ifdef ADAPTIVE_READ_BUFFERING
617 p
->adaptive_read_buffering
= 0;
618 p
->read_output_delay
= 0;
619 p
->read_output_skip
= 0;
622 /* If name is already in use, modify it until it is unused. */
627 tem
= Fget_process (name1
);
628 if (NILP (tem
)) break;
629 sprintf (suffix
, "<%d>", i
);
630 name1
= concat2 (name
, build_string (suffix
));
634 XSETPROCESS (val
, p
);
635 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
640 remove_process (proc
)
641 register Lisp_Object proc
;
643 register Lisp_Object pair
;
645 pair
= Frassq (proc
, Vprocess_alist
);
646 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
648 deactivate_process (proc
);
651 /* Setup coding systems of PROCESS. */
654 setup_process_coding_systems (process
)
657 struct Lisp_Process
*p
= XPROCESS (process
);
659 int outch
= p
->outfd
;
660 Lisp_Object coding_system
;
662 if (inch
< 0 || outch
< 0)
665 if (!proc_decode_coding_system
[inch
])
666 proc_decode_coding_system
[inch
]
667 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
668 coding_system
= p
->decode_coding_system
;
669 if (! NILP (p
->filter
))
671 else if (BUFFERP (p
->buffer
))
673 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
674 coding_system
= raw_text_coding_system (coding_system
);
676 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
678 if (!proc_encode_coding_system
[outch
])
679 proc_encode_coding_system
[outch
]
680 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
681 setup_coding_system (p
->encode_coding_system
,
682 proc_encode_coding_system
[outch
]);
685 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
686 doc
: /* Return t if OBJECT is a process. */)
690 return PROCESSP (object
) ? Qt
: Qnil
;
693 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
694 doc
: /* Return the process named NAME, or nil if there is none. */)
696 register Lisp_Object name
;
701 return Fcdr (Fassoc (name
, Vprocess_alist
));
704 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
705 doc
: /* Return the (or a) process associated with BUFFER.
706 BUFFER may be a buffer or the name of one. */)
708 register Lisp_Object buffer
;
710 register Lisp_Object buf
, tail
, proc
;
712 if (NILP (buffer
)) return Qnil
;
713 buf
= Fget_buffer (buffer
);
714 if (NILP (buf
)) return Qnil
;
716 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
718 proc
= Fcdr (XCAR (tail
));
719 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
725 /* This is how commands for the user decode process arguments. It
726 accepts a process, a process name, a buffer, a buffer name, or nil.
727 Buffers denote the first process in the buffer, and nil denotes the
732 register Lisp_Object name
;
734 register Lisp_Object proc
, obj
;
737 obj
= Fget_process (name
);
739 obj
= Fget_buffer (name
);
741 error ("Process %s does not exist", SDATA (name
));
743 else if (NILP (name
))
744 obj
= Fcurrent_buffer ();
748 /* Now obj should be either a buffer object or a process object.
752 proc
= Fget_buffer_process (obj
);
754 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
766 /* Fdelete_process promises to immediately forget about the process, but in
767 reality, Emacs needs to remember those processes until they have been
768 treated by sigchld_handler; otherwise this handler would consider the
769 process as being synchronous and say that the synchronous process is
771 static Lisp_Object deleted_pid_list
;
774 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
775 doc
: /* Delete PROCESS: kill it and forget about it immediately.
776 PROCESS may be a process, a buffer, the name of a process or buffer, or
777 nil, indicating the current buffer's process. */)
779 register Lisp_Object process
;
781 register struct Lisp_Process
*p
;
783 process
= get_process (process
);
784 p
= XPROCESS (process
);
786 p
->raw_status_new
= 0;
789 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
790 p
->tick
= ++process_tick
;
793 else if (p
->infd
>= 0)
797 /* Assignment to EMACS_INT stops GCC whining about limited range
799 EMACS_INT pid
= p
->pid
;
801 /* No problem storing the pid here, as it is still in Vprocess_alist. */
802 deleted_pid_list
= Fcons (make_fixnum_or_float (pid
),
803 /* GC treated elements set to nil. */
804 Fdelq (Qnil
, deleted_pid_list
));
805 /* If the process has already signaled, remove it from the list. */
806 if (p
->raw_status_new
)
809 if (CONSP (p
->status
))
810 symbol
= XCAR (p
->status
);
811 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
813 = Fdelete (make_fixnum_or_float (pid
), deleted_pid_list
);
817 Fkill_process (process
, Qnil
);
818 /* Do this now, since remove_process will make sigchld_handler do nothing. */
820 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
821 p
->tick
= ++process_tick
;
825 remove_process (process
);
829 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
830 doc
: /* Return the status of PROCESS.
831 The returned value is one of the following symbols:
832 run -- for a process that is running.
833 stop -- for a process stopped but continuable.
834 exit -- for a process that has exited.
835 signal -- for a process that has got a fatal signal.
836 open -- for a network stream connection that is open.
837 listen -- for a network stream server that is listening.
838 closed -- for a network stream connection that is closed.
839 connect -- when waiting for a non-blocking connection to complete.
840 failed -- when a non-blocking connection has failed.
841 nil -- if arg is a process name and no such process exists.
842 PROCESS may be a process, a buffer, the name of a process, or
843 nil, indicating the current buffer's process. */)
845 register Lisp_Object process
;
847 register struct Lisp_Process
*p
;
848 register Lisp_Object status
;
850 if (STRINGP (process
))
851 process
= Fget_process (process
);
853 process
= get_process (process
);
858 p
= XPROCESS (process
);
859 if (p
->raw_status_new
)
863 status
= XCAR (status
);
866 if (EQ (status
, Qexit
))
868 else if (EQ (p
->command
, Qt
))
870 else if (EQ (status
, Qrun
))
876 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
878 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
879 If PROCESS has not yet exited or died, return 0. */)
881 register Lisp_Object process
;
883 CHECK_PROCESS (process
);
884 if (XPROCESS (process
)->raw_status_new
)
885 update_status (XPROCESS (process
));
886 if (CONSP (XPROCESS (process
)->status
))
887 return XCAR (XCDR (XPROCESS (process
)->status
));
888 return make_number (0);
891 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
892 doc
: /* Return the process id of PROCESS.
893 This is the pid of the external process which PROCESS uses or talks to.
894 For a network connection, this value is nil. */)
896 register Lisp_Object process
;
898 /* Assignment to EMACS_INT stops GCC whining about limited range of
902 CHECK_PROCESS (process
);
903 pid
= XPROCESS (process
)->pid
;
904 return (pid
? make_fixnum_or_float (pid
) : Qnil
);
907 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
908 doc
: /* Return the name of PROCESS, as a string.
909 This is the name of the program invoked in PROCESS,
910 possibly modified to make it unique among process names. */)
912 register Lisp_Object process
;
914 CHECK_PROCESS (process
);
915 return XPROCESS (process
)->name
;
918 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
919 doc
: /* Return the command that was executed to start PROCESS.
920 This is a list of strings, the first string being the program executed
921 and the rest of the strings being the arguments given to it.
922 For a non-child channel, this is nil. */)
924 register Lisp_Object process
;
926 CHECK_PROCESS (process
);
927 return XPROCESS (process
)->command
;
930 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
931 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
932 This is the terminal that the process itself reads and writes on,
933 not the name of the pty that Emacs uses to talk with that terminal. */)
935 register Lisp_Object process
;
937 CHECK_PROCESS (process
);
938 return XPROCESS (process
)->tty_name
;
941 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
943 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
945 register Lisp_Object process
, buffer
;
947 struct Lisp_Process
*p
;
949 CHECK_PROCESS (process
);
951 CHECK_BUFFER (buffer
);
952 p
= XPROCESS (process
);
955 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
956 setup_process_coding_systems (process
);
960 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
962 doc
: /* Return the buffer PROCESS is associated with.
963 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
965 register Lisp_Object process
;
967 CHECK_PROCESS (process
);
968 return XPROCESS (process
)->buffer
;
971 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
973 doc
: /* Return the marker for the end of the last output from PROCESS. */)
975 register Lisp_Object process
;
977 CHECK_PROCESS (process
);
978 return XPROCESS (process
)->mark
;
981 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
983 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
984 A value of t means stop accepting output from the process.
986 When a process has a filter, its buffer is not used for output.
987 Instead, each time it does output, the entire string of output is
988 passed to the filter.
990 The filter gets two arguments: the process and the string of output.
991 The string argument is normally a multibyte string, except:
992 - if the process' input coding system is no-conversion or raw-text,
993 it is a unibyte string (the non-converted input), or else
994 - if `default-enable-multibyte-characters' is nil, it is a unibyte
995 string (the result of converting the decoded input multibyte
996 string to unibyte with `string-make-unibyte'). */)
998 register Lisp_Object process
, filter
;
1000 struct Lisp_Process
*p
;
1002 CHECK_PROCESS (process
);
1003 p
= XPROCESS (process
);
1005 /* Don't signal an error if the process' input file descriptor
1006 is closed. This could make debugging Lisp more difficult,
1007 for example when doing something like
1009 (setq process (start-process ...))
1011 (set-process-filter process ...) */
1015 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
1017 FD_CLR (p
->infd
, &input_wait_mask
);
1018 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
1020 else if (EQ (p
->filter
, Qt
)
1021 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
1023 FD_SET (p
->infd
, &input_wait_mask
);
1024 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
1030 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
1031 setup_process_coding_systems (process
);
1035 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1037 doc
: /* Returns the filter function of PROCESS; nil if none.
1038 See `set-process-filter' for more info on filter functions. */)
1040 register Lisp_Object process
;
1042 CHECK_PROCESS (process
);
1043 return XPROCESS (process
)->filter
;
1046 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1048 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1049 The sentinel is called as a function when the process changes state.
1050 It gets two arguments: the process, and a string describing the change. */)
1052 register Lisp_Object process
, sentinel
;
1054 struct Lisp_Process
*p
;
1056 CHECK_PROCESS (process
);
1057 p
= XPROCESS (process
);
1059 p
->sentinel
= sentinel
;
1061 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1065 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1067 doc
: /* Return the sentinel of PROCESS; nil if none.
1068 See `set-process-sentinel' for more info on sentinels. */)
1070 register Lisp_Object process
;
1072 CHECK_PROCESS (process
);
1073 return XPROCESS (process
)->sentinel
;
1076 DEFUN ("set-process-window-size", Fset_process_window_size
,
1077 Sset_process_window_size
, 3, 3, 0,
1078 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1079 (process
, height
, width
)
1080 register Lisp_Object process
, height
, width
;
1082 CHECK_PROCESS (process
);
1083 CHECK_NATNUM (height
);
1084 CHECK_NATNUM (width
);
1086 if (XPROCESS (process
)->infd
< 0
1087 || set_window_size (XPROCESS (process
)->infd
,
1088 XINT (height
), XINT (width
)) <= 0)
1094 DEFUN ("set-process-inherit-coding-system-flag",
1095 Fset_process_inherit_coding_system_flag
,
1096 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1097 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1098 If the second argument FLAG is non-nil, then the variable
1099 `buffer-file-coding-system' of the buffer associated with PROCESS
1100 will be bound to the value of the coding system used to decode
1103 This is useful when the coding system specified for the process buffer
1104 leaves either the character code conversion or the end-of-line conversion
1105 unspecified, or if the coding system used to decode the process output
1106 is more appropriate for saving the process buffer.
1108 Binding the variable `inherit-process-coding-system' to non-nil before
1109 starting the process is an alternative way of setting the inherit flag
1110 for the process which will run. */)
1112 register Lisp_Object process
, flag
;
1114 CHECK_PROCESS (process
);
1115 XPROCESS (process
)->inherit_coding_system_flag
= !NILP (flag
);
1119 DEFUN ("process-inherit-coding-system-flag",
1120 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1122 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1123 If this flag is t, `buffer-file-coding-system' of the buffer
1124 associated with PROCESS will inherit the coding system used to decode
1125 the process output. */)
1127 register Lisp_Object process
;
1129 CHECK_PROCESS (process
);
1130 return XPROCESS (process
)->inherit_coding_system_flag
? Qt
: Qnil
;
1133 DEFUN ("set-process-query-on-exit-flag",
1134 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1136 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1137 If the second argument FLAG is non-nil, Emacs will query the user before
1138 exiting if PROCESS is running. */)
1140 register Lisp_Object process
, flag
;
1142 CHECK_PROCESS (process
);
1143 XPROCESS (process
)->kill_without_query
= NILP (flag
);
1147 DEFUN ("process-query-on-exit-flag",
1148 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1150 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1152 register Lisp_Object process
;
1154 CHECK_PROCESS (process
);
1155 return (XPROCESS (process
)->kill_without_query
? Qnil
: Qt
);
1158 #ifdef DATAGRAM_SOCKETS
1159 Lisp_Object
Fprocess_datagram_address ();
1162 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1164 doc
: /* Return the contact info of PROCESS; t for a real child.
1165 For a net connection, the value depends on the optional KEY arg.
1166 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1167 if KEY is t, the complete contact information for the connection is
1168 returned, else the specific value for the keyword KEY is returned.
1169 See `make-network-process' for a list of keywords. */)
1171 register Lisp_Object process
, key
;
1173 Lisp_Object contact
;
1175 CHECK_PROCESS (process
);
1176 contact
= XPROCESS (process
)->childp
;
1178 #ifdef DATAGRAM_SOCKETS
1179 if (DATAGRAM_CONN_P (process
)
1180 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1181 contact
= Fplist_put (contact
, QCremote
,
1182 Fprocess_datagram_address (process
));
1185 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1188 return Fcons (Fplist_get (contact
, QChost
),
1189 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1190 return Fplist_get (contact
, key
);
1193 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1195 doc
: /* Return the plist of PROCESS. */)
1197 register Lisp_Object process
;
1199 CHECK_PROCESS (process
);
1200 return XPROCESS (process
)->plist
;
1203 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1205 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1207 register Lisp_Object process
, plist
;
1209 CHECK_PROCESS (process
);
1212 XPROCESS (process
)->plist
= plist
;
1216 #if 0 /* Turned off because we don't currently record this info
1217 in the process. Perhaps add it. */
1218 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1219 doc
: /* Return the connection type of PROCESS.
1220 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1221 a socket connection. */)
1223 Lisp_Object process
;
1225 return XPROCESS (process
)->type
;
1230 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1232 doc
: /* Convert network ADDRESS from internal format to a string.
1233 A 4 or 5 element vector represents an IPv4 address (with port number).
1234 An 8 or 9 element vector represents an IPv6 address (with port number).
1235 If optional second argument OMIT-PORT is non-nil, don't include a port
1236 number in the string, even when present in ADDRESS.
1237 Returns nil if format of ADDRESS is invalid. */)
1238 (address
, omit_port
)
1239 Lisp_Object address
, omit_port
;
1244 if (STRINGP (address
)) /* AF_LOCAL */
1247 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1249 register struct Lisp_Vector
*p
= XVECTOR (address
);
1250 Lisp_Object args
[10];
1253 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1255 args
[0] = build_string ("%d.%d.%d.%d");
1258 else if (p
->size
== 5)
1260 args
[0] = build_string ("%d.%d.%d.%d:%d");
1263 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1265 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1268 else if (p
->size
== 9)
1270 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1276 for (i
= 0; i
< nargs
; i
++)
1278 EMACS_INT element
= XINT (p
->contents
[i
]);
1280 if (element
< 0 || element
> 65535)
1283 if (nargs
<= 5 /* IPv4 */
1284 && i
< 4 /* host, not port */
1288 args
[i
+1] = p
->contents
[i
];
1291 return Fformat (nargs
+1, args
);
1294 if (CONSP (address
))
1296 Lisp_Object args
[2];
1297 args
[0] = build_string ("<Family %d>");
1298 args
[1] = Fcar (address
);
1299 return Fformat (2, args
);
1307 list_processes_1 (query_only
)
1308 Lisp_Object query_only
;
1310 register Lisp_Object tail
, tem
;
1311 Lisp_Object proc
, minspace
, tem1
;
1312 register struct Lisp_Process
*p
;
1314 int w_proc
, w_buffer
, w_tty
;
1316 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1318 w_proc
= 4; /* Proc */
1319 w_buffer
= 6; /* Buffer */
1320 w_tty
= 0; /* Omit if no ttys */
1322 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
1326 proc
= Fcdr (XCAR (tail
));
1327 p
= XPROCESS (proc
);
1328 if (NILP (p
->childp
))
1330 if (!NILP (query_only
) && p
->kill_without_query
)
1332 if (STRINGP (p
->name
)
1333 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1335 if (!NILP (p
->buffer
))
1337 if (NILP (XBUFFER (p
->buffer
)->name
))
1340 w_buffer
= 8; /* (Killed) */
1342 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1345 if (STRINGP (p
->tty_name
)
1346 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1350 XSETFASTINT (i_status
, w_proc
+ 1);
1351 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1354 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1355 XSETFASTINT (i_command
, XFASTINT (i_tty
) + w_tty
+ 1);
1360 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1363 XSETFASTINT (minspace
, 1);
1365 set_buffer_internal (XBUFFER (Vstandard_output
));
1366 current_buffer
->undo_list
= Qt
;
1368 current_buffer
->truncate_lines
= Qt
;
1370 write_string ("Proc", -1);
1371 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1372 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1375 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1377 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1378 write_string ("\n", -1);
1380 write_string ("----", -1);
1381 Findent_to (i_status
, minspace
); write_string ("------", -1);
1382 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1385 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1387 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1388 write_string ("\n", -1);
1390 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
1394 proc
= Fcdr (XCAR (tail
));
1395 p
= XPROCESS (proc
);
1396 if (NILP (p
->childp
))
1398 if (!NILP (query_only
) && p
->kill_without_query
)
1401 Finsert (1, &p
->name
);
1402 Findent_to (i_status
, minspace
);
1404 if (p
->raw_status_new
)
1407 if (CONSP (p
->status
))
1408 symbol
= XCAR (p
->status
);
1410 if (EQ (symbol
, Qsignal
))
1413 tem
= Fcar (Fcdr (p
->status
));
1415 if (XINT (tem
) < NSIG
)
1416 write_string (sys_errlist
[XINT (tem
)], -1);
1419 Fprinc (symbol
, Qnil
);
1421 else if (NETCONN1_P (p
))
1423 if (EQ (symbol
, Qexit
))
1424 write_string ("closed", -1);
1425 else if (EQ (p
->command
, Qt
))
1426 write_string ("stopped", -1);
1427 else if (EQ (symbol
, Qrun
))
1428 write_string ("open", -1);
1430 Fprinc (symbol
, Qnil
);
1433 Fprinc (symbol
, Qnil
);
1435 if (EQ (symbol
, Qexit
))
1438 tem
= Fcar (Fcdr (p
->status
));
1441 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1442 write_string (tembuf
, -1);
1446 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
) || EQ (symbol
, Qclosed
))
1449 Findent_to (i_buffer
, minspace
);
1450 if (NILP (p
->buffer
))
1451 insert_string ("(none)");
1452 else if (NILP (XBUFFER (p
->buffer
)->name
))
1453 insert_string ("(Killed)");
1455 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1459 Findent_to (i_tty
, minspace
);
1460 if (STRINGP (p
->tty_name
))
1461 Finsert (1, &p
->tty_name
);
1464 Findent_to (i_command
, minspace
);
1466 if (EQ (p
->status
, Qlisten
))
1468 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1469 if (INTEGERP (port
))
1470 port
= Fnumber_to_string (port
);
1472 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1473 sprintf (tembuf
, "(network %s server on %s)\n",
1474 (DATAGRAM_CHAN_P (p
->infd
) ? "datagram" : "stream"),
1475 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1476 insert_string (tembuf
);
1478 else if (NETCONN1_P (p
))
1480 /* For a local socket, there is no host name,
1481 so display service instead. */
1482 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1483 if (!STRINGP (host
))
1485 host
= Fplist_get (p
->childp
, QCservice
);
1486 if (INTEGERP (host
))
1487 host
= Fnumber_to_string (host
);
1490 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1491 sprintf (tembuf
, "(network %s connection to %s)\n",
1492 (DATAGRAM_CHAN_P (p
->infd
) ? "datagram" : "stream"),
1493 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1494 insert_string (tembuf
);
1506 insert_string (" ");
1508 insert_string ("\n");
1512 status_notify (NULL
);
1516 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1517 doc
: /* Display a list of all processes.
1518 If optional argument QUERY-ONLY is non-nil, only processes with
1519 the query-on-exit flag set will be listed.
1520 Any process listed as exited or signaled is actually eliminated
1521 after the listing is made. */)
1523 Lisp_Object query_only
;
1525 internal_with_output_to_temp_buffer ("*Process List*",
1526 list_processes_1
, query_only
);
1530 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1531 doc
: /* Return a list of all processes. */)
1534 return Fmapcar (Qcdr
, Vprocess_alist
);
1537 /* Starting asynchronous inferior processes. */
1539 static Lisp_Object
start_process_unwind ();
1541 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1542 doc
: /* Start a program in a subprocess. Return the process object for it.
1543 NAME is name for process. It is modified if necessary to make it unique.
1544 BUFFER is the buffer (or buffer name) to associate with the process.
1546 Process output (both standard output and standard error streams) goes
1547 at end of BUFFER, unless you specify an output stream or filter
1548 function to handle the output. BUFFER may also be nil, meaning that
1549 this process is not associated with any buffer.
1551 PROGRAM is the program file name. It is searched for in PATH.
1552 Remaining arguments are strings to give program as arguments.
1554 If you want to separate standard output from standard error, invoke
1555 the command through a shell and redirect one of them using the shell
1558 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1561 register Lisp_Object
*args
;
1563 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1565 register unsigned char *new_argv
;
1568 register unsigned char **new_argv
;
1571 int count
= SPECPDL_INDEX ();
1575 buffer
= Fget_buffer_create (buffer
);
1577 /* Make sure that the child will be able to chdir to the current
1578 buffer's current directory, or its unhandled equivalent. We
1579 can't just have the child check for an error when it does the
1580 chdir, since it's in a vfork.
1582 We have to GCPRO around this because Fexpand_file_name and
1583 Funhandled_file_name_directory might call a file name handling
1584 function. The argument list is protected by the caller, so all
1585 we really have to worry about is buffer. */
1587 struct gcpro gcpro1
, gcpro2
;
1589 current_dir
= current_buffer
->directory
;
1591 GCPRO2 (buffer
, current_dir
);
1593 current_dir
= Funhandled_file_name_directory (current_dir
);
1594 if (NILP (current_dir
))
1595 /* If the file name handler says that current_dir is unreachable, use
1596 a sensible default. */
1597 current_dir
= build_string ("~/");
1598 current_dir
= expand_and_dir_to_file (current_dir
, Qnil
);
1599 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1600 report_file_error ("Setting current directory",
1601 Fcons (current_buffer
->directory
, Qnil
));
1607 CHECK_STRING (name
);
1611 CHECK_STRING (program
);
1613 proc
= make_process (name
);
1614 /* If an error occurs and we can't start the process, we want to
1615 remove it from the process list. This means that each error
1616 check in create_process doesn't need to call remove_process
1617 itself; it's all taken care of here. */
1618 record_unwind_protect (start_process_unwind
, proc
);
1620 XPROCESS (proc
)->childp
= Qt
;
1621 XPROCESS (proc
)->plist
= Qnil
;
1622 XPROCESS (proc
)->buffer
= buffer
;
1623 XPROCESS (proc
)->sentinel
= Qnil
;
1624 XPROCESS (proc
)->filter
= Qnil
;
1625 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1627 #ifdef ADAPTIVE_READ_BUFFERING
1628 XPROCESS (proc
)->adaptive_read_buffering
1629 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
1630 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
1633 /* Make the process marker point into the process buffer (if any). */
1634 if (BUFFERP (buffer
))
1635 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1636 BUF_ZV (XBUFFER (buffer
)),
1637 BUF_ZV_BYTE (XBUFFER (buffer
)));
1640 /* Decide coding systems for communicating with the process. Here
1641 we don't setup the structure coding_system nor pay attention to
1642 unibyte mode. They are done in create_process. */
1644 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1645 Lisp_Object coding_systems
= Qt
;
1646 Lisp_Object val
, *args2
;
1647 struct gcpro gcpro1
, gcpro2
;
1649 val
= Vcoding_system_for_read
;
1652 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1653 args2
[0] = Qstart_process
;
1654 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1655 GCPRO2 (proc
, current_dir
);
1656 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1658 if (CONSP (coding_systems
))
1659 val
= XCAR (coding_systems
);
1660 else if (CONSP (Vdefault_process_coding_system
))
1661 val
= XCAR (Vdefault_process_coding_system
);
1663 XPROCESS (proc
)->decode_coding_system
= val
;
1665 val
= Vcoding_system_for_write
;
1668 if (EQ (coding_systems
, Qt
))
1670 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1671 args2
[0] = Qstart_process
;
1672 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1673 GCPRO2 (proc
, current_dir
);
1674 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1677 if (CONSP (coding_systems
))
1678 val
= XCDR (coding_systems
);
1679 else if (CONSP (Vdefault_process_coding_system
))
1680 val
= XCDR (Vdefault_process_coding_system
);
1682 XPROCESS (proc
)->encode_coding_system
= val
;
1686 /* Make a one member argv with all args concatenated
1687 together separated by a blank. */
1688 len
= SBYTES (program
) + 2;
1689 for (i
= 3; i
< nargs
; i
++)
1693 len
+= SBYTES (tem
) + 1; /* count the blank */
1695 new_argv
= (unsigned char *) alloca (len
);
1696 strcpy (new_argv
, SDATA (program
));
1697 for (i
= 3; i
< nargs
; i
++)
1701 strcat (new_argv
, " ");
1702 strcat (new_argv
, SDATA (tem
));
1704 /* Need to add code here to check for program existence on VMS */
1707 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1709 /* If program file name is not absolute, search our path for it.
1710 Put the name we will really use in TEM. */
1711 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1712 && !(SCHARS (program
) > 1
1713 && IS_DEVICE_SEP (SREF (program
, 1))))
1715 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1718 GCPRO4 (name
, program
, buffer
, current_dir
);
1719 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1722 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1723 tem
= Fexpand_file_name (tem
, Qnil
);
1727 if (!NILP (Ffile_directory_p (program
)))
1728 error ("Specified program for new process is a directory");
1732 /* If program file name starts with /: for quoting a magic name,
1734 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1735 && SREF (tem
, 1) == ':')
1736 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1738 /* Encode the file name and put it in NEW_ARGV.
1739 That's where the child will use it to execute the program. */
1740 tem
= ENCODE_FILE (tem
);
1741 new_argv
[0] = SDATA (tem
);
1743 /* Here we encode arguments by the coding system used for sending
1744 data to the process. We don't support using different coding
1745 systems for encoding arguments and for encoding data sent to the
1748 for (i
= 3; i
< nargs
; i
++)
1752 if (STRING_MULTIBYTE (tem
))
1753 tem
= (code_convert_string_norecord
1754 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1755 new_argv
[i
- 2] = SDATA (tem
);
1757 new_argv
[i
- 2] = 0;
1758 #endif /* not VMS */
1760 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1761 XPROCESS (proc
)->decoding_carryover
= 0;
1762 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1764 XPROCESS (proc
)->inherit_coding_system_flag
1765 = !(NILP (buffer
) || !inherit_process_coding_system
);
1767 create_process (proc
, (char **) new_argv
, current_dir
);
1769 return unbind_to (count
, proc
);
1772 /* This function is the unwind_protect form for Fstart_process. If
1773 PROC doesn't have its pid set, then we know someone has signaled
1774 an error and the process wasn't started successfully, so we should
1775 remove it from the process list. */
1777 start_process_unwind (proc
)
1780 if (!PROCESSP (proc
))
1783 /* Was PROC started successfully? */
1784 if (XPROCESS (proc
)->pid
<= 0)
1785 remove_process (proc
);
1791 create_process_1 (timer
)
1792 struct atimer
*timer
;
1794 /* Nothing to do. */
1798 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1801 /* Mimic blocking of signals on system V, which doesn't really have it. */
1803 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1804 int sigchld_deferred
;
1807 create_process_sigchld ()
1809 signal (SIGCHLD
, create_process_sigchld
);
1811 sigchld_deferred
= 1;
1817 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1819 create_process (process
, new_argv
, current_dir
)
1820 Lisp_Object process
;
1822 Lisp_Object current_dir
;
1824 int inchannel
, outchannel
;
1827 #ifdef POSIX_SIGNALS
1830 struct sigaction sigint_action
;
1831 struct sigaction sigquit_action
;
1833 struct sigaction sighup_action
;
1835 #else /* !POSIX_SIGNALS */
1838 SIGTYPE (*sigchld
)();
1841 #endif /* !POSIX_SIGNALS */
1842 /* Use volatile to protect variables from being clobbered by longjmp. */
1843 volatile int forkin
, forkout
;
1844 volatile int pty_flag
= 0;
1846 extern char **environ
;
1849 inchannel
= outchannel
= -1;
1852 if (!NILP (Vprocess_connection_type
))
1853 outchannel
= inchannel
= allocate_pty ();
1857 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1858 /* On most USG systems it does not work to open the pty's tty here,
1859 then close it and reopen it in the child. */
1861 /* Don't let this terminal become our controlling terminal
1862 (in case we don't have one). */
1863 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1865 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1868 report_file_error ("Opening pty", Qnil
);
1869 #if defined (DONT_REOPEN_PTY)
1870 /* In the case that vfork is defined as fork, the parent process
1871 (Emacs) may send some data before the child process completes
1872 tty options setup. So we setup tty before forking. */
1873 child_setup_tty (forkout
);
1874 #endif /* DONT_REOPEN_PTY */
1876 forkin
= forkout
= -1;
1877 #endif /* not USG, or USG_SUBTTY_WORKS */
1881 #endif /* HAVE_PTYS */
1886 report_file_error ("Creating pipe", Qnil
);
1892 emacs_close (inchannel
);
1893 emacs_close (forkout
);
1894 report_file_error ("Creating pipe", Qnil
);
1901 /* Replaced by close_process_descs */
1902 set_exclusive_use (inchannel
);
1903 set_exclusive_use (outchannel
);
1907 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1908 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1911 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1912 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1916 /* Record this as an active process, with its channels.
1917 As a result, child_setup will close Emacs's side of the pipes. */
1918 chan_process
[inchannel
] = process
;
1919 XPROCESS (process
)->infd
= inchannel
;
1920 XPROCESS (process
)->outfd
= outchannel
;
1922 /* Previously we recorded the tty descriptor used in the subprocess.
1923 It was only used for getting the foreground tty process, so now
1924 we just reopen the device (see emacs_get_tty_pgrp) as this is
1925 more portable (see USG_SUBTTY_WORKS above). */
1927 XPROCESS (process
)->pty_flag
= pty_flag
;
1928 XPROCESS (process
)->status
= Qrun
;
1929 setup_process_coding_systems (process
);
1931 /* Delay interrupts until we have a chance to store
1932 the new fork's pid in its process structure */
1933 #ifdef POSIX_SIGNALS
1934 sigemptyset (&blocked
);
1936 sigaddset (&blocked
, SIGCHLD
);
1938 #ifdef HAVE_WORKING_VFORK
1939 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1940 this sets the parent's signal handlers as well as the child's.
1941 So delay all interrupts whose handlers the child might munge,
1942 and record the current handlers so they can be restored later. */
1943 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1944 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1946 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1948 #endif /* HAVE_WORKING_VFORK */
1949 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1950 #else /* !POSIX_SIGNALS */
1954 #else /* not BSD4_1 */
1955 #if defined (BSD_SYSTEM) || defined (HPUX)
1956 sigsetmask (sigmask (SIGCHLD
));
1957 #else /* ordinary USG */
1959 sigchld_deferred
= 0;
1960 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1962 #endif /* ordinary USG */
1963 #endif /* not BSD4_1 */
1964 #endif /* SIGCHLD */
1965 #endif /* !POSIX_SIGNALS */
1967 FD_SET (inchannel
, &input_wait_mask
);
1968 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1969 if (inchannel
> max_process_desc
)
1970 max_process_desc
= inchannel
;
1972 /* Until we store the proper pid, enable sigchld_handler
1973 to recognize an unknown pid as standing for this process.
1974 It is very important not to let this `marker' value stay
1975 in the table after this function has returned; if it does
1976 it might cause call-process to hang and subsequent asynchronous
1977 processes to get their return values scrambled. */
1978 XPROCESS (process
)->pid
= -1;
1983 /* child_setup must clobber environ on systems with true vfork.
1984 Protect it from permanent change. */
1985 char **save_environ
= environ
;
1987 current_dir
= ENCODE_FILE (current_dir
);
1992 #endif /* not WINDOWSNT */
1994 int xforkin
= forkin
;
1995 int xforkout
= forkout
;
1997 #if 0 /* This was probably a mistake--it duplicates code later on,
1998 but fails to handle all the cases. */
1999 /* Make sure SIGCHLD is not blocked in the child. */
2000 sigsetmask (SIGEMPTYMASK
);
2003 /* Make the pty be the controlling terminal of the process. */
2005 /* First, disconnect its current controlling terminal. */
2007 /* We tried doing setsid only if pty_flag, but it caused
2008 process_set_signal to fail on SGI when using a pipe. */
2010 /* Make the pty's terminal the controlling terminal. */
2014 /* We ignore the return value
2015 because faith@cs.unc.edu says that is necessary on Linux. */
2016 ioctl (xforkin
, TIOCSCTTY
, 0);
2019 #else /* not HAVE_SETSID */
2021 /* It's very important to call setpgrp here and no time
2022 afterwards. Otherwise, we lose our controlling tty which
2023 is set when we open the pty. */
2026 #endif /* not HAVE_SETSID */
2027 #if defined (HAVE_TERMIOS) && defined (LDISC1)
2028 if (pty_flag
&& xforkin
>= 0)
2031 tcgetattr (xforkin
, &t
);
2033 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
2034 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
2037 #if defined (NTTYDISC) && defined (TIOCSETD)
2038 if (pty_flag
&& xforkin
>= 0)
2040 /* Use new line discipline. */
2041 int ldisc
= NTTYDISC
;
2042 ioctl (xforkin
, TIOCSETD
, &ldisc
);
2047 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2048 can do TIOCSPGRP only to the process's controlling tty. */
2051 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2052 I can't test it since I don't have 4.3. */
2053 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
2054 ioctl (j
, TIOCNOTTY
, 0);
2057 /* In order to get a controlling terminal on some versions
2058 of BSD, it is necessary to put the process in pgrp 0
2059 before it opens the terminal. */
2067 #endif /* TIOCNOTTY */
2069 #if !defined (DONT_REOPEN_PTY)
2070 /*** There is a suggestion that this ought to be a
2071 conditional on TIOCSPGRP,
2072 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2073 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2074 that system does seem to need this code, even though
2075 both HAVE_SETSID and TIOCSCTTY are defined. */
2076 /* Now close the pty (if we had it open) and reopen it.
2077 This makes the pty the controlling terminal of the subprocess. */
2080 #ifdef SET_CHILD_PTY_PGRP
2081 int pgrp
= getpid ();
2084 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2087 emacs_close (xforkin
);
2088 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2092 emacs_write (1, "Couldn't open the pty terminal ", 31);
2093 emacs_write (1, pty_name
, strlen (pty_name
));
2094 emacs_write (1, "\n", 1);
2098 #ifdef SET_CHILD_PTY_PGRP
2099 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
2100 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
2103 #endif /* not DONT_REOPEN_PTY */
2105 #ifdef SETUP_SLAVE_PTY
2110 #endif /* SETUP_SLAVE_PTY */
2112 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2113 Now reenable it in the child, so it will die when we want it to. */
2115 signal (SIGHUP
, SIG_DFL
);
2117 #endif /* HAVE_PTYS */
2119 signal (SIGINT
, SIG_DFL
);
2120 signal (SIGQUIT
, SIG_DFL
);
2122 /* Stop blocking signals in the child. */
2123 #ifdef POSIX_SIGNALS
2124 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2125 #else /* !POSIX_SIGNALS */
2129 #else /* not BSD4_1 */
2130 #if defined (BSD_SYSTEM) || defined (HPUX)
2131 sigsetmask (SIGEMPTYMASK
);
2132 #else /* ordinary USG */
2134 signal (SIGCHLD
, sigchld
);
2136 #endif /* ordinary USG */
2137 #endif /* not BSD4_1 */
2138 #endif /* SIGCHLD */
2139 #endif /* !POSIX_SIGNALS */
2141 #if !defined (DONT_REOPEN_PTY)
2143 child_setup_tty (xforkout
);
2144 #endif /* not DONT_REOPEN_PTY */
2146 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2147 new_argv
, 1, current_dir
);
2148 #else /* not WINDOWSNT */
2149 child_setup (xforkin
, xforkout
, xforkout
,
2150 new_argv
, 1, current_dir
);
2151 #endif /* not WINDOWSNT */
2153 environ
= save_environ
;
2158 /* This runs in the Emacs process. */
2162 emacs_close (forkin
);
2163 if (forkin
!= forkout
&& forkout
>= 0)
2164 emacs_close (forkout
);
2168 /* vfork succeeded. */
2169 XPROCESS (process
)->pid
= pid
;
2172 register_child (pid
, inchannel
);
2173 #endif /* WINDOWSNT */
2175 /* If the subfork execv fails, and it exits,
2176 this close hangs. I don't know why.
2177 So have an interrupt jar it loose. */
2179 struct atimer
*timer
;
2183 EMACS_SET_SECS_USECS (offset
, 1, 0);
2184 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2187 emacs_close (forkin
);
2189 cancel_atimer (timer
);
2193 if (forkin
!= forkout
&& forkout
>= 0)
2194 emacs_close (forkout
);
2198 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2201 XPROCESS (process
)->tty_name
= Qnil
;
2204 /* Restore the signal state whether vfork succeeded or not.
2205 (We will signal an error, below, if it failed.) */
2206 #ifdef POSIX_SIGNALS
2207 #ifdef HAVE_WORKING_VFORK
2208 /* Restore the parent's signal handlers. */
2209 sigaction (SIGINT
, &sigint_action
, 0);
2210 sigaction (SIGQUIT
, &sigquit_action
, 0);
2212 sigaction (SIGHUP
, &sighup_action
, 0);
2214 #endif /* HAVE_WORKING_VFORK */
2215 /* Stop blocking signals in the parent. */
2216 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2217 #else /* !POSIX_SIGNALS */
2221 #else /* not BSD4_1 */
2222 #if defined (BSD_SYSTEM) || defined (HPUX)
2223 sigsetmask (SIGEMPTYMASK
);
2224 #else /* ordinary USG */
2226 signal (SIGCHLD
, sigchld
);
2227 /* Now really handle any of these signals
2228 that came in during this function. */
2229 if (sigchld_deferred
)
2230 kill (getpid (), SIGCHLD
);
2232 #endif /* ordinary USG */
2233 #endif /* not BSD4_1 */
2234 #endif /* SIGCHLD */
2235 #endif /* !POSIX_SIGNALS */
2237 /* Now generate the error if vfork failed. */
2239 report_file_error ("Doing vfork", Qnil
);
2241 #endif /* not VMS */
2246 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2247 The address family of sa is not included in the result. */
2250 conv_sockaddr_to_lisp (sa
, len
)
2251 struct sockaddr
*sa
;
2254 Lisp_Object address
;
2257 register struct Lisp_Vector
*p
;
2259 switch (sa
->sa_family
)
2263 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2264 len
= sizeof (sin
->sin_addr
) + 1;
2265 address
= Fmake_vector (make_number (len
), Qnil
);
2266 p
= XVECTOR (address
);
2267 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2268 cp
= (unsigned char *)&sin
->sin_addr
;
2274 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2275 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2276 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2277 address
= Fmake_vector (make_number (len
), Qnil
);
2278 p
= XVECTOR (address
);
2279 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2280 for (i
= 0; i
< len
; i
++)
2281 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2285 #ifdef HAVE_LOCAL_SOCKETS
2288 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2289 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2290 if (sockun
->sun_path
[i
] == 0)
2292 return make_unibyte_string (sockun
->sun_path
, i
);
2296 len
-= sizeof (sa
->sa_family
);
2297 address
= Fcons (make_number (sa
->sa_family
),
2298 Fmake_vector (make_number (len
), Qnil
));
2299 p
= XVECTOR (XCDR (address
));
2300 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2306 p
->contents
[i
++] = make_number (*cp
++);
2312 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2315 get_lisp_to_sockaddr_size (address
, familyp
)
2316 Lisp_Object address
;
2319 register struct Lisp_Vector
*p
;
2321 if (VECTORP (address
))
2323 p
= XVECTOR (address
);
2327 return sizeof (struct sockaddr_in
);
2330 else if (p
->size
== 9)
2332 *familyp
= AF_INET6
;
2333 return sizeof (struct sockaddr_in6
);
2337 #ifdef HAVE_LOCAL_SOCKETS
2338 else if (STRINGP (address
))
2340 *familyp
= AF_LOCAL
;
2341 return sizeof (struct sockaddr_un
);
2344 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2346 struct sockaddr
*sa
;
2347 *familyp
= XINT (XCAR (address
));
2348 p
= XVECTOR (XCDR (address
));
2349 return p
->size
+ sizeof (sa
->sa_family
);
2354 /* Convert an address object (vector or string) to an internal sockaddr.
2356 The address format has been basically validated by
2357 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2358 it could have come from user data. So if FAMILY is not valid,
2359 we return after zeroing *SA. */
2362 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2364 Lisp_Object address
;
2365 struct sockaddr
*sa
;
2368 register struct Lisp_Vector
*p
;
2369 register unsigned char *cp
= NULL
;
2374 if (VECTORP (address
))
2376 p
= XVECTOR (address
);
2377 if (family
== AF_INET
)
2379 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2380 len
= sizeof (sin
->sin_addr
) + 1;
2381 i
= XINT (p
->contents
[--len
]);
2382 sin
->sin_port
= htons (i
);
2383 cp
= (unsigned char *)&sin
->sin_addr
;
2384 sa
->sa_family
= family
;
2387 else if (family
== AF_INET6
)
2389 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2390 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2391 len
= sizeof (sin6
->sin6_addr
) + 1;
2392 i
= XINT (p
->contents
[--len
]);
2393 sin6
->sin6_port
= htons (i
);
2394 for (i
= 0; i
< len
; i
++)
2395 if (INTEGERP (p
->contents
[i
]))
2397 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2400 sa
->sa_family
= family
;
2405 else if (STRINGP (address
))
2407 #ifdef HAVE_LOCAL_SOCKETS
2408 if (family
== AF_LOCAL
)
2410 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2411 cp
= SDATA (address
);
2412 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2413 sockun
->sun_path
[i
] = *cp
++;
2414 sa
->sa_family
= family
;
2421 p
= XVECTOR (XCDR (address
));
2422 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2425 for (i
= 0; i
< len
; i
++)
2426 if (INTEGERP (p
->contents
[i
]))
2427 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2430 #ifdef DATAGRAM_SOCKETS
2431 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2433 doc
: /* Get the current datagram address associated with PROCESS. */)
2435 Lisp_Object process
;
2439 CHECK_PROCESS (process
);
2441 if (!DATAGRAM_CONN_P (process
))
2444 channel
= XPROCESS (process
)->infd
;
2445 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2446 datagram_address
[channel
].len
);
2449 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2451 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2452 Returns nil upon error setting address, ADDRESS otherwise. */)
2454 Lisp_Object process
, address
;
2459 CHECK_PROCESS (process
);
2461 if (!DATAGRAM_CONN_P (process
))
2464 channel
= XPROCESS (process
)->infd
;
2466 len
= get_lisp_to_sockaddr_size (address
, &family
);
2467 if (datagram_address
[channel
].len
!= len
)
2469 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2475 static struct socket_options
{
2476 /* The name of this option. Should be lowercase version of option
2477 name without SO_ prefix. */
2479 /* Option level SOL_... */
2481 /* Option number SO_... */
2483 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2484 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2485 } socket_options
[] =
2487 #ifdef SO_BINDTODEVICE
2488 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2491 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2494 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2497 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2500 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2503 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2506 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2509 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2511 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2514 /* Set option OPT to value VAL on socket S.
2516 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2517 Signals an error if setting a known option fails.
2521 set_socket_option (s
, opt
, val
)
2523 Lisp_Object opt
, val
;
2526 struct socket_options
*sopt
;
2531 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2532 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2533 if (strcmp (name
, sopt
->name
) == 0)
2536 switch (sopt
->opttype
)
2541 optval
= NILP (val
) ? 0 : 1;
2542 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2543 &optval
, sizeof (optval
));
2551 optval
= XINT (val
);
2553 error ("Bad option value for %s", name
);
2554 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2555 &optval
, sizeof (optval
));
2559 #ifdef SO_BINDTODEVICE
2562 char devname
[IFNAMSIZ
+1];
2564 /* This is broken, at least in the Linux 2.4 kernel.
2565 To unbind, the arg must be a zero integer, not the empty string.
2566 This should work on all systems. KFS. 2003-09-23. */
2567 bzero (devname
, sizeof devname
);
2570 char *arg
= (char *) SDATA (val
);
2571 int len
= min (strlen (arg
), IFNAMSIZ
);
2572 bcopy (arg
, devname
, len
);
2574 else if (!NILP (val
))
2575 error ("Bad option value for %s", name
);
2576 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2585 struct linger linger
;
2588 linger
.l_linger
= 0;
2590 linger
.l_linger
= XINT (val
);
2592 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2593 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2594 &linger
, sizeof (linger
));
2604 report_file_error ("Cannot set network option",
2605 Fcons (opt
, Fcons (val
, Qnil
)));
2606 return (1 << sopt
->optbit
);
2610 DEFUN ("set-network-process-option",
2611 Fset_network_process_option
, Sset_network_process_option
,
2613 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2614 See `make-network-process' for a list of options and values.
2615 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2616 OPTION is not a supported option, return nil instead; otherwise return t. */)
2617 (process
, option
, value
, no_error
)
2618 Lisp_Object process
, option
, value
;
2619 Lisp_Object no_error
;
2622 struct Lisp_Process
*p
;
2624 CHECK_PROCESS (process
);
2625 p
= XPROCESS (process
);
2626 if (!NETCONN1_P (p
))
2627 error ("Process is not a network process");
2631 error ("Process is not running");
2633 if (set_socket_option (s
, option
, value
))
2635 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2639 if (NILP (no_error
))
2640 error ("Unknown or unsupported option");
2646 /* A version of request_sigio suitable for a record_unwind_protect. */
2650 unwind_request_sigio (dummy
)
2653 if (interrupt_input
)
2659 /* Create a network stream/datagram client/server process. Treated
2660 exactly like a normal process when reading and writing. Primary
2661 differences are in status display and process deletion. A network
2662 connection has no PID; you cannot signal it. All you can do is
2663 stop/continue it and deactivate/close it via delete-process */
2665 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2667 doc
: /* Create and return a network server or client process.
2669 In Emacs, network connections are represented by process objects, so
2670 input and output work as for subprocesses and `delete-process' closes
2671 a network connection. However, a network process has no process id,
2672 it cannot be signaled, and the status codes are different from normal
2675 Arguments are specified as keyword/argument pairs. The following
2676 arguments are defined:
2678 :name NAME -- NAME is name for process. It is modified if necessary
2681 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2682 with the process. Process output goes at end of that buffer, unless
2683 you specify an output stream or filter function to handle the output.
2684 BUFFER may be also nil, meaning that this process is not associated
2687 :host HOST -- HOST is name of the host to connect to, or its IP
2688 address. The symbol `local' specifies the local host. If specified
2689 for a server process, it must be a valid name or address for the local
2690 host, and only clients connecting to that address will be accepted.
2692 :service SERVICE -- SERVICE is name of the service desired, or an
2693 integer specifying a port number to connect to. If SERVICE is t,
2694 a random port number is selected for the server. (If Emacs was
2695 compiled with getaddrinfo, a port number can also be specified as a
2696 string, e.g. "80", as well as an integer. This is not portable.)
2698 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2699 stream type connection, `datagram' creates a datagram type connection.
2701 :family FAMILY -- FAMILY is the address (and protocol) family for the
2702 service specified by HOST and SERVICE. The default (nil) is to use
2703 whatever address family (IPv4 or IPv6) that is defined for the host
2704 and port number specified by HOST and SERVICE. Other address families
2706 local -- for a local (i.e. UNIX) address specified by SERVICE.
2707 ipv4 -- use IPv4 address family only.
2708 ipv6 -- use IPv6 address family only.
2710 :local ADDRESS -- ADDRESS is the local address used for the connection.
2711 This parameter is ignored when opening a client process. When specified
2712 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2714 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2715 connection. This parameter is ignored when opening a stream server
2716 process. For a datagram server process, it specifies the initial
2717 setting of the remote datagram address. When specified for a client
2718 process, the FAMILY, HOST, and SERVICE args are ignored.
2720 The format of ADDRESS depends on the address family:
2721 - An IPv4 address is represented as an vector of integers [A B C D P]
2722 corresponding to numeric IP address A.B.C.D and port number P.
2723 - A local address is represented as a string with the address in the
2724 local address space.
2725 - An "unsupported family" address is represented by a cons (F . AV)
2726 where F is the family number and AV is a vector containing the socket
2727 address data with one element per address data byte. Do not rely on
2728 this format in portable code, as it may depend on implementation
2729 defined constants, data sizes, and data structure alignment.
2731 :coding CODING -- If CODING is a symbol, it specifies the coding
2732 system used for both reading and writing for this process. If CODING
2733 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2734 ENCODING is used for writing.
2736 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2737 return without waiting for the connection to complete; instead, the
2738 sentinel function will be called with second arg matching "open" (if
2739 successful) or "failed" when the connect completes. Default is to use
2740 a blocking connect (i.e. wait) for stream type connections.
2742 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2743 running when Emacs is exited.
2745 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2746 In the stopped state, a server process does not accept new
2747 connections, and a client process does not handle incoming traffic.
2748 The stopped state is cleared by `continue-process' and set by
2751 :filter FILTER -- Install FILTER as the process filter.
2753 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2754 process filter are multibyte, otherwise they are unibyte.
2755 If this keyword is not specified, the strings are multibyte if
2756 `default-enable-multibyte-characters' is non-nil.
2758 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2760 :log LOG -- Install LOG as the server process log function. This
2761 function is called when the server accepts a network connection from a
2762 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2763 is the server process, CLIENT is the new process for the connection,
2764 and MESSAGE is a string.
2766 :plist PLIST -- Install PLIST as the new process' initial plist.
2768 :server QLEN -- if QLEN is non-nil, create a server process for the
2769 specified FAMILY, SERVICE, and connection type (stream or datagram).
2770 If QLEN is an integer, it is used as the max. length of the server's
2771 pending connection queue (also known as the backlog); the default
2772 queue length is 5. Default is to create a client process.
2774 The following network options can be specified for this connection:
2776 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2777 :dontroute BOOL -- Only send to directly connected hosts.
2778 :keepalive BOOL -- Send keep-alive messages on network stream.
2779 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2780 :oobinline BOOL -- Place out-of-band data in receive data stream.
2781 :priority INT -- Set protocol defined priority for sent packets.
2782 :reuseaddr BOOL -- Allow reusing a recently used local address
2783 (this is allowed by default for a server process).
2784 :bindtodevice NAME -- bind to interface NAME. Using this may require
2785 special privileges on some systems.
2787 Consult the relevant system programmer's manual pages for more
2788 information on using these options.
2791 A server process will listen for and accept connections from clients.
2792 When a client connection is accepted, a new network process is created
2793 for the connection with the following parameters:
2795 - The client's process name is constructed by concatenating the server
2796 process' NAME and a client identification string.
2797 - If the FILTER argument is non-nil, the client process will not get a
2798 separate process buffer; otherwise, the client's process buffer is a newly
2799 created buffer named after the server process' BUFFER name or process
2800 NAME concatenated with the client identification string.
2801 - The connection type and the process filter and sentinel parameters are
2802 inherited from the server process' TYPE, FILTER and SENTINEL.
2803 - The client process' contact info is set according to the client's
2804 addressing information (typically an IP address and a port number).
2805 - The client process' plist is initialized from the server's plist.
2807 Notice that the FILTER and SENTINEL args are never used directly by
2808 the server process. Also, the BUFFER argument is not used directly by
2809 the server process, but via the optional :log function, accepted (and
2810 failed) connections may be logged in the server process' buffer.
2812 The original argument list, modified with the actual connection
2813 information, is available via the `process-contact' function.
2815 usage: (make-network-process &rest ARGS) */)
2821 Lisp_Object contact
;
2822 struct Lisp_Process
*p
;
2823 #ifdef HAVE_GETADDRINFO
2824 struct addrinfo ai
, *res
, *lres
;
2825 struct addrinfo hints
;
2826 char *portstring
, portbuf
[128];
2827 #else /* HAVE_GETADDRINFO */
2828 struct _emacs_addrinfo
2834 struct sockaddr
*ai_addr
;
2835 struct _emacs_addrinfo
*ai_next
;
2837 #endif /* HAVE_GETADDRINFO */
2838 struct sockaddr_in address_in
;
2839 #ifdef HAVE_LOCAL_SOCKETS
2840 struct sockaddr_un address_un
;
2845 int s
= -1, outch
, inch
;
2846 struct gcpro gcpro1
;
2847 int count
= SPECPDL_INDEX ();
2849 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2851 Lisp_Object name
, buffer
, host
, service
, address
;
2852 Lisp_Object filter
, sentinel
;
2853 int is_non_blocking_client
= 0;
2854 int is_server
= 0, backlog
= 5;
2861 /* Save arguments for process-contact and clone-process. */
2862 contact
= Flist (nargs
, args
);
2866 /* Ensure socket support is loaded if available. */
2867 init_winsock (TRUE
);
2870 /* :type TYPE (nil: stream, datagram */
2871 tem
= Fplist_get (contact
, QCtype
);
2873 socktype
= SOCK_STREAM
;
2874 #ifdef DATAGRAM_SOCKETS
2875 else if (EQ (tem
, Qdatagram
))
2876 socktype
= SOCK_DGRAM
;
2879 error ("Unsupported connection type");
2882 tem
= Fplist_get (contact
, QCserver
);
2885 /* Don't support network sockets when non-blocking mode is
2886 not available, since a blocked Emacs is not useful. */
2887 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2888 error ("Network servers not supported");
2892 backlog
= XINT (tem
);
2896 /* Make QCaddress an alias for :local (server) or :remote (client). */
2897 QCaddress
= is_server
? QClocal
: QCremote
;
2900 if (!is_server
&& socktype
== SOCK_STREAM
2901 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2903 #ifndef NON_BLOCKING_CONNECT
2904 error ("Non-blocking connect not supported");
2906 is_non_blocking_client
= 1;
2910 name
= Fplist_get (contact
, QCname
);
2911 buffer
= Fplist_get (contact
, QCbuffer
);
2912 filter
= Fplist_get (contact
, QCfilter
);
2913 sentinel
= Fplist_get (contact
, QCsentinel
);
2915 CHECK_STRING (name
);
2918 /* Let's handle TERM before things get complicated ... */
2919 host
= Fplist_get (contact
, QChost
);
2920 CHECK_STRING (host
);
2922 service
= Fplist_get (contact
, QCservice
);
2923 if (INTEGERP (service
))
2924 port
= htons ((unsigned short) XINT (service
));
2927 struct servent
*svc_info
;
2928 CHECK_STRING (service
);
2929 svc_info
= getservbyname (SDATA (service
), "tcp");
2931 error ("Unknown service: %s", SDATA (service
));
2932 port
= svc_info
->s_port
;
2935 s
= connect_server (0);
2937 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2938 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2939 send_command (s
, C_DUMB
, 1, 0);
2941 #else /* not TERM */
2943 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2944 ai
.ai_socktype
= socktype
;
2949 /* :local ADDRESS or :remote ADDRESS */
2950 address
= Fplist_get (contact
, QCaddress
);
2951 if (!NILP (address
))
2953 host
= service
= Qnil
;
2955 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2956 error ("Malformed :address");
2957 ai
.ai_family
= family
;
2958 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2959 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2963 /* :family FAMILY -- nil (for Inet), local, or integer. */
2964 tem
= Fplist_get (contact
, QCfamily
);
2967 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
2973 #ifdef HAVE_LOCAL_SOCKETS
2974 else if (EQ (tem
, Qlocal
))
2978 else if (EQ (tem
, Qipv6
))
2981 else if (EQ (tem
, Qipv4
))
2983 else if (INTEGERP (tem
))
2984 family
= XINT (tem
);
2986 error ("Unknown address family");
2988 ai
.ai_family
= family
;
2990 /* :service SERVICE -- string, integer (port number), or t (random port). */
2991 service
= Fplist_get (contact
, QCservice
);
2993 #ifdef HAVE_LOCAL_SOCKETS
2994 if (family
== AF_LOCAL
)
2996 /* Host is not used. */
2998 CHECK_STRING (service
);
2999 bzero (&address_un
, sizeof address_un
);
3000 address_un
.sun_family
= AF_LOCAL
;
3001 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
3002 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
3003 ai
.ai_addrlen
= sizeof address_un
;
3008 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3009 host
= Fplist_get (contact
, QChost
);
3012 if (EQ (host
, Qlocal
))
3013 host
= build_string ("localhost");
3014 CHECK_STRING (host
);
3017 /* Slow down polling to every ten seconds.
3018 Some kernels have a bug which causes retrying connect to fail
3019 after a connect. Polling can interfere with gethostbyname too. */
3020 #ifdef POLL_FOR_INPUT
3021 if (socktype
== SOCK_STREAM
)
3023 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
3024 bind_polling_period (10);
3028 #ifdef HAVE_GETADDRINFO
3029 /* If we have a host, use getaddrinfo to resolve both host and service.
3030 Otherwise, use getservbyname to lookup the service. */
3034 /* SERVICE can either be a string or int.
3035 Convert to a C string for later use by getaddrinfo. */
3036 if (EQ (service
, Qt
))
3038 else if (INTEGERP (service
))
3040 sprintf (portbuf
, "%ld", (long) XINT (service
));
3041 portstring
= portbuf
;
3045 CHECK_STRING (service
);
3046 portstring
= SDATA (service
);
3051 memset (&hints
, 0, sizeof (hints
));
3053 hints
.ai_family
= family
;
3054 hints
.ai_socktype
= socktype
;
3055 hints
.ai_protocol
= 0;
3057 #ifdef HAVE_RES_INIT
3061 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3063 #ifdef HAVE_GAI_STRERROR
3064 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
3066 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3072 #endif /* HAVE_GETADDRINFO */
3074 /* We end up here if getaddrinfo is not defined, or in case no hostname
3075 has been specified (e.g. for a local server process). */
3077 if (EQ (service
, Qt
))
3079 else if (INTEGERP (service
))
3080 port
= htons ((unsigned short) XINT (service
));
3083 struct servent
*svc_info
;
3084 CHECK_STRING (service
);
3085 svc_info
= getservbyname (SDATA (service
),
3086 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3088 error ("Unknown service: %s", SDATA (service
));
3089 port
= svc_info
->s_port
;
3092 bzero (&address_in
, sizeof address_in
);
3093 address_in
.sin_family
= family
;
3094 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3095 address_in
.sin_port
= port
;
3097 #ifndef HAVE_GETADDRINFO
3100 struct hostent
*host_info_ptr
;
3102 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3103 as it may `hang' Emacs for a very long time. */
3107 #ifdef HAVE_RES_INIT
3111 host_info_ptr
= gethostbyname (SDATA (host
));
3116 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
3117 host_info_ptr
->h_length
);
3118 family
= host_info_ptr
->h_addrtype
;
3119 address_in
.sin_family
= family
;
3122 /* Attempt to interpret host as numeric inet address */
3124 unsigned long numeric_addr
;
3125 numeric_addr
= inet_addr ((char *) SDATA (host
));
3126 if (numeric_addr
== -1)
3127 error ("Unknown host \"%s\"", SDATA (host
));
3129 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
3130 sizeof (address_in
.sin_addr
));
3134 #endif /* not HAVE_GETADDRINFO */
3136 ai
.ai_family
= family
;
3137 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3138 ai
.ai_addrlen
= sizeof address_in
;
3143 /* Previously this was compiled unconditionally, but that seems
3144 unnecessary on modern systems, and `unrequest_sigio' was a noop
3145 under X anyway. --lorentey */
3146 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
3147 when connect is interrupted. So let's not let it get interrupted.
3148 Note we do not turn off polling, because polling is only used
3149 when not interrupt_input, and thus not normally used on the systems
3150 which have this bug. On systems which use polling, there's no way
3151 to quit if polling is turned off. */
3153 && !is_server
&& socktype
== SOCK_STREAM
)
3155 /* Comment from KFS: The original open-network-stream code
3156 didn't unwind protect this, but it seems like the proper
3157 thing to do. In any case, I don't see how it could harm to
3158 do this -- and it makes cleanup (using unbind_to) easier. */
3159 record_unwind_protect (unwind_request_sigio
, Qnil
);
3164 /* Do this in case we never enter the for-loop below. */
3165 count1
= SPECPDL_INDEX ();
3168 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3174 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3181 #ifdef DATAGRAM_SOCKETS
3182 if (!is_server
&& socktype
== SOCK_DGRAM
)
3184 #endif /* DATAGRAM_SOCKETS */
3186 #ifdef NON_BLOCKING_CONNECT
3187 if (is_non_blocking_client
)
3190 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3192 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3204 /* Make us close S if quit. */
3205 record_unwind_protect (close_file_unwind
, make_number (s
));
3207 /* Parse network options in the arg list.
3208 We simply ignore anything which isn't a known option (including other keywords).
3209 An error is signalled if setting a known option fails. */
3210 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3211 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3215 /* Configure as a server socket. */
3217 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3218 explicit :reuseaddr key to override this. */
3219 #ifdef HAVE_LOCAL_SOCKETS
3220 if (family
!= AF_LOCAL
)
3222 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3225 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3226 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3229 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3230 report_file_error ("Cannot bind server socket", Qnil
);
3232 #ifdef HAVE_GETSOCKNAME
3233 if (EQ (service
, Qt
))
3235 struct sockaddr_in sa1
;
3236 int len1
= sizeof (sa1
);
3237 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3239 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3240 service
= make_number (ntohs (sa1
.sin_port
));
3241 contact
= Fplist_put (contact
, QCservice
, service
);
3246 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3247 report_file_error ("Cannot listen on server socket", Qnil
);
3255 /* This turns off all alarm-based interrupts; the
3256 bind_polling_period call above doesn't always turn all the
3257 short-interval ones off, especially if interrupt_input is
3260 It'd be nice to be able to control the connect timeout
3261 though. Would non-blocking connect calls be portable?
3263 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3265 turn_on_atimers (0);
3267 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3270 turn_on_atimers (1);
3272 if (ret
== 0 || xerrno
== EISCONN
)
3274 /* The unwind-protect will be discarded afterwards.
3275 Likewise for immediate_quit. */
3279 #ifdef NON_BLOCKING_CONNECT
3281 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3285 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3293 /* Discard the unwind protect closing S. */
3294 specpdl_ptr
= specpdl
+ count1
;
3298 if (xerrno
== EINTR
)
3304 #ifdef DATAGRAM_SOCKETS
3305 if (socktype
== SOCK_DGRAM
)
3307 if (datagram_address
[s
].sa
)
3309 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3310 datagram_address
[s
].len
= lres
->ai_addrlen
;
3314 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3315 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3318 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3319 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3320 conv_lisp_to_sockaddr (rfamily
, remote
,
3321 datagram_address
[s
].sa
, rlen
);
3325 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3328 contact
= Fplist_put (contact
, QCaddress
,
3329 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3330 #ifdef HAVE_GETSOCKNAME
3333 struct sockaddr_in sa1
;
3334 int len1
= sizeof (sa1
);
3335 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3336 contact
= Fplist_put (contact
, QClocal
,
3337 conv_sockaddr_to_lisp (&sa1
, len1
));
3344 #ifdef HAVE_GETADDRINFO
3353 /* Discard the unwind protect for closing S, if any. */
3354 specpdl_ptr
= specpdl
+ count1
;
3356 /* Unwind bind_polling_period and request_sigio. */
3357 unbind_to (count
, Qnil
);
3361 /* If non-blocking got this far - and failed - assume non-blocking is
3362 not supported after all. This is probably a wrong assumption, but
3363 the normal blocking calls to open-network-stream handles this error
3365 if (is_non_blocking_client
)
3370 report_file_error ("make server process failed", contact
);
3372 report_file_error ("make client process failed", contact
);
3375 #endif /* not TERM */
3381 buffer
= Fget_buffer_create (buffer
);
3382 proc
= make_process (name
);
3384 chan_process
[inch
] = proc
;
3387 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3390 fcntl (inch
, F_SETFL
, O_NDELAY
);
3394 p
= XPROCESS (proc
);
3396 p
->childp
= contact
;
3397 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3400 p
->sentinel
= sentinel
;
3402 p
->log
= Fplist_get (contact
, QClog
);
3403 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3404 p
->kill_without_query
= 1;
3405 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3410 if (is_server
&& socktype
== SOCK_STREAM
)
3411 p
->status
= Qlisten
;
3413 /* Make the process marker point into the process buffer (if any). */
3414 if (BUFFERP (buffer
))
3415 set_marker_both (p
->mark
, buffer
,
3416 BUF_ZV (XBUFFER (buffer
)),
3417 BUF_ZV_BYTE (XBUFFER (buffer
)));
3419 #ifdef NON_BLOCKING_CONNECT
3420 if (is_non_blocking_client
)
3422 /* We may get here if connect did succeed immediately. However,
3423 in that case, we still need to signal this like a non-blocking
3425 p
->status
= Qconnect
;
3426 if (!FD_ISSET (inch
, &connect_wait_mask
))
3428 FD_SET (inch
, &connect_wait_mask
);
3429 num_pending_connects
++;
3434 /* A server may have a client filter setting of Qt, but it must
3435 still listen for incoming connects unless it is stopped. */
3436 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3437 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3439 FD_SET (inch
, &input_wait_mask
);
3440 FD_SET (inch
, &non_keyboard_wait_mask
);
3443 if (inch
> max_process_desc
)
3444 max_process_desc
= inch
;
3446 tem
= Fplist_member (contact
, QCcoding
);
3447 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3448 tem
= Qnil
; /* No error message (too late!). */
3451 /* Setup coding systems for communicating with the network stream. */
3452 struct gcpro gcpro1
;
3453 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3454 Lisp_Object coding_systems
= Qt
;
3455 Lisp_Object args
[5], val
;
3459 val
= XCAR (XCDR (tem
));
3463 else if (!NILP (Vcoding_system_for_read
))
3464 val
= Vcoding_system_for_read
;
3465 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3466 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3467 /* We dare not decode end-of-line format by setting VAL to
3468 Qraw_text, because the existing Emacs Lisp libraries
3469 assume that they receive bare code including a sequene of
3474 if (NILP (host
) || NILP (service
))
3475 coding_systems
= Qnil
;
3478 args
[0] = Qopen_network_stream
, args
[1] = name
,
3479 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3481 coding_systems
= Ffind_operation_coding_system (5, args
);
3484 if (CONSP (coding_systems
))
3485 val
= XCAR (coding_systems
);
3486 else if (CONSP (Vdefault_process_coding_system
))
3487 val
= XCAR (Vdefault_process_coding_system
);
3491 p
->decode_coding_system
= val
;
3495 val
= XCAR (XCDR (tem
));
3499 else if (!NILP (Vcoding_system_for_write
))
3500 val
= Vcoding_system_for_write
;
3501 else if (NILP (current_buffer
->enable_multibyte_characters
))
3505 if (EQ (coding_systems
, Qt
))
3507 if (NILP (host
) || NILP (service
))
3508 coding_systems
= Qnil
;
3511 args
[0] = Qopen_network_stream
, args
[1] = name
,
3512 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3514 coding_systems
= Ffind_operation_coding_system (5, args
);
3518 if (CONSP (coding_systems
))
3519 val
= XCDR (coding_systems
);
3520 else if (CONSP (Vdefault_process_coding_system
))
3521 val
= XCDR (Vdefault_process_coding_system
);
3525 p
->encode_coding_system
= val
;
3527 setup_process_coding_systems (proc
);
3529 p
->decoding_buf
= make_uninit_string (0);
3530 p
->decoding_carryover
= 0;
3531 p
->encoding_buf
= make_uninit_string (0);
3533 p
->inherit_coding_system_flag
3534 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
3539 #endif /* HAVE_SOCKETS */
3542 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3545 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3546 doc
: /* Return an alist of all network interfaces and their network address.
3547 Each element is a cons, the car of which is a string containing the
3548 interface name, and the cdr is the network address in internal
3549 format; see the description of ADDRESS in `make-network-process'. */)
3552 struct ifconf ifconf
;
3553 struct ifreq
*ifreqs
= NULL
;
3558 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3564 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3565 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3572 ifconf
.ifc_len
= buf_size
;
3573 ifconf
.ifc_req
= ifreqs
;
3574 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3580 if (ifconf
.ifc_len
== buf_size
)
3584 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3587 while (--ifaces
>= 0)
3589 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3590 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3591 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3593 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3594 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3595 res
= Fcons (Fcons (build_string (namebuf
),
3596 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3597 sizeof (struct sockaddr
))),
3603 #endif /* SIOCGIFCONF */
3605 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3612 static struct ifflag_def ifflag_table
[] = {
3616 #ifdef IFF_BROADCAST
3617 { IFF_BROADCAST
, "broadcast" },
3620 { IFF_DEBUG
, "debug" },
3623 { IFF_LOOPBACK
, "loopback" },
3625 #ifdef IFF_POINTOPOINT
3626 { IFF_POINTOPOINT
, "pointopoint" },
3629 { IFF_RUNNING
, "running" },
3632 { IFF_NOARP
, "noarp" },
3635 { IFF_PROMISC
, "promisc" },
3637 #ifdef IFF_NOTRAILERS
3638 { IFF_NOTRAILERS
, "notrailers" },
3641 { IFF_ALLMULTI
, "allmulti" },
3644 { IFF_MASTER
, "master" },
3647 { IFF_SLAVE
, "slave" },
3649 #ifdef IFF_MULTICAST
3650 { IFF_MULTICAST
, "multicast" },
3653 { IFF_PORTSEL
, "portsel" },
3655 #ifdef IFF_AUTOMEDIA
3656 { IFF_AUTOMEDIA
, "automedia" },
3659 { IFF_DYNAMIC
, "dynamic" },
3662 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3665 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3668 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3671 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3674 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3679 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3680 doc
: /* Return information about network interface named IFNAME.
3681 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3682 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3683 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3684 FLAGS is the current flags of the interface. */)
3689 Lisp_Object res
= Qnil
;
3694 CHECK_STRING (ifname
);
3696 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3697 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3699 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3704 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3705 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3707 int flags
= rq
.ifr_flags
;
3708 struct ifflag_def
*fp
;
3712 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3714 if (flags
& fp
->flag_bit
)
3716 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3717 flags
-= fp
->flag_bit
;
3720 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3722 if (flags
& (1 << fnum
))
3724 elt
= Fcons (make_number (fnum
), elt
);
3729 res
= Fcons (elt
, res
);
3732 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3733 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3735 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3736 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3740 for (n
= 0; n
< 6; n
++)
3741 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3742 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3745 res
= Fcons (elt
, res
);
3748 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
3749 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3752 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3753 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3755 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3759 res
= Fcons (elt
, res
);
3762 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3763 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3766 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3769 res
= Fcons (elt
, res
);
3772 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3773 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3776 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3779 res
= Fcons (elt
, res
);
3783 return any
? res
: Qnil
;
3786 #endif /* HAVE_SOCKETS */
3788 /* Turn off input and output for process PROC. */
3791 deactivate_process (proc
)
3794 register int inchannel
, outchannel
;
3795 register struct Lisp_Process
*p
= XPROCESS (proc
);
3797 inchannel
= p
->infd
;
3798 outchannel
= p
->outfd
;
3800 #ifdef ADAPTIVE_READ_BUFFERING
3801 if (p
->read_output_delay
> 0)
3803 if (--process_output_delay_count
< 0)
3804 process_output_delay_count
= 0;
3805 p
->read_output_delay
= 0;
3806 p
->read_output_skip
= 0;
3812 /* Beware SIGCHLD hereabouts. */
3813 flush_pending_output (inchannel
);
3816 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3817 sys$
dassgn (outchannel
);
3818 vs
= get_vms_process_pointer (p
->pid
);
3820 give_back_vms_process_stuff (vs
);
3823 emacs_close (inchannel
);
3824 if (outchannel
>= 0 && outchannel
!= inchannel
)
3825 emacs_close (outchannel
);
3830 #ifdef DATAGRAM_SOCKETS
3831 if (DATAGRAM_CHAN_P (inchannel
))
3833 xfree (datagram_address
[inchannel
].sa
);
3834 datagram_address
[inchannel
].sa
= 0;
3835 datagram_address
[inchannel
].len
= 0;
3838 chan_process
[inchannel
] = Qnil
;
3839 FD_CLR (inchannel
, &input_wait_mask
);
3840 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3841 #ifdef NON_BLOCKING_CONNECT
3842 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3844 FD_CLR (inchannel
, &connect_wait_mask
);
3845 if (--num_pending_connects
< 0)
3849 if (inchannel
== max_process_desc
)
3852 /* We just closed the highest-numbered process input descriptor,
3853 so recompute the highest-numbered one now. */
3854 max_process_desc
= 0;
3855 for (i
= 0; i
< MAXDESC
; i
++)
3856 if (!NILP (chan_process
[i
]))
3857 max_process_desc
= i
;
3862 /* Close all descriptors currently in use for communication
3863 with subprocess. This is used in a newly-forked subprocess
3864 to get rid of irrelevant descriptors. */
3867 close_process_descs ()
3871 for (i
= 0; i
< MAXDESC
; i
++)
3873 Lisp_Object process
;
3874 process
= chan_process
[i
];
3875 if (!NILP (process
))
3877 int in
= XPROCESS (process
)->infd
;
3878 int out
= XPROCESS (process
)->outfd
;
3881 if (out
>= 0 && in
!= out
)
3888 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3890 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3891 It is read into the process' buffers or given to their filter functions.
3892 Non-nil arg PROCESS means do not return until some output has been received
3895 Non-nil second arg SECONDS and third arg MILLISEC are number of
3896 seconds and milliseconds to wait; return after that much time whether
3897 or not there is input. If SECONDS is a floating point number,
3898 it specifies a fractional number of seconds to wait.
3899 The MILLISEC argument is obsolete and should be avoided.
3901 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3902 from PROCESS, suspending reading output from other processes.
3903 If JUST-THIS-ONE is an integer, don't run any timers either.
3904 Return non-nil if we received any output before the timeout expired. */)
3905 (process
, seconds
, millisec
, just_this_one
)
3906 register Lisp_Object process
, seconds
, millisec
, just_this_one
;
3908 int secs
, usecs
= 0;
3910 if (! NILP (process
))
3911 CHECK_PROCESS (process
);
3913 just_this_one
= Qnil
;
3915 if (!NILP (millisec
))
3916 { /* Obsolete calling convention using integers rather than floats. */
3917 CHECK_NUMBER (millisec
);
3919 seconds
= make_float (XINT (millisec
) / 1000.0);
3922 CHECK_NUMBER (seconds
);
3923 seconds
= make_float (XINT (millisec
) / 1000.0 + XINT (seconds
));
3927 if (!NILP (seconds
))
3929 if (INTEGERP (seconds
))
3930 secs
= XINT (seconds
);
3931 else if (FLOATP (seconds
))
3933 double timeout
= XFLOAT_DATA (seconds
);
3934 secs
= (int) timeout
;
3935 usecs
= (int) ((timeout
- (double) secs
) * 1000000);
3938 wrong_type_argument (Qnumberp
, seconds
);
3940 if (secs
< 0 || (secs
== 0 && usecs
== 0))
3941 secs
= -1, usecs
= 0;
3944 secs
= NILP (process
) ? -1 : 0;
3947 (wait_reading_process_output (secs
, usecs
, 0, 0,
3949 !NILP (process
) ? XPROCESS (process
) : NULL
,
3950 NILP (just_this_one
) ? 0 :
3951 !INTEGERP (just_this_one
) ? 1 : -1)
3955 /* Accept a connection for server process SERVER on CHANNEL. */
3957 static int connect_counter
= 0;
3960 server_accept_connection (server
, channel
)
3964 Lisp_Object proc
, caller
, name
, buffer
;
3965 Lisp_Object contact
, host
, service
;
3966 struct Lisp_Process
*ps
= XPROCESS (server
);
3967 struct Lisp_Process
*p
;
3971 struct sockaddr_in in
;
3973 struct sockaddr_in6 in6
;
3975 #ifdef HAVE_LOCAL_SOCKETS
3976 struct sockaddr_un un
;
3979 int len
= sizeof saddr
;
3981 s
= accept (channel
, &saddr
.sa
, &len
);
3990 if (code
== EWOULDBLOCK
)
3994 if (!NILP (ps
->log
))
3995 call3 (ps
->log
, server
, Qnil
,
3996 concat3 (build_string ("accept failed with code"),
3997 Fnumber_to_string (make_number (code
)),
3998 build_string ("\n")));
4004 /* Setup a new process to handle the connection. */
4006 /* Generate a unique identification of the caller, and build contact
4007 information for this process. */
4010 switch (saddr
.sa
.sa_family
)
4014 Lisp_Object args
[5];
4015 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4016 args
[0] = build_string ("%d.%d.%d.%d");
4017 args
[1] = make_number (*ip
++);
4018 args
[2] = make_number (*ip
++);
4019 args
[3] = make_number (*ip
++);
4020 args
[4] = make_number (*ip
++);
4021 host
= Fformat (5, args
);
4022 service
= make_number (ntohs (saddr
.in
.sin_port
));
4024 args
[0] = build_string (" <%s:%d>");
4027 caller
= Fformat (3, args
);
4034 Lisp_Object args
[9];
4035 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4037 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4038 for (i
= 0; i
< 8; i
++)
4039 args
[i
+1] = make_number (ntohs(ip6
[i
]));
4040 host
= Fformat (9, args
);
4041 service
= make_number (ntohs (saddr
.in
.sin_port
));
4043 args
[0] = build_string (" <[%s]:%d>");
4046 caller
= Fformat (3, args
);
4051 #ifdef HAVE_LOCAL_SOCKETS
4055 caller
= Fnumber_to_string (make_number (connect_counter
));
4056 caller
= concat3 (build_string (" <"), caller
, build_string (">"));
4060 /* Create a new buffer name for this process if it doesn't have a
4061 filter. The new buffer name is based on the buffer name or
4062 process name of the server process concatenated with the caller
4065 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4069 buffer
= ps
->buffer
;
4071 buffer
= Fbuffer_name (buffer
);
4076 buffer
= concat2 (buffer
, caller
);
4077 buffer
= Fget_buffer_create (buffer
);
4081 /* Generate a unique name for the new server process. Combine the
4082 server process name with the caller identification. */
4084 name
= concat2 (ps
->name
, caller
);
4085 proc
= make_process (name
);
4087 chan_process
[s
] = proc
;
4090 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4093 fcntl (s
, F_SETFL
, O_NDELAY
);
4097 p
= XPROCESS (proc
);
4099 /* Build new contact information for this setup. */
4100 contact
= Fcopy_sequence (ps
->childp
);
4101 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4102 contact
= Fplist_put (contact
, QChost
, host
);
4103 if (!NILP (service
))
4104 contact
= Fplist_put (contact
, QCservice
, service
);
4105 contact
= Fplist_put (contact
, QCremote
,
4106 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4107 #ifdef HAVE_GETSOCKNAME
4109 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4110 contact
= Fplist_put (contact
, QClocal
,
4111 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4114 p
->childp
= contact
;
4115 p
->plist
= Fcopy_sequence (ps
->plist
);
4118 p
->sentinel
= ps
->sentinel
;
4119 p
->filter
= ps
->filter
;
4126 /* Client processes for accepted connections are not stopped initially. */
4127 if (!EQ (p
->filter
, Qt
))
4129 FD_SET (s
, &input_wait_mask
);
4130 FD_SET (s
, &non_keyboard_wait_mask
);
4133 if (s
> max_process_desc
)
4134 max_process_desc
= s
;
4136 /* Setup coding system for new process based on server process.
4137 This seems to be the proper thing to do, as the coding system
4138 of the new process should reflect the settings at the time the
4139 server socket was opened; not the current settings. */
4141 p
->decode_coding_system
= ps
->decode_coding_system
;
4142 p
->encode_coding_system
= ps
->encode_coding_system
;
4143 setup_process_coding_systems (proc
);
4145 p
->decoding_buf
= make_uninit_string (0);
4146 p
->decoding_carryover
= 0;
4147 p
->encoding_buf
= make_uninit_string (0);
4149 p
->inherit_coding_system_flag
4150 = (NILP (buffer
) ? 0 : ps
->inherit_coding_system_flag
);
4152 if (!NILP (ps
->log
))
4153 call3 (ps
->log
, server
, proc
,
4154 concat3 (build_string ("accept from "),
4155 (STRINGP (host
) ? host
: build_string ("-")),
4156 build_string ("\n")));
4158 if (!NILP (p
->sentinel
))
4159 exec_sentinel (proc
,
4160 concat3 (build_string ("open from "),
4161 (STRINGP (host
) ? host
: build_string ("-")),
4162 build_string ("\n")));
4165 /* This variable is different from waiting_for_input in keyboard.c.
4166 It is used to communicate to a lisp process-filter/sentinel (via the
4167 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4168 for user-input when that process-filter was called.
4169 waiting_for_input cannot be used as that is by definition 0 when
4170 lisp code is being evalled.
4171 This is also used in record_asynch_buffer_change.
4172 For that purpose, this must be 0
4173 when not inside wait_reading_process_output. */
4174 static int waiting_for_user_input_p
;
4177 wait_reading_process_output_unwind (data
)
4180 waiting_for_user_input_p
= XINT (data
);
4184 /* This is here so breakpoints can be put on it. */
4186 wait_reading_process_output_1 ()
4190 /* Use a wrapper around select to work around a bug in gdb 5.3.
4191 Normally, the wrapper is optimzed away by inlining.
4193 If emacs is stopped inside select, the gdb backtrace doesn't
4194 show the function which called select, so it is practically
4195 impossible to step through wait_reading_process_output. */
4199 select_wrapper (n
, rfd
, wfd
, xfd
, tmo
)
4201 SELECT_TYPE
*rfd
, *wfd
, *xfd
;
4204 return select (n
, rfd
, wfd
, xfd
, tmo
);
4206 #define select select_wrapper
4209 /* Read and dispose of subprocess output while waiting for timeout to
4210 elapse and/or keyboard input to be available.
4213 timeout in seconds, or
4214 zero for no limit, or
4215 -1 means gobble data immediately available but don't wait for any.
4218 an additional duration to wait, measured in microseconds.
4219 If this is nonzero and time_limit is 0, then the timeout
4220 consists of MICROSECS only.
4222 READ_KBD is a lisp value:
4223 0 to ignore keyboard input, or
4224 1 to return when input is available, or
4225 -1 meaning caller will actually read the input, so don't throw to
4226 the quit handler, or
4228 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4229 output that arrives.
4231 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4232 (and gobble terminal input into the buffer if any arrives).
4234 If WAIT_PROC is specified, wait until something arrives from that
4235 process. The return value is true if we read some input from
4238 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4239 (suspending output from other processes). A negative value
4240 means don't run any timers either.
4242 If WAIT_PROC is specified, then the function returns true if we
4243 received input from that process before the timeout elapsed.
4244 Otherwise, return true if we received input from any process. */
4247 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
4248 wait_for_cell
, wait_proc
, just_wait_proc
)
4249 int time_limit
, microsecs
, read_kbd
, do_display
;
4250 Lisp_Object wait_for_cell
;
4251 struct Lisp_Process
*wait_proc
;
4254 register int channel
, nfds
;
4255 SELECT_TYPE Available
;
4256 #ifdef NON_BLOCKING_CONNECT
4257 SELECT_TYPE Connecting
;
4260 int check_delay
, no_avail
;
4263 EMACS_TIME timeout
, end_time
;
4264 int wait_channel
= -1;
4265 int got_some_input
= 0;
4266 int count
= SPECPDL_INDEX ();
4268 FD_ZERO (&Available
);
4269 #ifdef NON_BLOCKING_CONNECT
4270 FD_ZERO (&Connecting
);
4273 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4274 if (wait_proc
!= NULL
)
4275 wait_channel
= wait_proc
->infd
;
4277 record_unwind_protect (wait_reading_process_output_unwind
,
4278 make_number (waiting_for_user_input_p
));
4279 waiting_for_user_input_p
= read_kbd
;
4281 /* Since we may need to wait several times,
4282 compute the absolute time to return at. */
4283 if (time_limit
|| microsecs
)
4285 EMACS_GET_TIME (end_time
);
4286 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4287 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4289 #ifdef POLL_INTERRUPTED_SYS_CALL
4290 /* AlainF 5-Jul-1996
4291 HP-UX 10.10 seem to have problems with signals coming in
4292 Causes "poll: interrupted system call" messages when Emacs is run
4294 Turn off periodic alarms (in case they are in use),
4295 and then turn off any other atimers. */
4297 turn_on_atimers (0);
4298 #endif /* POLL_INTERRUPTED_SYS_CALL */
4302 int timeout_reduced_for_timers
= 0;
4304 /* If calling from keyboard input, do not quit
4305 since we want to return C-g as an input character.
4306 Otherwise, do pending quit if requested. */
4312 if (interrupt_input_pending
)
4313 handle_async_input ();
4314 if (pending_atimers
)
4315 do_pending_atimers ();
4319 /* Exit now if the cell we're waiting for became non-nil. */
4320 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4323 /* Compute time from now till when time limit is up */
4324 /* Exit if already run out */
4325 if (time_limit
== -1)
4327 /* -1 specified for timeout means
4328 gobble output available now
4329 but don't wait at all. */
4331 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4333 else if (time_limit
|| microsecs
)
4335 EMACS_GET_TIME (timeout
);
4336 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4337 if (EMACS_TIME_NEG_P (timeout
))
4342 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4345 /* Normally we run timers here.
4346 But not if wait_for_cell; in those cases,
4347 the wait is supposed to be short,
4348 and those callers cannot handle running arbitrary Lisp code here. */
4349 if (NILP (wait_for_cell
)
4350 && just_wait_proc
>= 0)
4352 EMACS_TIME timer_delay
;
4356 int old_timers_run
= timers_run
;
4357 struct buffer
*old_buffer
= current_buffer
;
4358 Lisp_Object old_window
= selected_window
;
4360 timer_delay
= timer_check (1);
4362 /* If a timer has run, this might have changed buffers
4363 an alike. Make read_key_sequence aware of that. */
4364 if (timers_run
!= old_timers_run
4365 && (old_buffer
!= current_buffer
4366 || !EQ (old_window
, selected_window
))
4367 && waiting_for_user_input_p
== -1)
4368 record_asynch_buffer_change ();
4370 if (timers_run
!= old_timers_run
&& do_display
)
4371 /* We must retry, since a timer may have requeued itself
4372 and that could alter the time_delay. */
4373 redisplay_preserve_echo_area (9);
4377 while (!detect_input_pending ());
4379 /* If there is unread keyboard input, also return. */
4381 && requeued_events_pending_p ())
4384 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4386 EMACS_TIME difference
;
4387 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4388 if (EMACS_TIME_NEG_P (difference
))
4390 timeout
= timer_delay
;
4391 timeout_reduced_for_timers
= 1;
4394 /* If time_limit is -1, we are not going to wait at all. */
4395 else if (time_limit
!= -1)
4397 /* This is so a breakpoint can be put here. */
4398 wait_reading_process_output_1 ();
4402 /* Cause C-g and alarm signals to take immediate action,
4403 and cause input available signals to zero out timeout.
4405 It is important that we do this before checking for process
4406 activity. If we get a SIGCHLD after the explicit checks for
4407 process activity, timeout is the only way we will know. */
4409 set_waiting_for_input (&timeout
);
4411 /* If status of something has changed, and no input is
4412 available, notify the user of the change right away. After
4413 this explicit check, we'll let the SIGCHLD handler zap
4414 timeout to get our attention. When Emacs is run
4415 interactively, only do this with a nonzero DO_DISPLAY
4416 argument, because status_notify triggers redisplay. */
4417 if (update_tick
!= process_tick
4418 && (do_display
|| noninteractive
))
4421 #ifdef NON_BLOCKING_CONNECT
4425 Atemp
= input_wait_mask
;
4427 /* On Mac OS X 10.0, the SELECT system call always says input is
4428 present (for reading) at stdin, even when none is. This
4429 causes the call to SELECT below to return 1 and
4430 status_notify not to be called. As a result output of
4431 subprocesses are incorrectly discarded.
4435 IF_NON_BLOCKING_CONNECT (Ctemp
= connect_wait_mask
);
4437 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4438 if ((select (max (max (max_process_desc
, max_keyboard_desc
),
4441 #ifdef NON_BLOCKING_CONNECT
4442 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4446 (SELECT_TYPE
*)0, &timeout
)
4449 /* It's okay for us to do this and then continue with
4450 the loop, since timeout has already been zeroed out. */
4451 clear_waiting_for_input ();
4452 status_notify (NULL
);
4456 /* Don't wait for output from a non-running process. Just
4457 read whatever data has already been received. */
4458 if (wait_proc
&& wait_proc
->raw_status_new
)
4459 update_status (wait_proc
);
4461 && ! EQ (wait_proc
->status
, Qrun
)
4462 && ! EQ (wait_proc
->status
, Qconnect
))
4464 int nread
, total_nread
= 0;
4466 clear_waiting_for_input ();
4467 XSETPROCESS (proc
, wait_proc
);
4469 /* Read data from the process, until we exhaust it. */
4470 while (wait_proc
->infd
>= 0)
4472 nread
= read_process_output (proc
, wait_proc
->infd
);
4479 total_nread
+= nread
;
4483 else if (nread
== -1 && EIO
== errno
)
4487 else if (nread
== -1 && EAGAIN
== errno
)
4491 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4495 if (total_nread
> 0 && do_display
)
4496 redisplay_preserve_echo_area (10);
4501 /* Wait till there is something to do */
4503 if (wait_proc
&& just_wait_proc
)
4505 if (wait_proc
->infd
< 0) /* Terminated */
4507 FD_SET (wait_proc
->infd
, &Available
);
4509 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4511 else if (!NILP (wait_for_cell
))
4513 Available
= non_process_wait_mask
;
4515 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4520 Available
= non_keyboard_wait_mask
;
4522 Available
= input_wait_mask
;
4523 IF_NON_BLOCKING_CONNECT (check_connect
= (num_pending_connects
> 0));
4524 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4527 /* If frame size has changed or the window is newly mapped,
4528 redisplay now, before we start to wait. There is a race
4529 condition here; if a SIGIO arrives between now and the select
4530 and indicates that a frame is trashed, the select may block
4531 displaying a trashed screen. */
4532 if (frame_garbaged
&& do_display
)
4534 clear_waiting_for_input ();
4535 redisplay_preserve_echo_area (11);
4537 set_waiting_for_input (&timeout
);
4541 if (read_kbd
&& detect_input_pending ())
4548 #ifdef NON_BLOCKING_CONNECT
4550 Connecting
= connect_wait_mask
;
4553 #ifdef ADAPTIVE_READ_BUFFERING
4554 /* Set the timeout for adaptive read buffering if any
4555 process has non-zero read_output_skip and non-zero
4556 read_output_delay, and we are not reading output for a
4557 specific wait_channel. It is not executed if
4558 Vprocess_adaptive_read_buffering is nil. */
4559 if (process_output_skip
&& check_delay
> 0)
4561 int usecs
= EMACS_USECS (timeout
);
4562 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4563 usecs
= READ_OUTPUT_DELAY_MAX
;
4564 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4566 proc
= chan_process
[channel
];
4569 /* Find minimum non-zero read_output_delay among the
4570 processes with non-zero read_output_skip. */
4571 if (XPROCESS (proc
)->read_output_delay
> 0)
4574 if (!XPROCESS (proc
)->read_output_skip
)
4576 FD_CLR (channel
, &Available
);
4577 XPROCESS (proc
)->read_output_skip
= 0;
4578 if (XPROCESS (proc
)->read_output_delay
< usecs
)
4579 usecs
= XPROCESS (proc
)->read_output_delay
;
4582 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4583 process_output_skip
= 0;
4587 nfds
= select (max (max (max_process_desc
, max_keyboard_desc
),
4590 #ifdef NON_BLOCKING_CONNECT
4591 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4595 (SELECT_TYPE
*)0, &timeout
);
4600 /* Make C-g and alarm signals set flags again */
4601 clear_waiting_for_input ();
4603 /* If we woke up due to SIGWINCH, actually change size now. */
4604 do_pending_window_change (0);
4606 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4607 /* We wanted the full specified time, so return now. */
4611 if (xerrno
== EINTR
)
4614 /* Ultrix select seems to return ENOMEM when it is
4615 interrupted. Treat it just like EINTR. Bleah. Note
4616 that we want to test for the "ultrix" CPP symbol, not
4617 "__ultrix__"; the latter is only defined under GCC, but
4618 not by DEC's bundled CC. -JimB */
4619 else if (xerrno
== ENOMEM
)
4622 else if (xerrno
== EBADF
)
4625 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4626 the child's closure of the pts gives the parent a SIGHUP, and
4627 the ptc file descriptor is automatically closed,
4628 yielding EBADF here or at select() call above.
4629 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4630 in m/ibmrt-aix.h), and here we just ignore the select error.
4631 Cleanup occurs c/o status_notify after SIGCLD. */
4632 no_avail
= 1; /* Cannot depend on values returned */
4638 error ("select error: %s", emacs_strerror (xerrno
));
4643 FD_ZERO (&Available
);
4644 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4647 #if defined(sun) && !defined(USG5_4)
4648 if (nfds
> 0 && keyboard_bit_set (&Available
)
4650 /* System sometimes fails to deliver SIGIO.
4652 David J. Mackenzie says that Emacs doesn't compile under
4653 Solaris if this code is enabled, thus the USG5_4 in the CPP
4654 conditional. "I haven't noticed any ill effects so far.
4655 If you find a Solaris expert somewhere, they might know
4657 kill (getpid (), SIGIO
);
4660 #if 0 /* When polling is used, interrupt_input is 0,
4661 so get_input_pending should read the input.
4662 So this should not be needed. */
4663 /* If we are using polling for input,
4664 and we see input available, make it get read now.
4665 Otherwise it might not actually get read for a second.
4666 And on hpux, since we turn off polling in wait_reading_process_output,
4667 it might never get read at all if we don't spend much time
4668 outside of wait_reading_process_output. */
4669 if (read_kbd
&& interrupt_input
4670 && keyboard_bit_set (&Available
)
4671 && input_polling_used ())
4672 kill (getpid (), SIGALRM
);
4675 /* Check for keyboard input */
4676 /* If there is any, return immediately
4677 to give it higher priority than subprocesses */
4681 int old_timers_run
= timers_run
;
4682 struct buffer
*old_buffer
= current_buffer
;
4683 Lisp_Object old_window
= selected_window
;
4686 if (detect_input_pending_run_timers (do_display
))
4688 swallow_events (do_display
);
4689 if (detect_input_pending_run_timers (do_display
))
4693 /* If a timer has run, this might have changed buffers
4694 an alike. Make read_key_sequence aware of that. */
4695 if (timers_run
!= old_timers_run
4696 && waiting_for_user_input_p
== -1
4697 && (old_buffer
!= current_buffer
4698 || !EQ (old_window
, selected_window
)))
4699 record_asynch_buffer_change ();
4705 /* If there is unread keyboard input, also return. */
4707 && requeued_events_pending_p ())
4710 /* If we are not checking for keyboard input now,
4711 do process events (but don't run any timers).
4712 This is so that X events will be processed.
4713 Otherwise they may have to wait until polling takes place.
4714 That would causes delays in pasting selections, for example.
4716 (We used to do this only if wait_for_cell.) */
4717 if (read_kbd
== 0 && detect_input_pending ())
4719 swallow_events (do_display
);
4720 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4721 if (detect_input_pending ())
4726 /* Exit now if the cell we're waiting for became non-nil. */
4727 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4731 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4732 go read it. This can happen with X on BSD after logging out.
4733 In that case, there really is no input and no SIGIO,
4734 but select says there is input. */
4736 if (read_kbd
&& interrupt_input
4737 && keyboard_bit_set (&Available
) && ! noninteractive
)
4738 kill (getpid (), SIGIO
);
4742 got_some_input
|= nfds
> 0;
4744 /* If checking input just got us a size-change event from X,
4745 obey it now if we should. */
4746 if (read_kbd
|| ! NILP (wait_for_cell
))
4747 do_pending_window_change (0);
4749 /* Check for data from a process. */
4750 if (no_avail
|| nfds
== 0)
4753 /* Really FIRST_PROC_DESC should be 0 on Unix,
4754 but this is safer in the short run. */
4755 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4757 if (FD_ISSET (channel
, &Available
)
4758 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4762 /* If waiting for this channel, arrange to return as
4763 soon as no more input to be processed. No more
4765 if (wait_channel
== channel
)
4771 proc
= chan_process
[channel
];
4775 /* If this is a server stream socket, accept connection. */
4776 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4778 server_accept_connection (proc
, channel
);
4782 /* Read data from the process, starting with our
4783 buffered-ahead character if we have one. */
4785 nread
= read_process_output (proc
, channel
);
4788 /* Since read_process_output can run a filter,
4789 which can call accept-process-output,
4790 don't try to read from any other processes
4791 before doing the select again. */
4792 FD_ZERO (&Available
);
4795 redisplay_preserve_echo_area (12);
4798 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4801 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4802 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4804 else if (nread
== -1 && errno
== EAGAIN
)
4808 else if (nread
== -1 && errno
== EAGAIN
)
4810 /* Note that we cannot distinguish between no input
4811 available now and a closed pipe.
4812 With luck, a closed pipe will be accompanied by
4813 subprocess termination and SIGCHLD. */
4814 else if (nread
== 0 && !NETCONN_P (proc
))
4816 #endif /* O_NDELAY */
4817 #endif /* O_NONBLOCK */
4819 /* On some OSs with ptys, when the process on one end of
4820 a pty exits, the other end gets an error reading with
4821 errno = EIO instead of getting an EOF (0 bytes read).
4822 Therefore, if we get an error reading and errno =
4823 EIO, just continue, because the child process has
4824 exited and should clean itself up soon (e.g. when we
4827 However, it has been known to happen that the SIGCHLD
4828 got lost. So raise the signal again just in case.
4830 else if (nread
== -1 && errno
== EIO
)
4832 /* Clear the descriptor now, so we only raise the signal once. */
4833 FD_CLR (channel
, &input_wait_mask
);
4834 FD_CLR (channel
, &non_keyboard_wait_mask
);
4836 kill (getpid (), SIGCHLD
);
4838 #endif /* HAVE_PTYS */
4839 /* If we can detect process termination, don't consider the process
4840 gone just because its pipe is closed. */
4842 else if (nread
== 0 && !NETCONN_P (proc
))
4847 /* Preserve status of processes already terminated. */
4848 XPROCESS (proc
)->tick
= ++process_tick
;
4849 deactivate_process (proc
);
4850 if (XPROCESS (proc
)->raw_status_new
)
4851 update_status (XPROCESS (proc
));
4852 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4853 XPROCESS (proc
)->status
4854 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4857 #ifdef NON_BLOCKING_CONNECT
4858 if (check_connect
&& FD_ISSET (channel
, &Connecting
)
4859 && FD_ISSET (channel
, &connect_wait_mask
))
4861 struct Lisp_Process
*p
;
4863 FD_CLR (channel
, &connect_wait_mask
);
4864 if (--num_pending_connects
< 0)
4867 proc
= chan_process
[channel
];
4871 p
= XPROCESS (proc
);
4874 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4875 So only use it on systems where it is known to work. */
4877 int xlen
= sizeof(xerrno
);
4878 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4883 struct sockaddr pname
;
4884 int pnamelen
= sizeof(pname
);
4886 /* If connection failed, getpeername will fail. */
4888 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4890 /* Obtain connect failure code through error slippage. */
4893 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4900 p
->tick
= ++process_tick
;
4901 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4902 deactivate_process (proc
);
4907 /* Execute the sentinel here. If we had relied on
4908 status_notify to do it later, it will read input
4909 from the process before calling the sentinel. */
4910 exec_sentinel (proc
, build_string ("open\n"));
4911 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4913 FD_SET (p
->infd
, &input_wait_mask
);
4914 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
4918 #endif /* NON_BLOCKING_CONNECT */
4919 } /* end for each file descriptor */
4920 } /* end while exit conditions not met */
4922 unbind_to (count
, Qnil
);
4924 /* If calling from keyboard input, do not quit
4925 since we want to return C-g as an input character.
4926 Otherwise, do pending quit if requested. */
4929 /* Prevent input_pending from remaining set if we quit. */
4930 clear_input_pending ();
4933 #ifdef POLL_INTERRUPTED_SYS_CALL
4934 /* AlainF 5-Jul-1996
4935 HP-UX 10.10 seems to have problems with signals coming in
4936 Causes "poll: interrupted system call" messages when Emacs is run
4938 Turn periodic alarms back on */
4940 #endif /* POLL_INTERRUPTED_SYS_CALL */
4942 return got_some_input
;
4945 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4948 read_process_output_call (fun_and_args
)
4949 Lisp_Object fun_and_args
;
4951 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4955 read_process_output_error_handler (error
)
4958 cmd_error_internal (error
, "error in process filter: ");
4960 update_echo_area ();
4961 Fsleep_for (make_number (2), Qnil
);
4965 /* Read pending output from the process channel,
4966 starting with our buffered-ahead character if we have one.
4967 Yield number of decoded characters read.
4969 This function reads at most 4096 characters.
4970 If you want to read all available subprocess output,
4971 you must call it repeatedly until it returns zero.
4973 The characters read are decoded according to PROC's coding-system
4977 read_process_output (proc
, channel
)
4979 register int channel
;
4981 register int nbytes
;
4983 register Lisp_Object outstream
;
4984 register struct buffer
*old
= current_buffer
;
4985 register struct Lisp_Process
*p
= XPROCESS (proc
);
4986 register int opoint
;
4987 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4988 int carryover
= p
->decoding_carryover
;
4992 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4994 vs
= get_vms_process_pointer (p
->pid
);
4998 return (0); /* Really weird if it does this */
4999 if (!(vs
->iosb
[0] & 1))
5000 return -1; /* I/O error */
5003 error ("Could not get VMS process pointer");
5004 chars
= vs
->inputBuffer
;
5005 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
5008 start_vms_process_read (vs
); /* Crank up the next read on the process */
5009 return 1; /* Nothing worth printing, say we got 1 */
5013 /* The data carried over in the previous decoding (which are at
5014 the tail of decoding buffer) should be prepended to the new
5015 data read to decode all together. */
5016 chars
= (char *) alloca (nbytes
+ carryover
);
5017 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
5018 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
5022 chars
= (char *) alloca (carryover
+ readmax
);
5024 /* See the comment above. */
5025 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
5027 #ifdef DATAGRAM_SOCKETS
5028 /* We have a working select, so proc_buffered_char is always -1. */
5029 if (DATAGRAM_CHAN_P (channel
))
5031 int len
= datagram_address
[channel
].len
;
5032 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5033 0, datagram_address
[channel
].sa
, &len
);
5037 if (proc_buffered_char
[channel
] < 0)
5039 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
5040 #ifdef ADAPTIVE_READ_BUFFERING
5041 if (nbytes
> 0 && p
->adaptive_read_buffering
)
5043 int delay
= p
->read_output_delay
;
5046 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5049 process_output_delay_count
++;
5050 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5053 else if (delay
> 0 && (nbytes
== readmax
))
5055 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5057 process_output_delay_count
--;
5059 p
->read_output_delay
= delay
;
5062 p
->read_output_skip
= 1;
5063 process_output_skip
= 1;
5070 chars
[carryover
] = proc_buffered_char
[channel
];
5071 proc_buffered_char
[channel
] = -1;
5072 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
5076 nbytes
= nbytes
+ 1;
5078 #endif /* not VMS */
5080 p
->decoding_carryover
= 0;
5082 /* At this point, NBYTES holds number of bytes just received
5083 (including the one in proc_buffered_char[channel]). */
5086 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5088 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5091 /* Now set NBYTES how many bytes we must decode. */
5092 nbytes
+= carryover
;
5094 /* Read and dispose of the process output. */
5095 outstream
= p
->filter
;
5096 if (!NILP (outstream
))
5098 /* We inhibit quit here instead of just catching it so that
5099 hitting ^G when a filter happens to be running won't screw
5101 int count
= SPECPDL_INDEX ();
5102 Lisp_Object odeactivate
;
5103 Lisp_Object obuffer
, okeymap
;
5105 int outer_running_asynch_code
= running_asynch_code
;
5106 int waiting
= waiting_for_user_input_p
;
5108 /* No need to gcpro these, because all we do with them later
5109 is test them for EQness, and none of them should be a string. */
5110 odeactivate
= Vdeactivate_mark
;
5111 XSETBUFFER (obuffer
, current_buffer
);
5112 okeymap
= current_buffer
->keymap
;
5114 specbind (Qinhibit_quit
, Qt
);
5115 specbind (Qlast_nonmenu_event
, Qt
);
5117 /* In case we get recursively called,
5118 and we already saved the match data nonrecursively,
5119 save the same match data in safely recursive fashion. */
5120 if (outer_running_asynch_code
)
5123 /* Don't clobber the CURRENT match data, either! */
5124 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5125 restore_search_regs ();
5126 record_unwind_save_match_data ();
5127 Fset_match_data (tem
, Qt
);
5130 /* For speed, if a search happens within this code,
5131 save the match data in a special nonrecursive fashion. */
5132 running_asynch_code
= 1;
5134 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
5135 text
= coding
->dst_object
;
5136 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5137 /* A new coding system might be found. */
5138 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5140 p
->decode_coding_system
= Vlast_coding_system_used
;
5142 /* Don't call setup_coding_system for
5143 proc_decode_coding_system[channel] here. It is done in
5144 detect_coding called via decode_coding above. */
5146 /* If a coding system for encoding is not yet decided, we set
5147 it as the same as coding-system for decoding.
5149 But, before doing that we must check if
5150 proc_encode_coding_system[p->outfd] surely points to a
5151 valid memory because p->outfd will be changed once EOF is
5152 sent to the process. */
5153 if (NILP (p
->encode_coding_system
)
5154 && proc_encode_coding_system
[p
->outfd
])
5156 p
->encode_coding_system
5157 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5158 setup_coding_system (p
->encode_coding_system
,
5159 proc_encode_coding_system
[p
->outfd
]);
5163 if (coding
->carryover_bytes
> 0)
5165 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5166 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5167 bcopy (coding
->carryover
, SDATA (p
->decoding_buf
),
5168 coding
->carryover_bytes
);
5169 p
->decoding_carryover
= coding
->carryover_bytes
;
5171 if (SBYTES (text
) > 0)
5172 internal_condition_case_1 (read_process_output_call
,
5174 Fcons (proc
, Fcons (text
, Qnil
))),
5175 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5176 read_process_output_error_handler
);
5178 /* If we saved the match data nonrecursively, restore it now. */
5179 restore_search_regs ();
5180 running_asynch_code
= outer_running_asynch_code
;
5182 /* Handling the process output should not deactivate the mark. */
5183 Vdeactivate_mark
= odeactivate
;
5185 /* Restore waiting_for_user_input_p as it was
5186 when we were called, in case the filter clobbered it. */
5187 waiting_for_user_input_p
= waiting
;
5189 #if 0 /* Call record_asynch_buffer_change unconditionally,
5190 because we might have changed minor modes or other things
5191 that affect key bindings. */
5192 if (! EQ (Fcurrent_buffer (), obuffer
)
5193 || ! EQ (current_buffer
->keymap
, okeymap
))
5195 /* But do it only if the caller is actually going to read events.
5196 Otherwise there's no need to make him wake up, and it could
5197 cause trouble (for example it would make sit_for return). */
5198 if (waiting_for_user_input_p
== -1)
5199 record_asynch_buffer_change ();
5202 start_vms_process_read (vs
);
5204 unbind_to (count
, Qnil
);
5208 /* If no filter, write into buffer if it isn't dead. */
5209 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5211 Lisp_Object old_read_only
;
5212 int old_begv
, old_zv
;
5213 int old_begv_byte
, old_zv_byte
;
5214 Lisp_Object odeactivate
;
5215 int before
, before_byte
;
5220 odeactivate
= Vdeactivate_mark
;
5222 Fset_buffer (p
->buffer
);
5224 opoint_byte
= PT_BYTE
;
5225 old_read_only
= current_buffer
->read_only
;
5228 old_begv_byte
= BEGV_BYTE
;
5229 old_zv_byte
= ZV_BYTE
;
5231 current_buffer
->read_only
= Qnil
;
5233 /* Insert new output into buffer
5234 at the current end-of-output marker,
5235 thus preserving logical ordering of input and output. */
5236 if (XMARKER (p
->mark
)->buffer
)
5237 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5238 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5241 SET_PT_BOTH (ZV
, ZV_BYTE
);
5243 before_byte
= PT_BYTE
;
5245 /* If the output marker is outside of the visible region, save
5246 the restriction and widen. */
5247 if (! (BEGV
<= PT
&& PT
<= ZV
))
5250 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
5251 text
= coding
->dst_object
;
5252 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5253 /* A new coding system might be found. See the comment in the
5254 similar code in the previous `if' block. */
5255 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5257 p
->decode_coding_system
= Vlast_coding_system_used
;
5258 if (NILP (p
->encode_coding_system
)
5259 && proc_encode_coding_system
[p
->outfd
])
5261 p
->encode_coding_system
5262 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5263 setup_coding_system (p
->encode_coding_system
,
5264 proc_encode_coding_system
[p
->outfd
]);
5267 if (coding
->carryover_bytes
> 0)
5269 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5270 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5271 bcopy (coding
->carryover
, SDATA (p
->decoding_buf
),
5272 coding
->carryover_bytes
);
5273 p
->decoding_carryover
= coding
->carryover_bytes
;
5275 /* Adjust the multibyteness of TEXT to that of the buffer. */
5276 if (NILP (current_buffer
->enable_multibyte_characters
)
5277 != ! STRING_MULTIBYTE (text
))
5278 text
= (STRING_MULTIBYTE (text
)
5279 ? Fstring_as_unibyte (text
)
5280 : Fstring_to_multibyte (text
));
5281 /* Insert before markers in case we are inserting where
5282 the buffer's mark is, and the user's next command is Meta-y. */
5283 insert_from_string_before_markers (text
, 0, 0,
5284 SCHARS (text
), SBYTES (text
), 0);
5286 /* Make sure the process marker's position is valid when the
5287 process buffer is changed in the signal_after_change above.
5288 W3 is known to do that. */
5289 if (BUFFERP (p
->buffer
)
5290 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5291 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5293 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5295 update_mode_lines
++;
5297 /* Make sure opoint and the old restrictions
5298 float ahead of any new text just as point would. */
5299 if (opoint
>= before
)
5301 opoint
+= PT
- before
;
5302 opoint_byte
+= PT_BYTE
- before_byte
;
5304 if (old_begv
> before
)
5306 old_begv
+= PT
- before
;
5307 old_begv_byte
+= PT_BYTE
- before_byte
;
5309 if (old_zv
>= before
)
5311 old_zv
+= PT
- before
;
5312 old_zv_byte
+= PT_BYTE
- before_byte
;
5315 /* If the restriction isn't what it should be, set it. */
5316 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5317 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5319 /* Handling the process output should not deactivate the mark. */
5320 Vdeactivate_mark
= odeactivate
;
5322 current_buffer
->read_only
= old_read_only
;
5323 SET_PT_BOTH (opoint
, opoint_byte
);
5324 set_buffer_internal (old
);
5327 start_vms_process_read (vs
);
5332 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5334 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5335 This is intended for use by asynchronous process output filters and sentinels. */)
5338 return (waiting_for_user_input_p
? Qt
: Qnil
);
5341 /* Sending data to subprocess */
5343 jmp_buf send_process_frame
;
5344 Lisp_Object process_sent_to
;
5347 send_process_trap ()
5349 SIGNAL_THREAD_CHECK (SIGPIPE
);
5354 sigunblock (sigmask (SIGPIPE
));
5355 longjmp (send_process_frame
, 1);
5358 /* Send some data to process PROC.
5359 BUF is the beginning of the data; LEN is the number of characters.
5360 OBJECT is the Lisp object that the data comes from. If OBJECT is
5361 nil or t, it means that the data comes from C string.
5363 If OBJECT is not nil, the data is encoded by PROC's coding-system
5364 for encoding before it is sent.
5366 This function can evaluate Lisp code and can garbage collect. */
5369 send_process (proc
, buf
, len
, object
)
5370 volatile Lisp_Object proc
;
5371 unsigned char *volatile buf
;
5373 volatile Lisp_Object object
;
5375 /* Use volatile to protect variables from being clobbered by longjmp. */
5376 struct Lisp_Process
*p
= XPROCESS (proc
);
5378 struct coding_system
*coding
;
5379 struct gcpro gcpro1
;
5380 SIGTYPE (*volatile old_sigpipe
) ();
5385 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5388 if (p
->raw_status_new
)
5390 if (! EQ (p
->status
, Qrun
))
5391 error ("Process %s not running", SDATA (p
->name
));
5393 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5395 coding
= proc_encode_coding_system
[p
->outfd
];
5396 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5398 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5399 || (BUFFERP (object
)
5400 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5403 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
5404 /* The coding system for encoding was changed to raw-text
5405 because we sent a unibyte text previously. Now we are
5406 sending a multibyte text, thus we must encode it by the
5407 original coding system specified for the current process. */
5408 setup_coding_system (p
->encode_coding_system
, coding
);
5409 coding
->src_multibyte
= 1;
5413 /* For sending a unibyte text, character code conversion should
5414 not take place but EOL conversion should. So, setup raw-text
5415 or one of the subsidiary if we have not yet done it. */
5416 if (CODING_REQUIRE_ENCODING (coding
))
5418 if (CODING_REQUIRE_FLUSHING (coding
))
5420 /* But, before changing the coding, we must flush out data. */
5421 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5422 send_process (proc
, "", 0, Qt
);
5423 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
5425 setup_coding_system (raw_text_coding_system
5426 (Vlast_coding_system_used
),
5428 coding
->src_multibyte
= 0;
5431 coding
->dst_multibyte
= 0;
5433 if (CODING_REQUIRE_ENCODING (coding
))
5435 coding
->dst_object
= Qt
;
5436 if (BUFFERP (object
))
5438 int from_byte
, from
, to
;
5439 int save_pt
, save_pt_byte
;
5440 struct buffer
*cur
= current_buffer
;
5442 set_buffer_internal (XBUFFER (object
));
5443 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
5445 from_byte
= PTR_BYTE_POS (buf
);
5446 from
= BYTE_TO_CHAR (from_byte
);
5447 to
= BYTE_TO_CHAR (from_byte
+ len
);
5448 TEMP_SET_PT_BOTH (from
, from_byte
);
5449 encode_coding_object (coding
, object
, from
, from_byte
,
5450 to
, from_byte
+ len
, Qt
);
5451 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
5452 set_buffer_internal (cur
);
5454 else if (STRINGP (object
))
5456 encode_coding_string (coding
, object
, 1);
5460 coding
->dst_object
= make_unibyte_string (buf
, len
);
5461 coding
->produced
= len
;
5464 len
= coding
->produced
;
5465 buf
= SDATA (coding
->dst_object
);
5469 vs
= get_vms_process_pointer (p
->pid
);
5471 error ("Could not find this process: %x", p
->pid
);
5472 else if (write_to_vms_process (vs
, buf
, len
))
5476 if (pty_max_bytes
== 0)
5478 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5479 pty_max_bytes
= fpathconf (p
->outfd
, _PC_MAX_CANON
);
5480 if (pty_max_bytes
< 0)
5481 pty_max_bytes
= 250;
5483 pty_max_bytes
= 250;
5485 /* Deduct one, to leave space for the eof. */
5489 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5490 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5491 when returning with longjmp despite being declared volatile. */
5492 if (!setjmp (send_process_frame
))
5494 process_sent_to
= proc
;
5499 /* Decide how much data we can send in one batch.
5500 Long lines need to be split into multiple batches. */
5503 /* Starting this at zero is always correct when not the first
5504 iteration because the previous iteration ended by sending C-d.
5505 It may not be correct for the first iteration
5506 if a partial line was sent in a separate send_process call.
5507 If that proves worth handling, we need to save linepos
5508 in the process object. */
5510 unsigned char *ptr
= (unsigned char *) buf
;
5511 unsigned char *end
= (unsigned char *) buf
+ len
;
5513 /* Scan through this text for a line that is too long. */
5514 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5522 /* If we found one, break the line there
5523 and put in a C-d to force the buffer through. */
5527 /* Send this batch, using one or more write calls. */
5530 int outfd
= p
->outfd
;
5531 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5532 #ifdef DATAGRAM_SOCKETS
5533 if (DATAGRAM_CHAN_P (outfd
))
5535 rv
= sendto (outfd
, (char *) buf
, this,
5536 0, datagram_address
[outfd
].sa
,
5537 datagram_address
[outfd
].len
);
5538 if (rv
< 0 && errno
== EMSGSIZE
)
5540 signal (SIGPIPE
, old_sigpipe
);
5541 report_file_error ("sending datagram",
5542 Fcons (proc
, Qnil
));
5548 rv
= emacs_write (outfd
, (char *) buf
, this);
5549 #ifdef ADAPTIVE_READ_BUFFERING
5550 if (p
->read_output_delay
> 0
5551 && p
->adaptive_read_buffering
== 1)
5553 p
->read_output_delay
= 0;
5554 process_output_delay_count
--;
5555 p
->read_output_skip
= 0;
5559 signal (SIGPIPE
, old_sigpipe
);
5565 || errno
== EWOULDBLOCK
5571 /* Buffer is full. Wait, accepting input;
5572 that may allow the program
5573 to finish doing output and read more. */
5577 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5578 /* A gross hack to work around a bug in FreeBSD.
5579 In the following sequence, read(2) returns
5583 write(2) 954 bytes, get EAGAIN
5584 read(2) 1024 bytes in process_read_output
5585 read(2) 11 bytes in process_read_output
5587 That is, read(2) returns more bytes than have
5588 ever been written successfully. The 1033 bytes
5589 read are the 1022 bytes written successfully
5590 after processing (for example with CRs added if
5591 the terminal is set up that way which it is
5592 here). The same bytes will be seen again in a
5593 later read(2), without the CRs. */
5595 if (errno
== EAGAIN
)
5598 ioctl (p
->outfd
, TIOCFLUSH
, &flags
);
5600 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5602 /* Running filters might relocate buffers or strings.
5603 Arrange to relocate BUF. */
5604 if (BUFFERP (object
))
5605 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5606 else if (STRINGP (object
))
5607 offset
= buf
- SDATA (object
);
5609 #ifdef EMACS_HAS_USECS
5610 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5612 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5615 if (BUFFERP (object
))
5616 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5617 else if (STRINGP (object
))
5618 buf
= offset
+ SDATA (object
);
5623 /* This is a real error. */
5624 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5631 /* If we sent just part of the string, put in an EOF
5632 to force it through, before we send the rest. */
5634 Fprocess_send_eof (proc
);
5637 #endif /* not VMS */
5640 signal (SIGPIPE
, old_sigpipe
);
5642 proc
= process_sent_to
;
5643 p
= XPROCESS (proc
);
5645 p
->raw_status_new
= 0;
5646 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5647 p
->tick
= ++process_tick
;
5648 deactivate_process (proc
);
5650 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5652 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5659 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5661 doc
: /* Send current contents of region as input to PROCESS.
5662 PROCESS may be a process, a buffer, the name of a process or buffer, or
5663 nil, indicating the current buffer's process.
5664 Called from program, takes three arguments, PROCESS, START and END.
5665 If the region is more than 500 characters long,
5666 it is sent in several bunches. This may happen even for shorter regions.
5667 Output from processes can arrive in between bunches. */)
5668 (process
, start
, end
)
5669 Lisp_Object process
, start
, end
;
5674 proc
= get_process (process
);
5675 validate_region (&start
, &end
);
5677 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5678 move_gap (XINT (start
));
5680 start1
= CHAR_TO_BYTE (XINT (start
));
5681 end1
= CHAR_TO_BYTE (XINT (end
));
5682 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5683 Fcurrent_buffer ());
5688 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5690 doc
: /* Send PROCESS the contents of STRING as input.
5691 PROCESS may be a process, a buffer, the name of a process or buffer, or
5692 nil, indicating the current buffer's process.
5693 If STRING is more than 500 characters long,
5694 it is sent in several bunches. This may happen even for shorter strings.
5695 Output from processes can arrive in between bunches. */)
5697 Lisp_Object process
, string
;
5700 CHECK_STRING (string
);
5701 proc
= get_process (process
);
5702 send_process (proc
, SDATA (string
),
5703 SBYTES (string
), string
);
5707 /* Return the foreground process group for the tty/pty that
5708 the process P uses. */
5710 emacs_get_tty_pgrp (p
)
5711 struct Lisp_Process
*p
;
5716 if (ioctl (p
->infd
, TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5719 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5720 master side. Try the slave side. */
5721 fd
= emacs_open (SDATA (p
->tty_name
), O_RDONLY
, 0);
5725 ioctl (fd
, TIOCGPGRP
, &gid
);
5729 #endif /* defined (TIOCGPGRP ) */
5734 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5735 Sprocess_running_child_p
, 0, 1, 0,
5736 doc
: /* Return t if PROCESS has given the terminal to a child.
5737 If the operating system does not make it possible to find out,
5738 return t unconditionally. */)
5740 Lisp_Object process
;
5742 /* Initialize in case ioctl doesn't exist or gives an error,
5743 in a way that will cause returning t. */
5746 struct Lisp_Process
*p
;
5748 proc
= get_process (process
);
5749 p
= XPROCESS (proc
);
5751 if (!EQ (p
->childp
, Qt
))
5752 error ("Process %s is not a subprocess",
5755 error ("Process %s is not active",
5758 gid
= emacs_get_tty_pgrp (p
);
5765 /* send a signal number SIGNO to PROCESS.
5766 If CURRENT_GROUP is t, that means send to the process group
5767 that currently owns the terminal being used to communicate with PROCESS.
5768 This is used for various commands in shell mode.
5769 If CURRENT_GROUP is lambda, that means send to the process group
5770 that currently owns the terminal, but only if it is NOT the shell itself.
5772 If NOMSG is zero, insert signal-announcements into process's buffers
5775 If we can, we try to signal PROCESS by sending control characters
5776 down the pty. This allows us to signal inferiors who have changed
5777 their uid, for which killpg would return an EPERM error. */
5780 process_send_signal (process
, signo
, current_group
, nomsg
)
5781 Lisp_Object process
;
5783 Lisp_Object current_group
;
5787 register struct Lisp_Process
*p
;
5791 proc
= get_process (process
);
5792 p
= XPROCESS (proc
);
5794 if (!EQ (p
->childp
, Qt
))
5795 error ("Process %s is not a subprocess",
5798 error ("Process %s is not active",
5802 current_group
= Qnil
;
5804 /* If we are using pgrps, get a pgrp number and make it negative. */
5805 if (NILP (current_group
))
5806 /* Send the signal to the shell's process group. */
5810 #ifdef SIGNALS_VIA_CHARACTERS
5811 /* If possible, send signals to the entire pgrp
5812 by sending an input character to it. */
5814 /* TERMIOS is the latest and bestest, and seems most likely to
5815 work. If the system has it, use it. */
5818 cc_t
*sig_char
= NULL
;
5820 tcgetattr (p
->infd
, &t
);
5825 sig_char
= &t
.c_cc
[VINTR
];
5829 sig_char
= &t
.c_cc
[VQUIT
];
5833 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5834 sig_char
= &t
.c_cc
[VSWTCH
];
5836 sig_char
= &t
.c_cc
[VSUSP
];
5841 if (sig_char
&& *sig_char
!= CDISABLE
)
5843 send_process (proc
, sig_char
, 1, Qnil
);
5846 /* If we can't send the signal with a character,
5847 fall through and send it another way. */
5848 #else /* ! HAVE_TERMIOS */
5850 /* On Berkeley descendants, the following IOCTL's retrieve the
5851 current control characters. */
5852 #if defined (TIOCGLTC) && defined (TIOCGETC)
5860 ioctl (p
->infd
, TIOCGETC
, &c
);
5861 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5864 ioctl (p
->infd
, TIOCGETC
, &c
);
5865 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5869 ioctl (p
->infd
, TIOCGLTC
, &lc
);
5870 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5872 #endif /* ! defined (SIGTSTP) */
5875 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5877 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5884 ioctl (p
->infd
, TCGETA
, &t
);
5885 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5888 ioctl (p
->infd
, TCGETA
, &t
);
5889 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5893 ioctl (p
->infd
, TCGETA
, &t
);
5894 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5896 #endif /* ! defined (SIGTSTP) */
5898 #else /* ! defined (TCGETA) */
5899 Your configuration files are messed up
.
5900 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5901 you'd better be using one of the alternatives above! */
5902 #endif /* ! defined (TCGETA) */
5903 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5904 /* In this case, the code above should alway return. */
5906 #endif /* ! defined HAVE_TERMIOS */
5908 /* The code above may fall through if it can't
5909 handle the signal. */
5910 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5913 /* Get the current pgrp using the tty itself, if we have that.
5914 Otherwise, use the pty to get the pgrp.
5915 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5916 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5917 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5918 His patch indicates that if TIOCGPGRP returns an error, then
5919 we should just assume that p->pid is also the process group id. */
5921 gid
= emacs_get_tty_pgrp (p
);
5924 /* If we can't get the information, assume
5925 the shell owns the tty. */
5928 /* It is not clear whether anything really can set GID to -1.
5929 Perhaps on some system one of those ioctls can or could do so.
5930 Or perhaps this is vestigial. */
5933 #else /* ! defined (TIOCGPGRP ) */
5934 /* Can't select pgrps on this system, so we know that
5935 the child itself heads the pgrp. */
5937 #endif /* ! defined (TIOCGPGRP ) */
5939 /* If current_group is lambda, and the shell owns the terminal,
5940 don't send any signal. */
5941 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
5949 p
->raw_status_new
= 0;
5951 p
->tick
= ++process_tick
;
5953 status_notify (NULL
);
5955 #endif /* ! defined (SIGCONT) */
5958 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5963 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5968 sys$
forcex (&(p
->pid
), 0, 1);
5971 flush_pending_output (p
->infd
);
5975 /* If we don't have process groups, send the signal to the immediate
5976 subprocess. That isn't really right, but it's better than any
5977 obvious alternative. */
5980 kill (p
->pid
, signo
);
5984 /* gid may be a pid, or minus a pgrp's number */
5986 if (!NILP (current_group
))
5988 if (ioctl (p
->infd
, TIOCSIGSEND
, signo
) == -1)
5989 EMACS_KILLPG (gid
, signo
);
5996 #else /* ! defined (TIOCSIGSEND) */
5997 EMACS_KILLPG (gid
, signo
);
5998 #endif /* ! defined (TIOCSIGSEND) */
6001 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
6002 doc
: /* Interrupt process PROCESS.
6003 PROCESS may be a process, a buffer, or the name of a process or buffer.
6004 No arg or nil means current buffer's process.
6005 Second arg CURRENT-GROUP non-nil means send signal to
6006 the current process-group of the process's controlling terminal
6007 rather than to the process's own process group.
6008 If the process is a shell, this means interrupt current subjob
6009 rather than the shell.
6011 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6012 don't send the signal. */)
6013 (process
, current_group
)
6014 Lisp_Object process
, current_group
;
6016 process_send_signal (process
, SIGINT
, current_group
, 0);
6020 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
6021 doc
: /* Kill process PROCESS. May be process or name of one.
6022 See function `interrupt-process' for more details on usage. */)
6023 (process
, current_group
)
6024 Lisp_Object process
, current_group
;
6026 process_send_signal (process
, SIGKILL
, current_group
, 0);
6030 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
6031 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
6032 See function `interrupt-process' for more details on usage. */)
6033 (process
, current_group
)
6034 Lisp_Object process
, current_group
;
6036 process_send_signal (process
, SIGQUIT
, current_group
, 0);
6040 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
6041 doc
: /* Stop process PROCESS. May be process or name of one.
6042 See function `interrupt-process' for more details on usage.
6043 If PROCESS is a network process, inhibit handling of incoming traffic. */)
6044 (process
, current_group
)
6045 Lisp_Object process
, current_group
;
6048 if (PROCESSP (process
) && NETCONN_P (process
))
6050 struct Lisp_Process
*p
;
6052 p
= XPROCESS (process
);
6053 if (NILP (p
->command
)
6056 FD_CLR (p
->infd
, &input_wait_mask
);
6057 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6064 error ("No SIGTSTP support");
6066 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6071 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6072 doc
: /* Continue process PROCESS. May be process or name of one.
6073 See function `interrupt-process' for more details on usage.
6074 If PROCESS is a network process, resume handling of incoming traffic. */)
6075 (process
, current_group
)
6076 Lisp_Object process
, current_group
;
6079 if (PROCESSP (process
) && NETCONN_P (process
))
6081 struct Lisp_Process
*p
;
6083 p
= XPROCESS (process
);
6084 if (EQ (p
->command
, Qt
)
6086 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6088 FD_SET (p
->infd
, &input_wait_mask
);
6089 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
6096 process_send_signal (process
, SIGCONT
, current_group
, 0);
6098 error ("No SIGCONT support");
6103 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6104 2, 2, "sProcess (name or number): \nnSignal code: ",
6105 doc
: /* Send PROCESS the signal with code SIGCODE.
6106 PROCESS may also be a number specifying the process id of the
6107 process to signal; in this case, the process need not be a child of
6109 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6111 Lisp_Object process
, sigcode
;
6115 if (INTEGERP (process
))
6117 pid
= XINT (process
);
6121 if (FLOATP (process
))
6123 pid
= (pid_t
) XFLOAT_DATA (process
);
6127 if (STRINGP (process
))
6130 if (tem
= Fget_process (process
), NILP (tem
))
6132 pid
= XINT (Fstring_to_number (process
, make_number (10)));
6139 process
= get_process (process
);
6144 CHECK_PROCESS (process
);
6145 pid
= XPROCESS (process
)->pid
;
6147 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6151 #define parse_signal(NAME, VALUE) \
6152 else if (!xstrcasecmp (name, NAME)) \
6153 XSETINT (sigcode, VALUE)
6155 if (INTEGERP (sigcode
))
6159 unsigned char *name
;
6161 CHECK_SYMBOL (sigcode
);
6162 name
= SDATA (SYMBOL_NAME (sigcode
));
6164 if (!strncmp(name
, "SIG", 3) || !strncmp(name
, "sig", 3))
6170 parse_signal ("usr1", SIGUSR1
);
6173 parse_signal ("usr2", SIGUSR2
);
6176 parse_signal ("term", SIGTERM
);
6179 parse_signal ("hup", SIGHUP
);
6182 parse_signal ("int", SIGINT
);
6185 parse_signal ("quit", SIGQUIT
);
6188 parse_signal ("ill", SIGILL
);
6191 parse_signal ("abrt", SIGABRT
);
6194 parse_signal ("emt", SIGEMT
);
6197 parse_signal ("kill", SIGKILL
);
6200 parse_signal ("fpe", SIGFPE
);
6203 parse_signal ("bus", SIGBUS
);
6206 parse_signal ("segv", SIGSEGV
);
6209 parse_signal ("sys", SIGSYS
);
6212 parse_signal ("pipe", SIGPIPE
);
6215 parse_signal ("alrm", SIGALRM
);
6218 parse_signal ("urg", SIGURG
);
6221 parse_signal ("stop", SIGSTOP
);
6224 parse_signal ("tstp", SIGTSTP
);
6227 parse_signal ("cont", SIGCONT
);
6230 parse_signal ("chld", SIGCHLD
);
6233 parse_signal ("ttin", SIGTTIN
);
6236 parse_signal ("ttou", SIGTTOU
);
6239 parse_signal ("io", SIGIO
);
6242 parse_signal ("xcpu", SIGXCPU
);
6245 parse_signal ("xfsz", SIGXFSZ
);
6248 parse_signal ("vtalrm", SIGVTALRM
);
6251 parse_signal ("prof", SIGPROF
);
6254 parse_signal ("winch", SIGWINCH
);
6257 parse_signal ("info", SIGINFO
);
6260 error ("Undefined signal name %s", name
);
6265 return make_number (kill (pid
, XINT (sigcode
)));
6268 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6269 doc
: /* Make PROCESS see end-of-file in its input.
6270 EOF comes after any text already sent to it.
6271 PROCESS may be a process, a buffer, the name of a process or buffer, or
6272 nil, indicating the current buffer's process.
6273 If PROCESS is a network connection, or is a process communicating
6274 through a pipe (as opposed to a pty), then you cannot send any more
6275 text to PROCESS after you call this function. */)
6277 Lisp_Object process
;
6280 struct coding_system
*coding
;
6282 if (DATAGRAM_CONN_P (process
))
6285 proc
= get_process (process
);
6286 coding
= proc_encode_coding_system
[XPROCESS (proc
)->outfd
];
6288 /* Make sure the process is really alive. */
6289 if (XPROCESS (proc
)->raw_status_new
)
6290 update_status (XPROCESS (proc
));
6291 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6292 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6294 if (CODING_REQUIRE_FLUSHING (coding
))
6296 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6297 send_process (proc
, "", 0, Qnil
);
6301 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6303 if (XPROCESS (proc
)->pty_flag
)
6304 send_process (proc
, "\004", 1, Qnil
);
6307 int old_outfd
, new_outfd
;
6309 #ifdef HAVE_SHUTDOWN
6310 /* If this is a network connection, or socketpair is used
6311 for communication with the subprocess, call shutdown to cause EOF.
6312 (In some old system, shutdown to socketpair doesn't work.
6313 Then we just can't win.) */
6314 if (XPROCESS (proc
)->pid
== 0
6315 || XPROCESS (proc
)->outfd
== XPROCESS (proc
)->infd
)
6316 shutdown (XPROCESS (proc
)->outfd
, 1);
6317 /* In case of socketpair, outfd == infd, so don't close it. */
6318 if (XPROCESS (proc
)->outfd
!= XPROCESS (proc
)->infd
)
6319 emacs_close (XPROCESS (proc
)->outfd
);
6320 #else /* not HAVE_SHUTDOWN */
6321 emacs_close (XPROCESS (proc
)->outfd
);
6322 #endif /* not HAVE_SHUTDOWN */
6323 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6326 old_outfd
= XPROCESS (proc
)->outfd
;
6328 if (!proc_encode_coding_system
[new_outfd
])
6329 proc_encode_coding_system
[new_outfd
]
6330 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6331 bcopy (proc_encode_coding_system
[old_outfd
],
6332 proc_encode_coding_system
[new_outfd
],
6333 sizeof (struct coding_system
));
6334 bzero (proc_encode_coding_system
[old_outfd
],
6335 sizeof (struct coding_system
));
6337 XPROCESS (proc
)->outfd
= new_outfd
;
6343 /* Kill all processes associated with `buffer'.
6344 If `buffer' is nil, kill all processes */
6347 kill_buffer_processes (buffer
)
6350 Lisp_Object tail
, proc
;
6352 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6354 proc
= XCDR (XCAR (tail
));
6356 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6358 if (NETCONN_P (proc
))
6359 Fdelete_process (proc
);
6360 else if (XPROCESS (proc
)->infd
>= 0)
6361 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6366 /* On receipt of a signal that a child status has changed, loop asking
6367 about children with changed statuses until the system says there
6370 All we do is change the status; we do not run sentinels or print
6371 notifications. That is saved for the next time keyboard input is
6372 done, in order to avoid timing errors.
6374 ** WARNING: this can be called during garbage collection.
6375 Therefore, it must not be fooled by the presence of mark bits in
6378 ** USG WARNING: Although it is not obvious from the documentation
6379 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6380 signal() before executing at least one wait(), otherwise the
6381 handler will be called again, resulting in an infinite loop. The
6382 relevant portion of the documentation reads "SIGCLD signals will be
6383 queued and the signal-catching function will be continually
6384 reentered until the queue is empty". Invoking signal() causes the
6385 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6388 ** Malloc WARNING: This should never call malloc either directly or
6389 indirectly; if it does, that is a bug */
6393 sigchld_handler (signo
)
6396 int old_errno
= errno
;
6398 register struct Lisp_Process
*p
;
6399 extern EMACS_TIME
*input_available_clear_time
;
6401 SIGNAL_THREAD_CHECK (signo
);
6405 sigheld
|= sigbit (SIGCHLD
);
6417 #endif /* no WUNTRACED */
6418 /* Keep trying to get a status until we get a definitive result. */
6422 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6424 while (pid
< 0 && errno
== EINTR
);
6428 /* PID == 0 means no processes found, PID == -1 means a real
6429 failure. We have done all our job, so return. */
6431 /* USG systems forget handlers when they are used;
6432 must reestablish each time */
6433 #if defined (USG) && !defined (POSIX_SIGNALS)
6434 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6437 sigheld
&= ~sigbit (SIGCHLD
);
6445 #endif /* no WNOHANG */
6447 /* Find the process that signaled us, and record its status. */
6449 /* The process can have been deleted by Fdelete_process. */
6450 for (tail
= deleted_pid_list
; CONSP (tail
); tail
= XCDR (tail
))
6452 Lisp_Object xpid
= XCAR (tail
);
6453 if ((INTEGERP (xpid
) && pid
== (pid_t
) XINT (xpid
))
6454 || (FLOATP (xpid
) && pid
== (pid_t
) XFLOAT_DATA (xpid
)))
6456 XSETCAR (tail
, Qnil
);
6457 goto sigchld_end_of_loop
;
6461 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6463 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6465 proc
= XCDR (XCAR (tail
));
6466 p
= XPROCESS (proc
);
6467 if (EQ (p
->childp
, Qt
) && p
->pid
== pid
)
6472 /* Look for an asynchronous process whose pid hasn't been filled
6475 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6477 proc
= XCDR (XCAR (tail
));
6478 p
= XPROCESS (proc
);
6484 /* Change the status of the process that was found. */
6487 union { int i
; WAITTYPE wt
; } u
;
6488 int clear_desc_flag
= 0;
6490 p
->tick
= ++process_tick
;
6492 p
->raw_status
= u
.i
;
6493 p
->raw_status_new
= 1;
6495 /* If process has terminated, stop waiting for its output. */
6496 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6498 clear_desc_flag
= 1;
6500 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6501 if (clear_desc_flag
)
6503 FD_CLR (p
->infd
, &input_wait_mask
);
6504 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6507 /* Tell wait_reading_process_output that it needs to wake up and
6509 if (input_available_clear_time
)
6510 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6513 /* There was no asynchronous process found for that pid: we have
6514 a synchronous process. */
6517 synch_process_alive
= 0;
6519 /* Report the status of the synchronous process. */
6521 synch_process_retcode
= WRETCODE (w
);
6522 else if (WIFSIGNALED (w
))
6523 synch_process_termsig
= WTERMSIG (w
);
6525 /* Tell wait_reading_process_output that it needs to wake up and
6527 if (input_available_clear_time
)
6528 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6531 sigchld_end_of_loop
:
6534 /* On some systems, we must return right away.
6535 If any more processes want to signal us, we will
6537 Otherwise (on systems that have WNOHANG), loop around
6538 to use up all the processes that have something to tell us. */
6539 #if (defined WINDOWSNT \
6540 || (defined USG && !defined GNU_LINUX \
6541 && !(defined HPUX && defined WNOHANG)))
6542 #if defined (USG) && ! defined (POSIX_SIGNALS)
6543 signal (signo
, sigchld_handler
);
6547 #endif /* USG, but not HPUX with WNOHANG */
6550 #endif /* SIGCHLD */
6554 exec_sentinel_unwind (data
)
6557 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6562 exec_sentinel_error_handler (error
)
6565 cmd_error_internal (error
, "error in process sentinel: ");
6567 update_echo_area ();
6568 Fsleep_for (make_number (2), Qnil
);
6573 exec_sentinel (proc
, reason
)
6574 Lisp_Object proc
, reason
;
6576 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6577 register struct Lisp_Process
*p
= XPROCESS (proc
);
6578 int count
= SPECPDL_INDEX ();
6579 int outer_running_asynch_code
= running_asynch_code
;
6580 int waiting
= waiting_for_user_input_p
;
6582 if (inhibit_sentinels
)
6585 /* No need to gcpro these, because all we do with them later
6586 is test them for EQness, and none of them should be a string. */
6587 odeactivate
= Vdeactivate_mark
;
6588 XSETBUFFER (obuffer
, current_buffer
);
6589 okeymap
= current_buffer
->keymap
;
6591 sentinel
= p
->sentinel
;
6592 if (NILP (sentinel
))
6595 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6596 assure that it gets restored no matter how the sentinel exits. */
6598 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6599 /* Inhibit quit so that random quits don't screw up a running filter. */
6600 specbind (Qinhibit_quit
, Qt
);
6601 specbind (Qlast_nonmenu_event
, Qt
);
6603 /* In case we get recursively called,
6604 and we already saved the match data nonrecursively,
6605 save the same match data in safely recursive fashion. */
6606 if (outer_running_asynch_code
)
6609 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6610 restore_search_regs ();
6611 record_unwind_save_match_data ();
6612 Fset_match_data (tem
, Qt
);
6615 /* For speed, if a search happens within this code,
6616 save the match data in a special nonrecursive fashion. */
6617 running_asynch_code
= 1;
6619 internal_condition_case_1 (read_process_output_call
,
6621 Fcons (proc
, Fcons (reason
, Qnil
))),
6622 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6623 exec_sentinel_error_handler
);
6625 /* If we saved the match data nonrecursively, restore it now. */
6626 restore_search_regs ();
6627 running_asynch_code
= outer_running_asynch_code
;
6629 Vdeactivate_mark
= odeactivate
;
6631 /* Restore waiting_for_user_input_p as it was
6632 when we were called, in case the filter clobbered it. */
6633 waiting_for_user_input_p
= waiting
;
6636 if (! EQ (Fcurrent_buffer (), obuffer
)
6637 || ! EQ (current_buffer
->keymap
, okeymap
))
6639 /* But do it only if the caller is actually going to read events.
6640 Otherwise there's no need to make him wake up, and it could
6641 cause trouble (for example it would make sit_for return). */
6642 if (waiting_for_user_input_p
== -1)
6643 record_asynch_buffer_change ();
6645 unbind_to (count
, Qnil
);
6648 /* Report all recent events of a change in process status
6649 (either run the sentinel or output a message).
6650 This is usually done while Emacs is waiting for keyboard input
6651 but can be done at other times. */
6654 status_notify (deleting_process
)
6655 struct Lisp_Process
*deleting_process
;
6657 register Lisp_Object proc
, buffer
;
6658 Lisp_Object tail
, msg
;
6659 struct gcpro gcpro1
, gcpro2
;
6663 /* We need to gcpro tail; if read_process_output calls a filter
6664 which deletes a process and removes the cons to which tail points
6665 from Vprocess_alist, and then causes a GC, tail is an unprotected
6669 /* Set this now, so that if new processes are created by sentinels
6670 that we run, we get called again to handle their status changes. */
6671 update_tick
= process_tick
;
6673 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6676 register struct Lisp_Process
*p
;
6678 proc
= Fcdr (XCAR (tail
));
6679 p
= XPROCESS (proc
);
6681 if (p
->tick
!= p
->update_tick
)
6683 p
->update_tick
= p
->tick
;
6685 /* If process is still active, read any output that remains. */
6686 while (! EQ (p
->filter
, Qt
)
6687 && ! EQ (p
->status
, Qconnect
)
6688 && ! EQ (p
->status
, Qlisten
)
6689 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6691 && p
!= deleting_process
6692 && read_process_output (proc
, p
->infd
) > 0);
6696 /* Get the text to use for the message. */
6697 if (p
->raw_status_new
)
6699 msg
= status_message (p
);
6701 /* If process is terminated, deactivate it or delete it. */
6703 if (CONSP (p
->status
))
6704 symbol
= XCAR (p
->status
);
6706 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6707 || EQ (symbol
, Qclosed
))
6709 if (delete_exited_processes
)
6710 remove_process (proc
);
6712 deactivate_process (proc
);
6715 /* The actions above may have further incremented p->tick.
6716 So set p->update_tick again
6717 so that an error in the sentinel will not cause
6718 this code to be run again. */
6719 p
->update_tick
= p
->tick
;
6720 /* Now output the message suitably. */
6721 if (!NILP (p
->sentinel
))
6722 exec_sentinel (proc
, msg
);
6723 /* Don't bother with a message in the buffer
6724 when a process becomes runnable. */
6725 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6727 Lisp_Object ro
, tem
;
6728 struct buffer
*old
= current_buffer
;
6729 int opoint
, opoint_byte
;
6730 int before
, before_byte
;
6732 ro
= XBUFFER (buffer
)->read_only
;
6734 /* Avoid error if buffer is deleted
6735 (probably that's why the process is dead, too) */
6736 if (NILP (XBUFFER (buffer
)->name
))
6738 Fset_buffer (buffer
);
6741 opoint_byte
= PT_BYTE
;
6742 /* Insert new output into buffer
6743 at the current end-of-output marker,
6744 thus preserving logical ordering of input and output. */
6745 if (XMARKER (p
->mark
)->buffer
)
6746 Fgoto_char (p
->mark
);
6748 SET_PT_BOTH (ZV
, ZV_BYTE
);
6751 before_byte
= PT_BYTE
;
6753 tem
= current_buffer
->read_only
;
6754 current_buffer
->read_only
= Qnil
;
6755 insert_string ("\nProcess ");
6756 Finsert (1, &p
->name
);
6757 insert_string (" ");
6759 current_buffer
->read_only
= tem
;
6760 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6762 if (opoint
>= before
)
6763 SET_PT_BOTH (opoint
+ (PT
- before
),
6764 opoint_byte
+ (PT_BYTE
- before_byte
));
6766 SET_PT_BOTH (opoint
, opoint_byte
);
6768 set_buffer_internal (old
);
6773 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6774 redisplay_preserve_echo_area (13);
6780 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6781 Sset_process_coding_system
, 1, 3, 0,
6782 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6783 DECODING will be used to decode subprocess output and ENCODING to
6784 encode subprocess input. */)
6785 (process
, decoding
, encoding
)
6786 register Lisp_Object process
, decoding
, encoding
;
6788 register struct Lisp_Process
*p
;
6790 CHECK_PROCESS (process
);
6791 p
= XPROCESS (process
);
6793 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6795 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6796 Fcheck_coding_system (decoding
);
6797 Fcheck_coding_system (encoding
);
6798 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
6799 p
->decode_coding_system
= decoding
;
6800 p
->encode_coding_system
= encoding
;
6801 setup_process_coding_systems (process
);
6806 DEFUN ("process-coding-system",
6807 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6808 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6810 register Lisp_Object process
;
6812 CHECK_PROCESS (process
);
6813 return Fcons (XPROCESS (process
)->decode_coding_system
,
6814 XPROCESS (process
)->encode_coding_system
);
6817 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6818 Sset_process_filter_multibyte
, 2, 2, 0,
6819 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6820 If FLAG is non-nil, the filter is given multibyte strings.
6821 If FLAG is nil, the filter is given unibyte strings. In this case,
6822 all character code conversion except for end-of-line conversion is
6825 Lisp_Object process
, flag
;
6827 register struct Lisp_Process
*p
;
6829 CHECK_PROCESS (process
);
6830 p
= XPROCESS (process
);
6832 p
->decode_coding_system
= raw_text_coding_system (p
->decode_coding_system
);
6833 setup_process_coding_systems (process
);
6838 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6839 Sprocess_filter_multibyte_p
, 1, 1, 0,
6840 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6842 Lisp_Object process
;
6844 register struct Lisp_Process
*p
;
6845 struct coding_system
*coding
;
6847 CHECK_PROCESS (process
);
6848 p
= XPROCESS (process
);
6849 coding
= proc_decode_coding_system
[p
->infd
];
6850 return (CODING_FOR_UNIBYTE (coding
) ? Qnil
: Qt
);
6855 /* Add DESC to the set of keyboard input descriptors. */
6858 add_keyboard_wait_descriptor (desc
)
6861 FD_SET (desc
, &input_wait_mask
);
6862 FD_SET (desc
, &non_process_wait_mask
);
6863 if (desc
> max_keyboard_desc
)
6864 max_keyboard_desc
= desc
;
6867 static int add_gpm_wait_descriptor_called_flag
;
6870 add_gpm_wait_descriptor (desc
)
6873 if (! add_gpm_wait_descriptor_called_flag
)
6874 FD_CLR (0, &input_wait_mask
);
6875 add_gpm_wait_descriptor_called_flag
= 1;
6876 FD_SET (desc
, &input_wait_mask
);
6877 FD_SET (desc
, &gpm_wait_mask
);
6878 if (desc
> max_gpm_desc
)
6879 max_gpm_desc
= desc
;
6882 /* From now on, do not expect DESC to give keyboard input. */
6885 delete_keyboard_wait_descriptor (desc
)
6889 int lim
= max_keyboard_desc
;
6891 FD_CLR (desc
, &input_wait_mask
);
6892 FD_CLR (desc
, &non_process_wait_mask
);
6894 if (desc
== max_keyboard_desc
)
6895 for (fd
= 0; fd
< lim
; fd
++)
6896 if (FD_ISSET (fd
, &input_wait_mask
)
6897 && !FD_ISSET (fd
, &non_keyboard_wait_mask
)
6898 && !FD_ISSET (fd
, &gpm_wait_mask
))
6899 max_keyboard_desc
= fd
;
6903 delete_gpm_wait_descriptor (desc
)
6907 int lim
= max_gpm_desc
;
6909 FD_CLR (desc
, &input_wait_mask
);
6910 FD_CLR (desc
, &non_process_wait_mask
);
6912 if (desc
== max_gpm_desc
)
6913 for (fd
= 0; fd
< lim
; fd
++)
6914 if (FD_ISSET (fd
, &input_wait_mask
)
6915 && !FD_ISSET (fd
, &non_keyboard_wait_mask
)
6916 && !FD_ISSET (fd
, &non_process_wait_mask
))
6920 /* Return nonzero if *MASK has a bit set
6921 that corresponds to one of the keyboard input descriptors. */
6924 keyboard_bit_set (mask
)
6929 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6930 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6931 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6942 inhibit_sentinels
= 0;
6946 if (! noninteractive
|| initialized
)
6948 signal (SIGCHLD
, sigchld_handler
);
6951 FD_ZERO (&input_wait_mask
);
6952 FD_ZERO (&non_keyboard_wait_mask
);
6953 FD_ZERO (&non_process_wait_mask
);
6954 max_process_desc
= 0;
6956 #ifdef NON_BLOCKING_CONNECT
6957 FD_ZERO (&connect_wait_mask
);
6958 num_pending_connects
= 0;
6961 #ifdef ADAPTIVE_READ_BUFFERING
6962 process_output_delay_count
= 0;
6963 process_output_skip
= 0;
6966 /* Don't do this, it caused infinite select loops. The display
6967 method should call add_keyboard_wait_descriptor on stdin if it
6970 FD_SET (0, &input_wait_mask
);
6973 Vprocess_alist
= Qnil
;
6975 deleted_pid_list
= Qnil
;
6977 for (i
= 0; i
< MAXDESC
; i
++)
6979 chan_process
[i
] = Qnil
;
6980 proc_buffered_char
[i
] = -1;
6982 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6983 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6984 #ifdef DATAGRAM_SOCKETS
6985 bzero (datagram_address
, sizeof datagram_address
);
6990 Lisp_Object subfeatures
= Qnil
;
6991 struct socket_options
*sopt
;
6993 #define ADD_SUBFEATURE(key, val) \
6994 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6996 #ifdef NON_BLOCKING_CONNECT
6997 ADD_SUBFEATURE (QCnowait
, Qt
);
6999 #ifdef DATAGRAM_SOCKETS
7000 ADD_SUBFEATURE (QCtype
, Qdatagram
);
7002 #ifdef HAVE_LOCAL_SOCKETS
7003 ADD_SUBFEATURE (QCfamily
, Qlocal
);
7005 ADD_SUBFEATURE (QCfamily
, Qipv4
);
7007 ADD_SUBFEATURE (QCfamily
, Qipv6
);
7009 #ifdef HAVE_GETSOCKNAME
7010 ADD_SUBFEATURE (QCservice
, Qt
);
7012 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
7013 ADD_SUBFEATURE (QCserver
, Qt
);
7016 for (sopt
= socket_options
; sopt
->name
; sopt
++)
7017 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
7019 Fprovide (intern ("make-network-process"), subfeatures
);
7021 #endif /* HAVE_SOCKETS */
7023 #if defined (DARWIN) || defined (MAC_OSX)
7024 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7025 processes. As such, we only change the default value. */
7028 char *release
= get_operating_system_release();
7029 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
7030 && release
[1] == '.')) {
7031 Vprocess_connection_type
= Qnil
;
7040 Qprocessp
= intern ("processp");
7041 staticpro (&Qprocessp
);
7042 Qrun
= intern ("run");
7044 Qstop
= intern ("stop");
7046 Qsignal
= intern ("signal");
7047 staticpro (&Qsignal
);
7049 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7052 Qexit = intern ("exit");
7053 staticpro (&Qexit); */
7055 Qopen
= intern ("open");
7057 Qclosed
= intern ("closed");
7058 staticpro (&Qclosed
);
7059 Qconnect
= intern ("connect");
7060 staticpro (&Qconnect
);
7061 Qfailed
= intern ("failed");
7062 staticpro (&Qfailed
);
7063 Qlisten
= intern ("listen");
7064 staticpro (&Qlisten
);
7065 Qlocal
= intern ("local");
7066 staticpro (&Qlocal
);
7067 Qipv4
= intern ("ipv4");
7070 Qipv6
= intern ("ipv6");
7073 Qdatagram
= intern ("datagram");
7074 staticpro (&Qdatagram
);
7076 QCname
= intern (":name");
7077 staticpro (&QCname
);
7078 QCbuffer
= intern (":buffer");
7079 staticpro (&QCbuffer
);
7080 QChost
= intern (":host");
7081 staticpro (&QChost
);
7082 QCservice
= intern (":service");
7083 staticpro (&QCservice
);
7084 QCtype
= intern (":type");
7085 staticpro (&QCtype
);
7086 QClocal
= intern (":local");
7087 staticpro (&QClocal
);
7088 QCremote
= intern (":remote");
7089 staticpro (&QCremote
);
7090 QCcoding
= intern (":coding");
7091 staticpro (&QCcoding
);
7092 QCserver
= intern (":server");
7093 staticpro (&QCserver
);
7094 QCnowait
= intern (":nowait");
7095 staticpro (&QCnowait
);
7096 QCsentinel
= intern (":sentinel");
7097 staticpro (&QCsentinel
);
7098 QClog
= intern (":log");
7100 QCnoquery
= intern (":noquery");
7101 staticpro (&QCnoquery
);
7102 QCstop
= intern (":stop");
7103 staticpro (&QCstop
);
7104 QCoptions
= intern (":options");
7105 staticpro (&QCoptions
);
7106 QCplist
= intern (":plist");
7107 staticpro (&QCplist
);
7109 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
7110 staticpro (&Qlast_nonmenu_event
);
7112 staticpro (&Vprocess_alist
);
7114 staticpro (&deleted_pid_list
);
7117 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
7118 doc
: /* *Non-nil means delete processes immediately when they exit.
7119 A value of nil means don't delete them until `list-processes' is run. */);
7121 delete_exited_processes
= 1;
7123 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
7124 doc
: /* Control type of device used to communicate with subprocesses.
7125 Values are nil to use a pipe, or t or `pty' to use a pty.
7126 The value has no effect if the system has no ptys or if all ptys are busy:
7127 then a pipe is used in any case.
7128 The value takes effect when `start-process' is called. */);
7129 Vprocess_connection_type
= Qt
;
7131 #ifdef ADAPTIVE_READ_BUFFERING
7132 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
7133 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7134 On some systems, when Emacs reads the output from a subprocess, the output data
7135 is read in very small blocks, potentially resulting in very poor performance.
7136 This behavior can be remedied to some extent by setting this variable to a
7137 non-nil value, as it will automatically delay reading from such processes, to
7138 allow them to produce more output before Emacs tries to read it.
7139 If the value is t, the delay is reset after each write to the process; any other
7140 non-nil value means that the delay is not reset on write.
7141 The variable takes effect when `start-process' is called. */);
7142 Vprocess_adaptive_read_buffering
= Qt
;
7145 defsubr (&Sprocessp
);
7146 defsubr (&Sget_process
);
7147 defsubr (&Sget_buffer_process
);
7148 defsubr (&Sdelete_process
);
7149 defsubr (&Sprocess_status
);
7150 defsubr (&Sprocess_exit_status
);
7151 defsubr (&Sprocess_id
);
7152 defsubr (&Sprocess_name
);
7153 defsubr (&Sprocess_tty_name
);
7154 defsubr (&Sprocess_command
);
7155 defsubr (&Sset_process_buffer
);
7156 defsubr (&Sprocess_buffer
);
7157 defsubr (&Sprocess_mark
);
7158 defsubr (&Sset_process_filter
);
7159 defsubr (&Sprocess_filter
);
7160 defsubr (&Sset_process_sentinel
);
7161 defsubr (&Sprocess_sentinel
);
7162 defsubr (&Sset_process_window_size
);
7163 defsubr (&Sset_process_inherit_coding_system_flag
);
7164 defsubr (&Sprocess_inherit_coding_system_flag
);
7165 defsubr (&Sset_process_query_on_exit_flag
);
7166 defsubr (&Sprocess_query_on_exit_flag
);
7167 defsubr (&Sprocess_contact
);
7168 defsubr (&Sprocess_plist
);
7169 defsubr (&Sset_process_plist
);
7170 defsubr (&Slist_processes
);
7171 defsubr (&Sprocess_list
);
7172 defsubr (&Sstart_process
);
7174 defsubr (&Sset_network_process_option
);
7175 defsubr (&Smake_network_process
);
7176 defsubr (&Sformat_network_address
);
7177 #endif /* HAVE_SOCKETS */
7178 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7180 defsubr (&Snetwork_interface_list
);
7182 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7183 defsubr (&Snetwork_interface_info
);
7185 #endif /* HAVE_SOCKETS ... */
7186 #ifdef DATAGRAM_SOCKETS
7187 defsubr (&Sprocess_datagram_address
);
7188 defsubr (&Sset_process_datagram_address
);
7190 defsubr (&Saccept_process_output
);
7191 defsubr (&Sprocess_send_region
);
7192 defsubr (&Sprocess_send_string
);
7193 defsubr (&Sinterrupt_process
);
7194 defsubr (&Skill_process
);
7195 defsubr (&Squit_process
);
7196 defsubr (&Sstop_process
);
7197 defsubr (&Scontinue_process
);
7198 defsubr (&Sprocess_running_child_p
);
7199 defsubr (&Sprocess_send_eof
);
7200 defsubr (&Ssignal_process
);
7201 defsubr (&Swaiting_for_user_input_p
);
7202 /* defsubr (&Sprocess_connection); */
7203 defsubr (&Sset_process_coding_system
);
7204 defsubr (&Sprocess_coding_system
);
7205 defsubr (&Sset_process_filter_multibyte
);
7206 defsubr (&Sprocess_filter_multibyte_p
);
7210 #else /* not subprocesses */
7212 #include <sys/types.h>
7216 #include "systime.h"
7217 #include "character.h"
7219 #include "termopts.h"
7220 #include "sysselect.h"
7222 extern int frame_garbaged
;
7224 extern EMACS_TIME
timer_check ();
7225 extern int timers_run
;
7229 /* As described above, except assuming that there are no subprocesses:
7231 Wait for timeout to elapse and/or keyboard input to be available.
7234 timeout in seconds, or
7235 zero for no limit, or
7236 -1 means gobble data immediately available but don't wait for any.
7238 read_kbd is a Lisp_Object:
7239 0 to ignore keyboard input, or
7240 1 to return when input is available, or
7241 -1 means caller will actually read the input, so don't throw to
7244 see full version for other parameters. We know that wait_proc will
7245 always be NULL, since `subprocesses' isn't defined.
7247 do_display != 0 means redisplay should be done to show subprocess
7248 output that arrives.
7250 Return true if we received input from any process. */
7253 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
7254 wait_for_cell
, wait_proc
, just_wait_proc
)
7255 int time_limit
, microsecs
, read_kbd
, do_display
;
7256 Lisp_Object wait_for_cell
;
7257 struct Lisp_Process
*wait_proc
;
7261 EMACS_TIME end_time
, timeout
;
7262 SELECT_TYPE waitchannels
;
7265 /* What does time_limit really mean? */
7266 if (time_limit
|| microsecs
)
7268 EMACS_GET_TIME (end_time
);
7269 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
7270 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
7273 /* Turn off periodic alarms (in case they are in use)
7274 and then turn off any other atimers,
7275 because the select emulator uses alarms. */
7277 turn_on_atimers (0);
7281 int timeout_reduced_for_timers
= 0;
7283 /* If calling from keyboard input, do not quit
7284 since we want to return C-g as an input character.
7285 Otherwise, do pending quit if requested. */
7289 /* Exit now if the cell we're waiting for became non-nil. */
7290 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7293 /* Compute time from now till when time limit is up */
7294 /* Exit if already run out */
7295 if (time_limit
== -1)
7297 /* -1 specified for timeout means
7298 gobble output available now
7299 but don't wait at all. */
7301 EMACS_SET_SECS_USECS (timeout
, 0, 0);
7303 else if (time_limit
|| microsecs
)
7305 EMACS_GET_TIME (timeout
);
7306 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
7307 if (EMACS_TIME_NEG_P (timeout
))
7312 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
7315 /* If our caller will not immediately handle keyboard events,
7316 run timer events directly.
7317 (Callers that will immediately read keyboard events
7318 call timer_delay on their own.) */
7319 if (NILP (wait_for_cell
))
7321 EMACS_TIME timer_delay
;
7325 int old_timers_run
= timers_run
;
7326 timer_delay
= timer_check (1);
7327 if (timers_run
!= old_timers_run
&& do_display
)
7328 /* We must retry, since a timer may have requeued itself
7329 and that could alter the time delay. */
7330 redisplay_preserve_echo_area (14);
7334 while (!detect_input_pending ());
7336 /* If there is unread keyboard input, also return. */
7338 && requeued_events_pending_p ())
7341 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
7343 EMACS_TIME difference
;
7344 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
7345 if (EMACS_TIME_NEG_P (difference
))
7347 timeout
= timer_delay
;
7348 timeout_reduced_for_timers
= 1;
7353 /* Cause C-g and alarm signals to take immediate action,
7354 and cause input available signals to zero out timeout. */
7356 set_waiting_for_input (&timeout
);
7358 /* Wait till there is something to do. */
7360 if (! read_kbd
&& NILP (wait_for_cell
))
7361 FD_ZERO (&waitchannels
);
7363 FD_SET (0, &waitchannels
);
7365 /* If a frame has been newly mapped and needs updating,
7366 reprocess its display stuff. */
7367 if (frame_garbaged
&& do_display
)
7369 clear_waiting_for_input ();
7370 redisplay_preserve_echo_area (15);
7372 set_waiting_for_input (&timeout
);
7375 if (read_kbd
&& detect_input_pending ())
7378 FD_ZERO (&waitchannels
);
7381 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7386 /* Make C-g and alarm signals set flags again */
7387 clear_waiting_for_input ();
7389 /* If we woke up due to SIGWINCH, actually change size now. */
7390 do_pending_window_change (0);
7392 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7393 /* We waited the full specified time, so return now. */
7398 /* If the system call was interrupted, then go around the
7400 if (xerrno
== EINTR
)
7401 FD_ZERO (&waitchannels
);
7403 error ("select error: %s", emacs_strerror (xerrno
));
7406 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7407 /* System sometimes fails to deliver SIGIO. */
7408 kill (getpid (), SIGIO
);
7411 if (read_kbd
&& interrupt_input
&& (waitchannels
& 1))
7412 kill (getpid (), SIGIO
);
7415 /* Check for keyboard input */
7418 && detect_input_pending_run_timers (do_display
))
7420 swallow_events (do_display
);
7421 if (detect_input_pending_run_timers (do_display
))
7425 /* If there is unread keyboard input, also return. */
7427 && requeued_events_pending_p ())
7430 /* If wait_for_cell. check for keyboard input
7431 but don't run any timers.
7432 ??? (It seems wrong to me to check for keyboard
7433 input at all when wait_for_cell, but the code
7434 has been this way since July 1994.
7435 Try changing this after version 19.31.) */
7436 if (! NILP (wait_for_cell
)
7437 && detect_input_pending ())
7439 swallow_events (do_display
);
7440 if (detect_input_pending ())
7444 /* Exit now if the cell we're waiting for became non-nil. */
7445 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7455 /* Don't confuse make-docfile by having two doc strings for this function.
7456 make-docfile does not pay attention to #if, for good reason! */
7457 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7460 register Lisp_Object name
;
7465 /* Don't confuse make-docfile by having two doc strings for this function.
7466 make-docfile does not pay attention to #if, for good reason! */
7467 DEFUN ("process-inherit-coding-system-flag",
7468 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7472 register Lisp_Object process
;
7474 /* Ignore the argument and return the value of
7475 inherit-process-coding-system. */
7476 return inherit_process_coding_system
? Qt
: Qnil
;
7479 /* Kill all processes associated with `buffer'.
7480 If `buffer' is nil, kill all processes.
7481 Since we have no subprocesses, this does nothing. */
7484 kill_buffer_processes (buffer
)
7497 QCtype
= intern (":type");
7498 staticpro (&QCtype
);
7500 defsubr (&Sget_buffer_process
);
7501 defsubr (&Sprocess_inherit_coding_system_flag
);
7505 #endif /* not subprocesses */
7507 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7508 (do not change this comment) */