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 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, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
27 /* This file is split into two parts by the following preprocessor
28 conditional. The 'then' clause contains all of the support for
29 asynchronous subprocesses. The 'else' clause contains stub
30 versions of some of the asynchronous subprocess routines that are
31 often called elsewhere in Emacs, so we don't have to #ifdef the
32 sections that call them. */
40 #include <sys/types.h> /* some typedefs are used in sys/file.h */
43 #ifdef HAVE_INTTYPES_H
50 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
53 #endif /* not WINDOWSNT */
55 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
56 #include <sys/socket.h>
58 #include <netinet/in.h>
59 #include <arpa/inet.h>
60 #ifdef NEED_NET_ERRNO_H
61 #include <net/errno.h>
62 #endif /* NEED_NET_ERRNO_H */
64 /* Are local (unix) sockets supported? */
65 #if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
66 #if !defined (AF_LOCAL) && defined (AF_UNIX)
67 #define AF_LOCAL AF_UNIX
70 #define HAVE_LOCAL_SOCKETS
74 #endif /* HAVE_SOCKETS */
76 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
81 /* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
82 #ifdef HAVE_BROKEN_INET_ADDR
83 #define IN_ADDR struct in_addr
84 #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
86 #define IN_ADDR unsigned long
87 #define NUMERIC_ADDR_ERROR (numeric_addr == -1)
90 #if defined(BSD_SYSTEM) || defined(STRIDE)
91 #include <sys/ioctl.h>
92 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
94 #endif /* HAVE_PTYS and no O_NDELAY */
95 #endif /* BSD_SYSTEM || STRIDE */
97 #ifdef BROKEN_O_NONBLOCK
99 #endif /* BROKEN_O_NONBLOCK */
105 /* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
107 #if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
108 /* sys/ioctl.h may have been included already */
110 #include <sys/ioctl.h>
117 #include <sys/sysmacros.h> /* for "minor" */
118 #endif /* not IRIS */
121 #include <sys/wait.h>
130 #include "character.h"
133 #include "termhooks.h"
134 #include "termopts.h"
135 #include "commands.h"
136 #include "keyboard.h"
138 #include "blockinput.h"
139 #include "dispextern.h"
140 #include "composite.h"
143 Lisp_Object Qprocessp
;
144 Lisp_Object Qrun
, Qstop
, Qsignal
;
145 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
146 Lisp_Object Qlocal
, Qipv4
, Qdatagram
;
150 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
151 Lisp_Object QClocal
, QCremote
, QCcoding
;
152 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
153 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
154 Lisp_Object QCfilter_multibyte
;
155 Lisp_Object Qlast_nonmenu_event
;
156 /* QCfamily is declared and initialized in xfaces.c,
157 QCfilter in keyboard.c. */
158 extern Lisp_Object QCfamily
, QCfilter
;
160 /* Qexit is declared and initialized in eval.c. */
162 /* QCfamily is defined in xfaces.c. */
163 extern Lisp_Object QCfamily
;
164 /* QCfilter is defined in keyboard.c. */
165 extern Lisp_Object QCfilter
;
167 /* a process object is a network connection when its childp field is neither
168 Qt nor Qnil but is instead a property list (KEY VAL ...). */
171 #define NETCONN_P(p) (CONSP (XPROCESS (p)->childp))
172 #define NETCONN1_P(p) (CONSP ((p)->childp))
174 #define NETCONN_P(p) 0
175 #define NETCONN1_P(p) 0
176 #endif /* HAVE_SOCKETS */
178 /* Define first descriptor number available for subprocesses. */
180 #define FIRST_PROC_DESC 1
182 #define FIRST_PROC_DESC 3
185 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
188 #if !defined (SIGCHLD) && defined (SIGCLD)
189 #define SIGCHLD SIGCLD
192 #include "syssignal.h"
196 extern char *get_operating_system_release ();
202 extern char *sys_errlist
[];
209 /* t means use pty, nil means use a pipe,
210 maybe other values to come. */
211 static Lisp_Object Vprocess_connection_type
;
215 #include <sys/socket.h>
219 /* These next two vars are non-static since sysdep.c uses them in the
220 emulation of `select'. */
221 /* Number of events of change of status of a process. */
223 /* Number of events for which the user or sentinel has been notified. */
226 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
228 #ifdef BROKEN_NON_BLOCKING_CONNECT
229 #undef NON_BLOCKING_CONNECT
231 #ifndef NON_BLOCKING_CONNECT
234 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
235 #if defined (O_NONBLOCK) || defined (O_NDELAY)
236 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
237 #define NON_BLOCKING_CONNECT
238 #endif /* EWOULDBLOCK || EINPROGRESS */
239 #endif /* O_NONBLOCK || O_NDELAY */
240 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
241 #endif /* HAVE_SELECT */
242 #endif /* HAVE_SOCKETS */
243 #endif /* NON_BLOCKING_CONNECT */
244 #endif /* BROKEN_NON_BLOCKING_CONNECT */
246 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
247 this system. We need to read full packets, so we need a
248 "non-destructive" select. So we require either native select,
249 or emulation of select using FIONREAD. */
251 #ifdef BROKEN_DATAGRAM_SOCKETS
252 #undef DATAGRAM_SOCKETS
254 #ifndef DATAGRAM_SOCKETS
256 #if defined (HAVE_SELECT) || defined (FIONREAD)
257 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
258 #define DATAGRAM_SOCKETS
259 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
260 #endif /* HAVE_SELECT || FIONREAD */
261 #endif /* HAVE_SOCKETS */
262 #endif /* DATAGRAM_SOCKETS */
263 #endif /* BROKEN_DATAGRAM_SOCKETS */
266 #undef NON_BLOCKING_CONNECT
267 #undef DATAGRAM_SOCKETS
270 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
271 #ifdef EMACS_HAS_USECS
272 #define ADAPTIVE_READ_BUFFERING
276 #ifdef ADAPTIVE_READ_BUFFERING
277 #define READ_OUTPUT_DELAY_INCREMENT 10000
278 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
279 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
281 /* Number of processes which have a non-zero read_output_delay,
282 and therefore might be delayed for adaptive read buffering. */
284 static int process_output_delay_count
;
286 /* Non-zero if any process has non-nil read_output_skip. */
288 static int process_output_skip
;
290 /* Non-nil means to delay reading process output to improve buffering.
291 A value of t means that delay is reset after each send, any other
292 non-nil value does not reset the delay. A value of nil disables
293 adaptive read buffering completely. */
294 static Lisp_Object Vprocess_adaptive_read_buffering
;
296 #define process_output_delay_count 0
300 #include "sysselect.h"
302 static int keyboard_bit_set
P_ ((SELECT_TYPE
*));
303 static void deactivate_process
P_ ((Lisp_Object
));
304 static void status_notify
P_ ((struct Lisp_Process
*));
305 static int read_process_output
P_ ((Lisp_Object
, int));
307 /* If we support a window system, turn on the code to poll periodically
308 to detect C-g. It isn't actually used when doing interrupt input. */
309 #ifdef HAVE_WINDOW_SYSTEM
310 #define POLL_FOR_INPUT
313 static Lisp_Object
get_process ();
314 static void exec_sentinel ();
316 extern EMACS_TIME
timer_check ();
317 extern int timers_run
;
319 /* Mask of bits indicating the descriptors that we wait for input on. */
321 static SELECT_TYPE input_wait_mask
;
323 /* Mask that excludes keyboard input descriptor(s). */
325 static SELECT_TYPE non_keyboard_wait_mask
;
327 /* Mask that excludes process input descriptor(s). */
329 static SELECT_TYPE non_process_wait_mask
;
331 /* Mask for the gpm mouse input descriptor. */
333 static SELECT_TYPE gpm_wait_mask
;
335 #ifdef NON_BLOCKING_CONNECT
336 /* Mask of bits indicating the descriptors that we wait for connect to
337 complete on. Once they complete, they are removed from this mask
338 and added to the input_wait_mask and non_keyboard_wait_mask. */
340 static SELECT_TYPE connect_wait_mask
;
342 /* Number of bits set in connect_wait_mask. */
343 static int num_pending_connects
;
345 #define IF_NON_BLOCKING_CONNECT(s) s
347 #define IF_NON_BLOCKING_CONNECT(s)
350 /* The largest descriptor currently in use for a process object. */
351 static int max_process_desc
;
353 /* The largest descriptor currently in use for keyboard input. */
354 static int max_keyboard_desc
;
356 /* The largest descriptor currently in use for gpm mouse input. */
357 static int max_gpm_desc
;
359 /* Nonzero means delete a process right away if it exits. */
360 static int delete_exited_processes
;
362 /* Indexed by descriptor, gives the process (if any) for that descriptor */
363 Lisp_Object chan_process
[MAXDESC
];
365 /* Alist of elements (NAME . PROCESS) */
366 Lisp_Object Vprocess_alist
;
368 /* Buffered-ahead input char from process, indexed by channel.
369 -1 means empty (no char is buffered).
370 Used on sys V where the only way to tell if there is any
371 output from the process is to read at least one char.
372 Always -1 on systems that support FIONREAD. */
374 /* Don't make static; need to access externally. */
375 int proc_buffered_char
[MAXDESC
];
377 /* Table of `struct coding-system' for each process. */
378 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
379 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
381 #ifdef DATAGRAM_SOCKETS
382 /* Table of `partner address' for datagram sockets. */
383 struct sockaddr_and_len
{
386 } datagram_address
[MAXDESC
];
387 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
388 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
390 #define DATAGRAM_CHAN_P(chan) (0)
391 #define DATAGRAM_CONN_P(proc) (0)
394 /* Maximum number of bytes to send to a pty without an eof. */
395 static int pty_max_bytes
;
397 /* Nonzero means don't run process sentinels. This is used
399 int inhibit_sentinels
;
405 /* The file name of the pty opened by allocate_pty. */
407 static char pty_name
[24];
410 /* Compute the Lisp form of the process status, p->status, from
411 the numeric status that was returned by `wait'. */
413 static Lisp_Object
status_convert ();
417 struct Lisp_Process
*p
;
419 union { int i
; WAITTYPE wt
; } u
;
420 eassert (p
->raw_status_new
);
422 p
->status
= status_convert (u
.wt
);
423 p
->raw_status_new
= 0;
426 /* Convert a process status word in Unix format to
427 the list that we use internally. */
434 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
435 else if (WIFEXITED (w
))
436 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
437 WCOREDUMP (w
) ? Qt
: Qnil
));
438 else if (WIFSIGNALED (w
))
439 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
440 WCOREDUMP (w
) ? Qt
: Qnil
));
445 /* Given a status-list, extract the three pieces of information
446 and store them individually through the three pointers. */
449 decode_status (l
, symbol
, code
, coredump
)
467 *code
= XFASTINT (XCAR (tem
));
469 *coredump
= !NILP (tem
);
473 /* Return a string describing a process status list. */
477 struct Lisp_Process
*p
;
479 Lisp_Object status
= p
->status
;
482 Lisp_Object string
, string2
;
484 decode_status (status
, &symbol
, &code
, &coredump
);
486 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
489 synchronize_system_messages_locale ();
490 signame
= strsignal (code
);
493 string
= build_string (signame
);
494 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
495 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
496 return concat2 (string
, string2
);
498 else if (EQ (symbol
, Qexit
))
501 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
503 return build_string ("finished\n");
504 string
= Fnumber_to_string (make_number (code
));
505 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
506 return concat3 (build_string ("exited abnormally with code "),
509 else if (EQ (symbol
, Qfailed
))
511 string
= Fnumber_to_string (make_number (code
));
512 string2
= build_string ("\n");
513 return concat3 (build_string ("failed with code "),
517 return Fcopy_sequence (Fsymbol_name (symbol
));
522 /* Open an available pty, returning a file descriptor.
523 Return -1 on failure.
524 The file name of the terminal corresponding to the pty
525 is left in the variable pty_name. */
536 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
537 for (i
= 0; i
< 16; i
++)
540 struct stat stb
; /* Used in some PTY_OPEN. */
541 #ifdef PTY_NAME_SPRINTF
544 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
545 #endif /* no PTY_NAME_SPRINTF */
549 #else /* no PTY_OPEN */
552 /* Unusual IRIS code */
553 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
556 if (fstat (fd
, &stb
) < 0)
558 # else /* not IRIS */
559 { /* Some systems name their pseudoterminals so that there are gaps in
560 the usual sequence - for example, on HP9000/S700 systems, there
561 are no pseudoterminals with names ending in 'f'. So we wait for
562 three failures in a row before deciding that we've reached the
564 int failed_count
= 0;
566 if (stat (pty_name
, &stb
) < 0)
569 if (failed_count
>= 3)
576 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
578 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
580 # endif /* not IRIS */
582 #endif /* no PTY_OPEN */
586 /* check to make certain that both sides are available
587 this avoids a nasty yet stupid bug in rlogins */
588 #ifdef PTY_TTY_NAME_SPRINTF
591 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
592 #endif /* no PTY_TTY_NAME_SPRINTF */
594 if (access (pty_name
, 6) != 0)
597 # if !defined(IRIS) && !defined(__sgi)
603 #endif /* not UNIPLUS */
610 #endif /* HAVE_PTYS */
616 register Lisp_Object val
, tem
, name1
;
617 register struct Lisp_Process
*p
;
621 p
= allocate_process ();
628 p
->raw_status_new
= 0;
630 p
->mark
= Fmake_marker ();
632 #ifdef ADAPTIVE_READ_BUFFERING
633 p
->adaptive_read_buffering
= 0;
634 p
->read_output_delay
= 0;
635 p
->read_output_skip
= 0;
638 /* If name is already in use, modify it until it is unused. */
643 tem
= Fget_process (name1
);
644 if (NILP (tem
)) break;
645 sprintf (suffix
, "<%d>", i
);
646 name1
= concat2 (name
, build_string (suffix
));
650 XSETPROCESS (val
, p
);
651 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
656 remove_process (proc
)
657 register Lisp_Object proc
;
659 register Lisp_Object pair
;
661 pair
= Frassq (proc
, Vprocess_alist
);
662 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
664 deactivate_process (proc
);
667 /* Setup coding systems of PROCESS. */
670 setup_process_coding_systems (process
)
673 struct Lisp_Process
*p
= XPROCESS (process
);
675 int outch
= p
->outfd
;
676 Lisp_Object coding_system
;
678 if (inch
< 0 || outch
< 0)
681 if (!proc_decode_coding_system
[inch
])
682 proc_decode_coding_system
[inch
]
683 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
684 coding_system
= p
->decode_coding_system
;
685 if (! NILP (p
->filter
))
687 if (!p
->filter_multibyte
)
688 coding_system
= raw_text_coding_system (coding_system
);
690 else if (BUFFERP (p
->buffer
))
692 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
693 coding_system
= raw_text_coding_system (coding_system
);
695 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
697 if (!proc_encode_coding_system
[outch
])
698 proc_encode_coding_system
[outch
]
699 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
700 setup_coding_system (p
->encode_coding_system
,
701 proc_encode_coding_system
[outch
]);
704 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
705 doc
: /* Return t if OBJECT is a process. */)
709 return PROCESSP (object
) ? Qt
: Qnil
;
712 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
713 doc
: /* Return the process named NAME, or nil if there is none. */)
715 register Lisp_Object name
;
720 return Fcdr (Fassoc (name
, Vprocess_alist
));
723 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
724 doc
: /* Return the (or a) process associated with BUFFER.
725 BUFFER may be a buffer or the name of one. */)
727 register Lisp_Object buffer
;
729 register Lisp_Object buf
, tail
, proc
;
731 if (NILP (buffer
)) return Qnil
;
732 buf
= Fget_buffer (buffer
);
733 if (NILP (buf
)) return Qnil
;
735 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
737 proc
= Fcdr (Fcar (tail
));
738 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
744 /* This is how commands for the user decode process arguments. It
745 accepts a process, a process name, a buffer, a buffer name, or nil.
746 Buffers denote the first process in the buffer, and nil denotes the
751 register Lisp_Object name
;
753 register Lisp_Object proc
, obj
;
756 obj
= Fget_process (name
);
758 obj
= Fget_buffer (name
);
760 error ("Process %s does not exist", SDATA (name
));
762 else if (NILP (name
))
763 obj
= Fcurrent_buffer ();
767 /* Now obj should be either a buffer object or a process object.
771 proc
= Fget_buffer_process (obj
);
773 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
785 /* Fdelete_process promises to immediately forget about the process, but in
786 reality, Emacs needs to remember those processes until they have been
787 treated by sigchld_handler; otherwise this handler would consider the
788 process as being synchronous and say that the synchronous process is
790 static Lisp_Object deleted_pid_list
;
793 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
794 doc
: /* Delete PROCESS: kill it and forget about it immediately.
795 PROCESS may be a process, a buffer, the name of a process or buffer, or
796 nil, indicating the current buffer's process. */)
798 register Lisp_Object process
;
800 register struct Lisp_Process
*p
;
802 process
= get_process (process
);
803 p
= XPROCESS (process
);
805 p
->raw_status_new
= 0;
808 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
809 p
->tick
= ++process_tick
;
812 else if (p
->infd
>= 0)
816 /* Assignment to EMACS_INT stops GCC whining about limited range
818 EMACS_INT pid
= p
->pid
;
820 /* No problem storing the pid here, as it is still in Vprocess_alist. */
821 deleted_pid_list
= Fcons (make_fixnum_or_float (pid
),
822 /* GC treated elements set to nil. */
823 Fdelq (Qnil
, deleted_pid_list
));
824 /* If the process has already signaled, remove it from the list. */
825 if (p
->raw_status_new
)
828 if (CONSP (p
->status
))
829 symbol
= XCAR (p
->status
);
830 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
832 = Fdelete (make_fixnum_or_float (pid
), deleted_pid_list
);
836 Fkill_process (process
, Qnil
);
837 /* Do this now, since remove_process will make sigchld_handler do nothing. */
839 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
840 p
->tick
= ++process_tick
;
844 remove_process (process
);
848 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
849 doc
: /* Return the status of PROCESS.
850 The returned value is one of the following symbols:
851 run -- for a process that is running.
852 stop -- for a process stopped but continuable.
853 exit -- for a process that has exited.
854 signal -- for a process that has got a fatal signal.
855 open -- for a network stream connection that is open.
856 listen -- for a network stream server that is listening.
857 closed -- for a network stream connection that is closed.
858 connect -- when waiting for a non-blocking connection to complete.
859 failed -- when a non-blocking connection has failed.
860 nil -- if arg is a process name and no such process exists.
861 PROCESS may be a process, a buffer, the name of a process, or
862 nil, indicating the current buffer's process. */)
864 register Lisp_Object process
;
866 register struct Lisp_Process
*p
;
867 register Lisp_Object status
;
869 if (STRINGP (process
))
870 process
= Fget_process (process
);
872 process
= get_process (process
);
877 p
= XPROCESS (process
);
878 if (p
->raw_status_new
)
882 status
= XCAR (status
);
885 if (EQ (status
, Qexit
))
887 else if (EQ (p
->command
, Qt
))
889 else if (EQ (status
, Qrun
))
895 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
897 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
898 If PROCESS has not yet exited or died, return 0. */)
900 register Lisp_Object process
;
902 CHECK_PROCESS (process
);
903 if (XPROCESS (process
)->raw_status_new
)
904 update_status (XPROCESS (process
));
905 if (CONSP (XPROCESS (process
)->status
))
906 return XCAR (XCDR (XPROCESS (process
)->status
));
907 return make_number (0);
910 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
911 doc
: /* Return the process id of PROCESS.
912 This is the pid of the external process which PROCESS uses or talks to.
913 For a network connection, this value is nil. */)
915 register Lisp_Object process
;
917 /* Assignment to EMACS_INT stops GCC whining about limited range of
921 CHECK_PROCESS (process
);
922 pid
= XPROCESS (process
)->pid
;
923 return (pid
? make_fixnum_or_float (pid
) : Qnil
);
926 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
927 doc
: /* Return the name of PROCESS, as a string.
928 This is the name of the program invoked in PROCESS,
929 possibly modified to make it unique among process names. */)
931 register Lisp_Object process
;
933 CHECK_PROCESS (process
);
934 return XPROCESS (process
)->name
;
937 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
938 doc
: /* Return the command that was executed to start PROCESS.
939 This is a list of strings, the first string being the program executed
940 and the rest of the strings being the arguments given to it.
941 For a non-child channel, this is nil. */)
943 register Lisp_Object process
;
945 CHECK_PROCESS (process
);
946 return XPROCESS (process
)->command
;
949 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
950 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
951 This is the terminal that the process itself reads and writes on,
952 not the name of the pty that Emacs uses to talk with that terminal. */)
954 register Lisp_Object process
;
956 CHECK_PROCESS (process
);
957 return XPROCESS (process
)->tty_name
;
960 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
962 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
964 register Lisp_Object process
, buffer
;
966 struct Lisp_Process
*p
;
968 CHECK_PROCESS (process
);
970 CHECK_BUFFER (buffer
);
971 p
= XPROCESS (process
);
974 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
975 setup_process_coding_systems (process
);
979 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
981 doc
: /* Return the buffer PROCESS is associated with.
982 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
984 register Lisp_Object process
;
986 CHECK_PROCESS (process
);
987 return XPROCESS (process
)->buffer
;
990 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
992 doc
: /* Return the marker for the end of the last output from PROCESS. */)
994 register Lisp_Object process
;
996 CHECK_PROCESS (process
);
997 return XPROCESS (process
)->mark
;
1000 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
1002 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
1003 t means stop accepting output from the process.
1005 When a process has a filter, its buffer is not used for output.
1006 Instead, each time it does output, the entire string of output is
1007 passed to the filter.
1009 The filter gets two arguments: the process and the string of output.
1010 The string argument is normally a multibyte string, except:
1011 - if the process' input coding system is no-conversion or raw-text,
1012 it is a unibyte string (the non-converted input), or else
1013 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1014 string (the result of converting the decoded input multibyte
1015 string to unibyte with `string-make-unibyte'). */)
1017 register Lisp_Object process
, filter
;
1019 struct Lisp_Process
*p
;
1021 CHECK_PROCESS (process
);
1022 p
= XPROCESS (process
);
1024 /* Don't signal an error if the process' input file descriptor
1025 is closed. This could make debugging Lisp more difficult,
1026 for example when doing something like
1028 (setq process (start-process ...))
1030 (set-process-filter process ...) */
1034 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
1036 FD_CLR (p
->infd
, &input_wait_mask
);
1037 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
1039 else if (EQ (p
->filter
, Qt
)
1040 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
1042 FD_SET (p
->infd
, &input_wait_mask
);
1043 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
1049 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
1050 setup_process_coding_systems (process
);
1054 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1056 doc
: /* Returns the filter function of PROCESS; nil if none.
1057 See `set-process-filter' for more info on filter functions. */)
1059 register Lisp_Object process
;
1061 CHECK_PROCESS (process
);
1062 return XPROCESS (process
)->filter
;
1065 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1067 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1068 The sentinel is called as a function when the process changes state.
1069 It gets two arguments: the process, and a string describing the change. */)
1071 register Lisp_Object process
, sentinel
;
1073 struct Lisp_Process
*p
;
1075 CHECK_PROCESS (process
);
1076 p
= XPROCESS (process
);
1078 p
->sentinel
= sentinel
;
1080 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1084 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1086 doc
: /* Return the sentinel of PROCESS; nil if none.
1087 See `set-process-sentinel' for more info on sentinels. */)
1089 register Lisp_Object process
;
1091 CHECK_PROCESS (process
);
1092 return XPROCESS (process
)->sentinel
;
1095 DEFUN ("set-process-window-size", Fset_process_window_size
,
1096 Sset_process_window_size
, 3, 3, 0,
1097 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1098 (process
, height
, width
)
1099 register Lisp_Object process
, height
, width
;
1101 CHECK_PROCESS (process
);
1102 CHECK_NATNUM (height
);
1103 CHECK_NATNUM (width
);
1105 if (XPROCESS (process
)->infd
< 0
1106 || set_window_size (XPROCESS (process
)->infd
,
1107 XINT (height
), XINT (width
)) <= 0)
1113 DEFUN ("set-process-inherit-coding-system-flag",
1114 Fset_process_inherit_coding_system_flag
,
1115 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1116 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1117 If the second argument FLAG is non-nil, then the variable
1118 `buffer-file-coding-system' of the buffer associated with PROCESS
1119 will be bound to the value of the coding system used to decode
1122 This is useful when the coding system specified for the process buffer
1123 leaves either the character code conversion or the end-of-line conversion
1124 unspecified, or if the coding system used to decode the process output
1125 is more appropriate for saving the process buffer.
1127 Binding the variable `inherit-process-coding-system' to non-nil before
1128 starting the process is an alternative way of setting the inherit flag
1129 for the process which will run. */)
1131 register Lisp_Object process
, flag
;
1133 CHECK_PROCESS (process
);
1134 XPROCESS (process
)->inherit_coding_system_flag
= !NILP (flag
);
1138 DEFUN ("process-inherit-coding-system-flag",
1139 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1141 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1142 If this flag is t, `buffer-file-coding-system' of the buffer
1143 associated with PROCESS will inherit the coding system used to decode
1144 the process output. */)
1146 register Lisp_Object process
;
1148 CHECK_PROCESS (process
);
1149 return XPROCESS (process
)->inherit_coding_system_flag
? Qt
: Qnil
;
1152 DEFUN ("set-process-query-on-exit-flag",
1153 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1155 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1156 If the second argument FLAG is non-nil, Emacs will query the user before
1157 exiting if PROCESS is running. */)
1159 register Lisp_Object process
, flag
;
1161 CHECK_PROCESS (process
);
1162 XPROCESS (process
)->kill_without_query
= NILP (flag
);
1166 DEFUN ("process-query-on-exit-flag",
1167 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1169 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1171 register Lisp_Object process
;
1173 CHECK_PROCESS (process
);
1174 return (XPROCESS (process
)->kill_without_query
? Qnil
: Qt
);
1177 #ifdef DATAGRAM_SOCKETS
1178 Lisp_Object
Fprocess_datagram_address ();
1181 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1183 doc
: /* Return the contact info of PROCESS; t for a real child.
1184 For a net connection, the value depends on the optional KEY arg.
1185 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1186 if KEY is t, the complete contact information for the connection is
1187 returned, else the specific value for the keyword KEY is returned.
1188 See `make-network-process' for a list of keywords. */)
1190 register Lisp_Object process
, key
;
1192 Lisp_Object contact
;
1194 CHECK_PROCESS (process
);
1195 contact
= XPROCESS (process
)->childp
;
1197 #ifdef DATAGRAM_SOCKETS
1198 if (DATAGRAM_CONN_P (process
)
1199 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1200 contact
= Fplist_put (contact
, QCremote
,
1201 Fprocess_datagram_address (process
));
1204 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1207 return Fcons (Fplist_get (contact
, QChost
),
1208 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1209 return Fplist_get (contact
, key
);
1212 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1214 doc
: /* Return the plist of PROCESS. */)
1216 register Lisp_Object process
;
1218 CHECK_PROCESS (process
);
1219 return XPROCESS (process
)->plist
;
1222 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1224 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1226 register Lisp_Object process
, plist
;
1228 CHECK_PROCESS (process
);
1231 XPROCESS (process
)->plist
= plist
;
1235 #if 0 /* Turned off because we don't currently record this info
1236 in the process. Perhaps add it. */
1237 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1238 doc
: /* Return the connection type of PROCESS.
1239 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1240 a socket connection. */)
1242 Lisp_Object process
;
1244 return XPROCESS (process
)->type
;
1249 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1251 doc
: /* Convert network ADDRESS from internal format to a string.
1252 A 4 or 5 element vector represents an IPv4 address (with port number).
1253 An 8 or 9 element vector represents an IPv6 address (with port number).
1254 If optional second argument OMIT-PORT is non-nil, don't include a port
1255 number in the string, even when present in ADDRESS.
1256 Returns nil if format of ADDRESS is invalid. */)
1257 (address
, omit_port
)
1258 Lisp_Object address
, omit_port
;
1263 if (STRINGP (address
)) /* AF_LOCAL */
1266 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1268 register struct Lisp_Vector
*p
= XVECTOR (address
);
1269 Lisp_Object args
[10];
1272 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1274 args
[0] = build_string ("%d.%d.%d.%d");
1277 else if (p
->size
== 5)
1279 args
[0] = build_string ("%d.%d.%d.%d:%d");
1282 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1284 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1287 else if (p
->size
== 9)
1289 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1295 for (i
= 0; i
< nargs
; i
++)
1297 EMACS_INT element
= XINT (p
->contents
[i
]);
1299 if (element
< 0 || element
> 65535)
1302 if (nargs
<= 5 /* IPv4 */
1303 && i
< 4 /* host, not port */
1307 args
[i
+1] = p
->contents
[i
];
1310 return Fformat (nargs
+1, args
);
1313 if (CONSP (address
))
1315 Lisp_Object args
[2];
1316 args
[0] = build_string ("<Family %d>");
1317 args
[1] = Fcar (address
);
1318 return Fformat (2, args
);
1326 list_processes_1 (query_only
)
1327 Lisp_Object query_only
;
1329 register Lisp_Object tail
, tem
;
1330 Lisp_Object proc
, minspace
, tem1
;
1331 register struct Lisp_Process
*p
;
1333 int w_proc
, w_buffer
, w_tty
;
1335 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1337 w_proc
= 4; /* Proc */
1338 w_buffer
= 6; /* Buffer */
1339 w_tty
= 0; /* Omit if no ttys */
1341 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1345 proc
= Fcdr (Fcar (tail
));
1346 p
= XPROCESS (proc
);
1347 if (NILP (p
->childp
))
1349 if (!NILP (query_only
) && p
->kill_without_query
)
1351 if (STRINGP (p
->name
)
1352 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1354 if (!NILP (p
->buffer
))
1356 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1357 w_buffer
= 8; /* (Killed) */
1358 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1361 if (STRINGP (p
->tty_name
)
1362 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1366 XSETFASTINT (i_status
, w_proc
+ 1);
1367 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1370 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1371 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1374 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1377 XSETFASTINT (minspace
, 1);
1379 set_buffer_internal (XBUFFER (Vstandard_output
));
1380 current_buffer
->undo_list
= Qt
;
1382 current_buffer
->truncate_lines
= Qt
;
1384 write_string ("Proc", -1);
1385 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1386 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1389 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1391 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1392 write_string ("\n", -1);
1394 write_string ("----", -1);
1395 Findent_to (i_status
, minspace
); write_string ("------", -1);
1396 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1399 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1401 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1402 write_string ("\n", -1);
1404 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1408 proc
= Fcdr (Fcar (tail
));
1409 p
= XPROCESS (proc
);
1410 if (NILP (p
->childp
))
1412 if (!NILP (query_only
) && p
->kill_without_query
)
1415 Finsert (1, &p
->name
);
1416 Findent_to (i_status
, minspace
);
1418 if (p
->raw_status_new
)
1421 if (CONSP (p
->status
))
1422 symbol
= XCAR (p
->status
);
1424 if (EQ (symbol
, Qsignal
))
1427 tem
= Fcar (Fcdr (p
->status
));
1429 if (XINT (tem
) < NSIG
)
1430 write_string (sys_errlist
[XINT (tem
)], -1);
1433 Fprinc (symbol
, Qnil
);
1435 else if (NETCONN1_P (p
))
1437 if (EQ (symbol
, Qexit
))
1438 write_string ("closed", -1);
1439 else if (EQ (p
->command
, Qt
))
1440 write_string ("stopped", -1);
1441 else if (EQ (symbol
, Qrun
))
1442 write_string ("open", -1);
1444 Fprinc (symbol
, Qnil
);
1447 Fprinc (symbol
, Qnil
);
1449 if (EQ (symbol
, Qexit
))
1452 tem
= Fcar (Fcdr (p
->status
));
1455 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1456 write_string (tembuf
, -1);
1460 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
) || EQ (symbol
, Qclosed
))
1463 Findent_to (i_buffer
, minspace
);
1464 if (NILP (p
->buffer
))
1465 insert_string ("(none)");
1466 else if (NILP (XBUFFER (p
->buffer
)->name
))
1467 insert_string ("(Killed)");
1469 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1473 Findent_to (i_tty
, minspace
);
1474 if (STRINGP (p
->tty_name
))
1475 Finsert (1, &p
->tty_name
);
1478 Findent_to (i_command
, minspace
);
1480 if (EQ (p
->status
, Qlisten
))
1482 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1483 if (INTEGERP (port
))
1484 port
= Fnumber_to_string (port
);
1486 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1487 sprintf (tembuf
, "(network %s server on %s)\n",
1488 (DATAGRAM_CHAN_P (p
->infd
) ? "datagram" : "stream"),
1489 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1490 insert_string (tembuf
);
1492 else if (NETCONN1_P (p
))
1494 /* For a local socket, there is no host name,
1495 so display service instead. */
1496 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1497 if (!STRINGP (host
))
1499 host
= Fplist_get (p
->childp
, QCservice
);
1500 if (INTEGERP (host
))
1501 host
= Fnumber_to_string (host
);
1504 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1505 sprintf (tembuf
, "(network %s connection to %s)\n",
1506 (DATAGRAM_CHAN_P (p
->infd
) ? "datagram" : "stream"),
1507 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1508 insert_string (tembuf
);
1520 insert_string (" ");
1522 insert_string ("\n");
1526 status_notify (NULL
);
1530 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1531 doc
: /* Display a list of all processes.
1532 If optional argument QUERY-ONLY is non-nil, only processes with
1533 the query-on-exit flag set will be listed.
1534 Any process listed as exited or signaled is actually eliminated
1535 after the listing is made. */)
1537 Lisp_Object query_only
;
1539 internal_with_output_to_temp_buffer ("*Process List*",
1540 list_processes_1
, query_only
);
1544 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1545 doc
: /* Return a list of all processes. */)
1548 return Fmapcar (Qcdr
, Vprocess_alist
);
1551 /* Starting asynchronous inferior processes. */
1553 static Lisp_Object
start_process_unwind ();
1555 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1556 doc
: /* Start a program in a subprocess. Return the process object for it.
1557 NAME is name for process. It is modified if necessary to make it unique.
1558 BUFFER is the buffer (or buffer name) to associate with the process.
1560 Process output (both standard output and standard error streams) goes
1561 at end of BUFFER, unless you specify an output stream or filter
1562 function to handle the output. BUFFER may also be nil, meaning that
1563 this process is not associated with any buffer.
1565 PROGRAM is the program file name. It is searched for in PATH.
1566 Remaining arguments are strings to give program as arguments.
1568 If you want to separate standard output from standard error, invoke
1569 the command through a shell and redirect one of them using the shell
1572 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1575 register Lisp_Object
*args
;
1577 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1579 register unsigned char *new_argv
;
1582 register unsigned char **new_argv
;
1585 int count
= SPECPDL_INDEX ();
1589 buffer
= Fget_buffer_create (buffer
);
1591 /* Make sure that the child will be able to chdir to the current
1592 buffer's current directory, or its unhandled equivalent. We
1593 can't just have the child check for an error when it does the
1594 chdir, since it's in a vfork.
1596 We have to GCPRO around this because Fexpand_file_name and
1597 Funhandled_file_name_directory might call a file name handling
1598 function. The argument list is protected by the caller, so all
1599 we really have to worry about is buffer. */
1601 struct gcpro gcpro1
, gcpro2
;
1603 current_dir
= current_buffer
->directory
;
1605 GCPRO2 (buffer
, current_dir
);
1608 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1610 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1611 report_file_error ("Setting current directory",
1612 Fcons (current_buffer
->directory
, Qnil
));
1618 CHECK_STRING (name
);
1622 CHECK_STRING (program
);
1624 proc
= make_process (name
);
1625 /* If an error occurs and we can't start the process, we want to
1626 remove it from the process list. This means that each error
1627 check in create_process doesn't need to call remove_process
1628 itself; it's all taken care of here. */
1629 record_unwind_protect (start_process_unwind
, proc
);
1631 XPROCESS (proc
)->childp
= Qt
;
1632 XPROCESS (proc
)->plist
= Qnil
;
1633 XPROCESS (proc
)->buffer
= buffer
;
1634 XPROCESS (proc
)->sentinel
= Qnil
;
1635 XPROCESS (proc
)->filter
= Qnil
;
1636 XPROCESS (proc
)->filter_multibyte
1637 = !NILP (buffer_defaults
.enable_multibyte_characters
);
1638 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1640 #ifdef ADAPTIVE_READ_BUFFERING
1641 XPROCESS (proc
)->adaptive_read_buffering
1642 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
1643 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
1646 /* Make the process marker point into the process buffer (if any). */
1647 if (BUFFERP (buffer
))
1648 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1649 BUF_ZV (XBUFFER (buffer
)),
1650 BUF_ZV_BYTE (XBUFFER (buffer
)));
1653 /* Decide coding systems for communicating with the process. Here
1654 we don't setup the structure coding_system nor pay attention to
1655 unibyte mode. They are done in create_process. */
1657 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1658 Lisp_Object coding_systems
= Qt
;
1659 Lisp_Object val
, *args2
;
1660 struct gcpro gcpro1
, gcpro2
;
1662 val
= Vcoding_system_for_read
;
1665 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1666 args2
[0] = Qstart_process
;
1667 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1668 GCPRO2 (proc
, current_dir
);
1669 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1671 if (CONSP (coding_systems
))
1672 val
= XCAR (coding_systems
);
1673 else if (CONSP (Vdefault_process_coding_system
))
1674 val
= XCAR (Vdefault_process_coding_system
);
1676 XPROCESS (proc
)->decode_coding_system
= val
;
1678 val
= Vcoding_system_for_write
;
1681 if (EQ (coding_systems
, Qt
))
1683 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1684 args2
[0] = Qstart_process
;
1685 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1686 GCPRO2 (proc
, current_dir
);
1687 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1690 if (CONSP (coding_systems
))
1691 val
= XCDR (coding_systems
);
1692 else if (CONSP (Vdefault_process_coding_system
))
1693 val
= XCDR (Vdefault_process_coding_system
);
1695 XPROCESS (proc
)->encode_coding_system
= val
;
1699 /* Make a one member argv with all args concatenated
1700 together separated by a blank. */
1701 len
= SBYTES (program
) + 2;
1702 for (i
= 3; i
< nargs
; i
++)
1706 len
+= SBYTES (tem
) + 1; /* count the blank */
1708 new_argv
= (unsigned char *) alloca (len
);
1709 strcpy (new_argv
, SDATA (program
));
1710 for (i
= 3; i
< nargs
; i
++)
1714 strcat (new_argv
, " ");
1715 strcat (new_argv
, SDATA (tem
));
1717 /* Need to add code here to check for program existence on VMS */
1720 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1722 /* If program file name is not absolute, search our path for it.
1723 Put the name we will really use in TEM. */
1724 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1725 && !(SCHARS (program
) > 1
1726 && IS_DEVICE_SEP (SREF (program
, 1))))
1728 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1731 GCPRO4 (name
, program
, buffer
, current_dir
);
1732 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1735 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1736 tem
= Fexpand_file_name (tem
, Qnil
);
1740 if (!NILP (Ffile_directory_p (program
)))
1741 error ("Specified program for new process is a directory");
1745 /* If program file name starts with /: for quoting a magic name,
1747 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1748 && SREF (tem
, 1) == ':')
1749 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1751 /* Encode the file name and put it in NEW_ARGV.
1752 That's where the child will use it to execute the program. */
1753 tem
= ENCODE_FILE (tem
);
1754 new_argv
[0] = SDATA (tem
);
1756 /* Here we encode arguments by the coding system used for sending
1757 data to the process. We don't support using different coding
1758 systems for encoding arguments and for encoding data sent to the
1761 for (i
= 3; i
< nargs
; i
++)
1765 if (STRING_MULTIBYTE (tem
))
1766 tem
= (code_convert_string_norecord
1767 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1768 new_argv
[i
- 2] = SDATA (tem
);
1770 new_argv
[i
- 2] = 0;
1771 #endif /* not VMS */
1773 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1774 XPROCESS (proc
)->decoding_carryover
= 0;
1775 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1777 XPROCESS (proc
)->inherit_coding_system_flag
1778 = !(NILP (buffer
) || !inherit_process_coding_system
);
1780 create_process (proc
, (char **) new_argv
, current_dir
);
1782 return unbind_to (count
, proc
);
1785 /* This function is the unwind_protect form for Fstart_process. If
1786 PROC doesn't have its pid set, then we know someone has signaled
1787 an error and the process wasn't started successfully, so we should
1788 remove it from the process list. */
1790 start_process_unwind (proc
)
1793 if (!PROCESSP (proc
))
1796 /* Was PROC started successfully? */
1797 if (XPROCESS (proc
)->pid
<= 0)
1798 remove_process (proc
);
1804 create_process_1 (timer
)
1805 struct atimer
*timer
;
1807 /* Nothing to do. */
1811 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1814 /* Mimic blocking of signals on system V, which doesn't really have it. */
1816 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1817 int sigchld_deferred
;
1820 create_process_sigchld ()
1822 signal (SIGCHLD
, create_process_sigchld
);
1824 sigchld_deferred
= 1;
1830 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1832 create_process (process
, new_argv
, current_dir
)
1833 Lisp_Object process
;
1835 Lisp_Object current_dir
;
1837 int inchannel
, outchannel
;
1840 #ifdef POSIX_SIGNALS
1843 struct sigaction sigint_action
;
1844 struct sigaction sigquit_action
;
1846 struct sigaction sighup_action
;
1848 #else /* !POSIX_SIGNALS */
1851 SIGTYPE (*sigchld
)();
1854 #endif /* !POSIX_SIGNALS */
1855 /* Use volatile to protect variables from being clobbered by longjmp. */
1856 volatile int forkin
, forkout
;
1857 volatile int pty_flag
= 0;
1859 extern char **environ
;
1862 inchannel
= outchannel
= -1;
1865 if (!NILP (Vprocess_connection_type
))
1866 outchannel
= inchannel
= allocate_pty ();
1870 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1871 /* On most USG systems it does not work to open the pty's tty here,
1872 then close it and reopen it in the child. */
1874 /* Don't let this terminal become our controlling terminal
1875 (in case we don't have one). */
1876 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1878 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1881 report_file_error ("Opening pty", Qnil
);
1882 #if defined (RTU) || defined (UNIPLUS) || defined (DONT_REOPEN_PTY)
1883 /* In the case that vfork is defined as fork, the parent process
1884 (Emacs) may send some data before the child process completes
1885 tty options setup. So we setup tty before forking. */
1886 child_setup_tty (forkout
);
1887 #endif /* RTU or UNIPLUS or DONT_REOPEN_PTY */
1889 forkin
= forkout
= -1;
1890 #endif /* not USG, or USG_SUBTTY_WORKS */
1894 #endif /* HAVE_PTYS */
1897 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1898 report_file_error ("Opening socketpair", Qnil
);
1899 outchannel
= inchannel
= sv
[0];
1900 forkout
= forkin
= sv
[1];
1902 #else /* not SKTPAIR */
1907 report_file_error ("Creating pipe", Qnil
);
1913 emacs_close (inchannel
);
1914 emacs_close (forkout
);
1915 report_file_error ("Creating pipe", Qnil
);
1920 #endif /* not SKTPAIR */
1923 /* Replaced by close_process_descs */
1924 set_exclusive_use (inchannel
);
1925 set_exclusive_use (outchannel
);
1928 /* Stride people say it's a mystery why this is needed
1929 as well as the O_NDELAY, but that it fails without this. */
1930 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1933 ioctl (inchannel
, FIONBIO
, &one
);
1938 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1939 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1942 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1943 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1947 /* Record this as an active process, with its channels.
1948 As a result, child_setup will close Emacs's side of the pipes. */
1949 chan_process
[inchannel
] = process
;
1950 XPROCESS (process
)->infd
= inchannel
;
1951 XPROCESS (process
)->outfd
= outchannel
;
1953 /* Previously we recorded the tty descriptor used in the subprocess.
1954 It was only used for getting the foreground tty process, so now
1955 we just reopen the device (see emacs_get_tty_pgrp) as this is
1956 more portable (see USG_SUBTTY_WORKS above). */
1958 XPROCESS (process
)->pty_flag
= pty_flag
;
1959 XPROCESS (process
)->status
= Qrun
;
1960 setup_process_coding_systems (process
);
1962 /* Delay interrupts until we have a chance to store
1963 the new fork's pid in its process structure */
1964 #ifdef POSIX_SIGNALS
1965 sigemptyset (&blocked
);
1967 sigaddset (&blocked
, SIGCHLD
);
1969 #ifdef HAVE_WORKING_VFORK
1970 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1971 this sets the parent's signal handlers as well as the child's.
1972 So delay all interrupts whose handlers the child might munge,
1973 and record the current handlers so they can be restored later. */
1974 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1975 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1977 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1979 #endif /* HAVE_WORKING_VFORK */
1980 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1981 #else /* !POSIX_SIGNALS */
1985 #else /* not BSD4_1 */
1986 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1987 sigsetmask (sigmask (SIGCHLD
));
1988 #else /* ordinary USG */
1990 sigchld_deferred
= 0;
1991 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1993 #endif /* ordinary USG */
1994 #endif /* not BSD4_1 */
1995 #endif /* SIGCHLD */
1996 #endif /* !POSIX_SIGNALS */
1998 FD_SET (inchannel
, &input_wait_mask
);
1999 FD_SET (inchannel
, &non_keyboard_wait_mask
);
2000 if (inchannel
> max_process_desc
)
2001 max_process_desc
= inchannel
;
2003 /* Until we store the proper pid, enable sigchld_handler
2004 to recognize an unknown pid as standing for this process.
2005 It is very important not to let this `marker' value stay
2006 in the table after this function has returned; if it does
2007 it might cause call-process to hang and subsequent asynchronous
2008 processes to get their return values scrambled. */
2009 XPROCESS (process
)->pid
= -1;
2014 /* child_setup must clobber environ on systems with true vfork.
2015 Protect it from permanent change. */
2016 char **save_environ
= environ
;
2018 current_dir
= ENCODE_FILE (current_dir
);
2023 #endif /* not WINDOWSNT */
2025 int xforkin
= forkin
;
2026 int xforkout
= forkout
;
2028 #if 0 /* This was probably a mistake--it duplicates code later on,
2029 but fails to handle all the cases. */
2030 /* Make sure SIGCHLD is not blocked in the child. */
2031 sigsetmask (SIGEMPTYMASK
);
2034 /* Make the pty be the controlling terminal of the process. */
2036 /* First, disconnect its current controlling terminal. */
2038 /* We tried doing setsid only if pty_flag, but it caused
2039 process_set_signal to fail on SGI when using a pipe. */
2041 /* Make the pty's terminal the controlling terminal. */
2045 /* We ignore the return value
2046 because faith@cs.unc.edu says that is necessary on Linux. */
2047 ioctl (xforkin
, TIOCSCTTY
, 0);
2050 #else /* not HAVE_SETSID */
2052 /* It's very important to call setpgrp here and no time
2053 afterwards. Otherwise, we lose our controlling tty which
2054 is set when we open the pty. */
2057 #endif /* not HAVE_SETSID */
2058 #if defined (HAVE_TERMIOS) && defined (LDISC1)
2059 if (pty_flag
&& xforkin
>= 0)
2062 tcgetattr (xforkin
, &t
);
2064 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
2065 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
2068 #if defined (NTTYDISC) && defined (TIOCSETD)
2069 if (pty_flag
&& xforkin
>= 0)
2071 /* Use new line discipline. */
2072 int ldisc
= NTTYDISC
;
2073 ioctl (xforkin
, TIOCSETD
, &ldisc
);
2078 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2079 can do TIOCSPGRP only to the process's controlling tty. */
2082 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2083 I can't test it since I don't have 4.3. */
2084 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
2085 ioctl (j
, TIOCNOTTY
, 0);
2088 /* In order to get a controlling terminal on some versions
2089 of BSD, it is necessary to put the process in pgrp 0
2090 before it opens the terminal. */
2098 #endif /* TIOCNOTTY */
2100 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2101 /*** There is a suggestion that this ought to be a
2102 conditional on TIOCSPGRP,
2103 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2104 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2105 that system does seem to need this code, even though
2106 both HAVE_SETSID and TIOCSCTTY are defined. */
2107 /* Now close the pty (if we had it open) and reopen it.
2108 This makes the pty the controlling terminal of the subprocess. */
2111 #ifdef SET_CHILD_PTY_PGRP
2112 int pgrp
= getpid ();
2115 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2118 emacs_close (xforkin
);
2119 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2123 emacs_write (1, "Couldn't open the pty terminal ", 31);
2124 emacs_write (1, pty_name
, strlen (pty_name
));
2125 emacs_write (1, "\n", 1);
2129 #ifdef SET_CHILD_PTY_PGRP
2130 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
2131 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
2134 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
2136 #ifdef SETUP_SLAVE_PTY
2141 #endif /* SETUP_SLAVE_PTY */
2143 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2144 Now reenable it in the child, so it will die when we want it to. */
2146 signal (SIGHUP
, SIG_DFL
);
2148 #endif /* HAVE_PTYS */
2150 signal (SIGINT
, SIG_DFL
);
2151 signal (SIGQUIT
, SIG_DFL
);
2153 /* Stop blocking signals in the child. */
2154 #ifdef POSIX_SIGNALS
2155 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2156 #else /* !POSIX_SIGNALS */
2160 #else /* not BSD4_1 */
2161 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2162 sigsetmask (SIGEMPTYMASK
);
2163 #else /* ordinary USG */
2165 signal (SIGCHLD
, sigchld
);
2167 #endif /* ordinary USG */
2168 #endif /* not BSD4_1 */
2169 #endif /* SIGCHLD */
2170 #endif /* !POSIX_SIGNALS */
2172 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2174 child_setup_tty (xforkout
);
2175 #endif /* not RTU and not UNIPLUS and not DONT_REOPEN_PTY */
2177 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2178 new_argv
, 1, current_dir
);
2179 #else /* not WINDOWSNT */
2180 child_setup (xforkin
, xforkout
, xforkout
,
2181 new_argv
, 1, current_dir
);
2182 #endif /* not WINDOWSNT */
2184 environ
= save_environ
;
2189 /* This runs in the Emacs process. */
2193 emacs_close (forkin
);
2194 if (forkin
!= forkout
&& forkout
>= 0)
2195 emacs_close (forkout
);
2199 /* vfork succeeded. */
2200 XPROCESS (process
)->pid
= pid
;
2203 register_child (pid
, inchannel
);
2204 #endif /* WINDOWSNT */
2206 /* If the subfork execv fails, and it exits,
2207 this close hangs. I don't know why.
2208 So have an interrupt jar it loose. */
2210 struct atimer
*timer
;
2214 EMACS_SET_SECS_USECS (offset
, 1, 0);
2215 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2218 emacs_close (forkin
);
2220 cancel_atimer (timer
);
2224 if (forkin
!= forkout
&& forkout
>= 0)
2225 emacs_close (forkout
);
2229 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2232 XPROCESS (process
)->tty_name
= Qnil
;
2235 /* Restore the signal state whether vfork succeeded or not.
2236 (We will signal an error, below, if it failed.) */
2237 #ifdef POSIX_SIGNALS
2238 #ifdef HAVE_WORKING_VFORK
2239 /* Restore the parent's signal handlers. */
2240 sigaction (SIGINT
, &sigint_action
, 0);
2241 sigaction (SIGQUIT
, &sigquit_action
, 0);
2243 sigaction (SIGHUP
, &sighup_action
, 0);
2245 #endif /* HAVE_WORKING_VFORK */
2246 /* Stop blocking signals in the parent. */
2247 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2248 #else /* !POSIX_SIGNALS */
2252 #else /* not BSD4_1 */
2253 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2254 sigsetmask (SIGEMPTYMASK
);
2255 #else /* ordinary USG */
2257 signal (SIGCHLD
, sigchld
);
2258 /* Now really handle any of these signals
2259 that came in during this function. */
2260 if (sigchld_deferred
)
2261 kill (getpid (), SIGCHLD
);
2263 #endif /* ordinary USG */
2264 #endif /* not BSD4_1 */
2265 #endif /* SIGCHLD */
2266 #endif /* !POSIX_SIGNALS */
2268 /* Now generate the error if vfork failed. */
2270 report_file_error ("Doing vfork", Qnil
);
2272 #endif /* not VMS */
2277 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2278 The address family of sa is not included in the result. */
2281 conv_sockaddr_to_lisp (sa
, len
)
2282 struct sockaddr
*sa
;
2285 Lisp_Object address
;
2288 register struct Lisp_Vector
*p
;
2290 switch (sa
->sa_family
)
2294 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2295 len
= sizeof (sin
->sin_addr
) + 1;
2296 address
= Fmake_vector (make_number (len
), Qnil
);
2297 p
= XVECTOR (address
);
2298 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2299 cp
= (unsigned char *)&sin
->sin_addr
;
2305 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2306 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2307 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2308 address
= Fmake_vector (make_number (len
), Qnil
);
2309 p
= XVECTOR (address
);
2310 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2311 for (i
= 0; i
< len
; i
++)
2312 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2316 #ifdef HAVE_LOCAL_SOCKETS
2319 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2320 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2321 if (sockun
->sun_path
[i
] == 0)
2323 return make_unibyte_string (sockun
->sun_path
, i
);
2327 len
-= sizeof (sa
->sa_family
);
2328 address
= Fcons (make_number (sa
->sa_family
),
2329 Fmake_vector (make_number (len
), Qnil
));
2330 p
= XVECTOR (XCDR (address
));
2331 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2337 p
->contents
[i
++] = make_number (*cp
++);
2343 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2346 get_lisp_to_sockaddr_size (address
, familyp
)
2347 Lisp_Object address
;
2350 register struct Lisp_Vector
*p
;
2352 if (VECTORP (address
))
2354 p
= XVECTOR (address
);
2358 return sizeof (struct sockaddr_in
);
2361 else if (p
->size
== 9)
2363 *familyp
= AF_INET6
;
2364 return sizeof (struct sockaddr_in6
);
2368 #ifdef HAVE_LOCAL_SOCKETS
2369 else if (STRINGP (address
))
2371 *familyp
= AF_LOCAL
;
2372 return sizeof (struct sockaddr_un
);
2375 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2377 struct sockaddr
*sa
;
2378 *familyp
= XINT (XCAR (address
));
2379 p
= XVECTOR (XCDR (address
));
2380 return p
->size
+ sizeof (sa
->sa_family
);
2385 /* Convert an address object (vector or string) to an internal sockaddr.
2387 The address format has been basically validated by
2388 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2389 it could have come from user data. So if FAMILY is not valid,
2390 we return after zeroing *SA. */
2393 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2395 Lisp_Object address
;
2396 struct sockaddr
*sa
;
2399 register struct Lisp_Vector
*p
;
2400 register unsigned char *cp
= NULL
;
2405 if (VECTORP (address
))
2407 p
= XVECTOR (address
);
2408 if (family
== AF_INET
)
2410 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2411 len
= sizeof (sin
->sin_addr
) + 1;
2412 i
= XINT (p
->contents
[--len
]);
2413 sin
->sin_port
= htons (i
);
2414 cp
= (unsigned char *)&sin
->sin_addr
;
2415 sa
->sa_family
= family
;
2418 else if (family
== AF_INET6
)
2420 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2421 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2422 len
= sizeof (sin6
->sin6_addr
) + 1;
2423 i
= XINT (p
->contents
[--len
]);
2424 sin6
->sin6_port
= htons (i
);
2425 for (i
= 0; i
< len
; i
++)
2426 if (INTEGERP (p
->contents
[i
]))
2428 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2431 sa
->sa_family
= family
;
2436 else if (STRINGP (address
))
2438 #ifdef HAVE_LOCAL_SOCKETS
2439 if (family
== AF_LOCAL
)
2441 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2442 cp
= SDATA (address
);
2443 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2444 sockun
->sun_path
[i
] = *cp
++;
2445 sa
->sa_family
= family
;
2452 p
= XVECTOR (XCDR (address
));
2453 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2456 for (i
= 0; i
< len
; i
++)
2457 if (INTEGERP (p
->contents
[i
]))
2458 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2461 #ifdef DATAGRAM_SOCKETS
2462 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2464 doc
: /* Get the current datagram address associated with PROCESS. */)
2466 Lisp_Object process
;
2470 CHECK_PROCESS (process
);
2472 if (!DATAGRAM_CONN_P (process
))
2475 channel
= XPROCESS (process
)->infd
;
2476 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2477 datagram_address
[channel
].len
);
2480 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2482 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2483 Returns nil upon error setting address, ADDRESS otherwise. */)
2485 Lisp_Object process
, address
;
2490 CHECK_PROCESS (process
);
2492 if (!DATAGRAM_CONN_P (process
))
2495 channel
= XPROCESS (process
)->infd
;
2497 len
= get_lisp_to_sockaddr_size (address
, &family
);
2498 if (datagram_address
[channel
].len
!= len
)
2500 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2506 static struct socket_options
{
2507 /* The name of this option. Should be lowercase version of option
2508 name without SO_ prefix. */
2510 /* Option level SOL_... */
2512 /* Option number SO_... */
2514 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2515 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2516 } socket_options
[] =
2518 #ifdef SO_BINDTODEVICE
2519 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2522 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2525 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2528 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2531 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2534 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2537 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2540 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2542 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2545 /* Set option OPT to value VAL on socket S.
2547 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2548 Signals an error if setting a known option fails.
2552 set_socket_option (s
, opt
, val
)
2554 Lisp_Object opt
, val
;
2557 struct socket_options
*sopt
;
2562 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2563 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2564 if (strcmp (name
, sopt
->name
) == 0)
2567 switch (sopt
->opttype
)
2572 optval
= NILP (val
) ? 0 : 1;
2573 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2574 &optval
, sizeof (optval
));
2582 optval
= XINT (val
);
2584 error ("Bad option value for %s", name
);
2585 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2586 &optval
, sizeof (optval
));
2590 #ifdef SO_BINDTODEVICE
2593 char devname
[IFNAMSIZ
+1];
2595 /* This is broken, at least in the Linux 2.4 kernel.
2596 To unbind, the arg must be a zero integer, not the empty string.
2597 This should work on all systems. KFS. 2003-09-23. */
2598 bzero (devname
, sizeof devname
);
2601 char *arg
= (char *) SDATA (val
);
2602 int len
= min (strlen (arg
), IFNAMSIZ
);
2603 bcopy (arg
, devname
, len
);
2605 else if (!NILP (val
))
2606 error ("Bad option value for %s", name
);
2607 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2616 struct linger linger
;
2619 linger
.l_linger
= 0;
2621 linger
.l_linger
= XINT (val
);
2623 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2624 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2625 &linger
, sizeof (linger
));
2635 report_file_error ("Cannot set network option",
2636 Fcons (opt
, Fcons (val
, Qnil
)));
2637 return (1 << sopt
->optbit
);
2641 DEFUN ("set-network-process-option",
2642 Fset_network_process_option
, Sset_network_process_option
,
2644 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2645 See `make-network-process' for a list of options and values.
2646 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2647 OPTION is not a supported option, return nil instead; otherwise return t. */)
2648 (process
, option
, value
, no_error
)
2649 Lisp_Object process
, option
, value
;
2650 Lisp_Object no_error
;
2653 struct Lisp_Process
*p
;
2655 CHECK_PROCESS (process
);
2656 p
= XPROCESS (process
);
2657 if (!NETCONN1_P (p
))
2658 error ("Process is not a network process");
2662 error ("Process is not running");
2664 if (set_socket_option (s
, option
, value
))
2666 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2670 if (NILP (no_error
))
2671 error ("Unknown or unsupported option");
2677 /* A version of request_sigio suitable for a record_unwind_protect. */
2680 unwind_request_sigio (dummy
)
2683 if (interrupt_input
)
2688 /* Create a network stream/datagram client/server process. Treated
2689 exactly like a normal process when reading and writing. Primary
2690 differences are in status display and process deletion. A network
2691 connection has no PID; you cannot signal it. All you can do is
2692 stop/continue it and deactivate/close it via delete-process */
2694 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2696 doc
: /* Create and return a network server or client process.
2698 In Emacs, network connections are represented by process objects, so
2699 input and output work as for subprocesses and `delete-process' closes
2700 a network connection. However, a network process has no process id,
2701 it cannot be signaled, and the status codes are different from normal
2704 Arguments are specified as keyword/argument pairs. The following
2705 arguments are defined:
2707 :name NAME -- NAME is name for process. It is modified if necessary
2710 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2711 with the process. Process output goes at end of that buffer, unless
2712 you specify an output stream or filter function to handle the output.
2713 BUFFER may be also nil, meaning that this process is not associated
2716 :host HOST -- HOST is name of the host to connect to, or its IP
2717 address. The symbol `local' specifies the local host. If specified
2718 for a server process, it must be a valid name or address for the local
2719 host, and only clients connecting to that address will be accepted.
2721 :service SERVICE -- SERVICE is name of the service desired, or an
2722 integer specifying a port number to connect to. If SERVICE is t,
2723 a random port number is selected for the server.
2725 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2726 stream type connection, `datagram' creates a datagram type connection.
2728 :family FAMILY -- FAMILY is the address (and protocol) family for the
2729 service specified by HOST and SERVICE. The default (nil) is to use
2730 whatever address family (IPv4 or IPv6) that is defined for the host
2731 and port number specified by HOST and SERVICE. Other address families
2733 local -- for a local (i.e. UNIX) address specified by SERVICE.
2734 ipv4 -- use IPv4 address family only.
2735 ipv6 -- use IPv6 address family only.
2737 :local ADDRESS -- ADDRESS is the local address used for the connection.
2738 This parameter is ignored when opening a client process. When specified
2739 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2741 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2742 connection. This parameter is ignored when opening a stream server
2743 process. For a datagram server process, it specifies the initial
2744 setting of the remote datagram address. When specified for a client
2745 process, the FAMILY, HOST, and SERVICE args are ignored.
2747 The format of ADDRESS depends on the address family:
2748 - An IPv4 address is represented as an vector of integers [A B C D P]
2749 corresponding to numeric IP address A.B.C.D and port number P.
2750 - A local address is represented as a string with the address in the
2751 local address space.
2752 - An "unsupported family" address is represented by a cons (F . AV)
2753 where F is the family number and AV is a vector containing the socket
2754 address data with one element per address data byte. Do not rely on
2755 this format in portable code, as it may depend on implementation
2756 defined constants, data sizes, and data structure alignment.
2758 :coding CODING -- If CODING is a symbol, it specifies the coding
2759 system used for both reading and writing for this process. If CODING
2760 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2761 ENCODING is used for writing.
2763 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2764 return without waiting for the connection to complete; instead, the
2765 sentinel function will be called with second arg matching "open" (if
2766 successful) or "failed" when the connect completes. Default is to use
2767 a blocking connect (i.e. wait) for stream type connections.
2769 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2770 running when Emacs is exited.
2772 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2773 In the stopped state, a server process does not accept new
2774 connections, and a client process does not handle incoming traffic.
2775 The stopped state is cleared by `continue-process' and set by
2778 :filter FILTER -- Install FILTER as the process filter.
2780 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2781 process filter are multibyte, otherwise they are unibyte.
2782 If this keyword is not specified, the strings are multibyte iff
2783 `default-enable-multibyte-characters' is non-nil.
2785 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2787 :log LOG -- Install LOG as the server process log function. This
2788 function is called when the server accepts a network connection from a
2789 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2790 is the server process, CLIENT is the new process for the connection,
2791 and MESSAGE is a string.
2793 :plist PLIST -- Install PLIST as the new process' initial plist.
2795 :server QLEN -- if QLEN is non-nil, create a server process for the
2796 specified FAMILY, SERVICE, and connection type (stream or datagram).
2797 If QLEN is an integer, it is used as the max. length of the server's
2798 pending connection queue (also known as the backlog); the default
2799 queue length is 5. Default is to create a client process.
2801 The following network options can be specified for this connection:
2803 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2804 :dontroute BOOL -- Only send to directly connected hosts.
2805 :keepalive BOOL -- Send keep-alive messages on network stream.
2806 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2807 :oobinline BOOL -- Place out-of-band data in receive data stream.
2808 :priority INT -- Set protocol defined priority for sent packets.
2809 :reuseaddr BOOL -- Allow reusing a recently used local address
2810 (this is allowed by default for a server process).
2811 :bindtodevice NAME -- bind to interface NAME. Using this may require
2812 special privileges on some systems.
2814 Consult the relevant system programmer's manual pages for more
2815 information on using these options.
2818 A server process will listen for and accept connections from clients.
2819 When a client connection is accepted, a new network process is created
2820 for the connection with the following parameters:
2822 - The client's process name is constructed by concatenating the server
2823 process' NAME and a client identification string.
2824 - If the FILTER argument is non-nil, the client process will not get a
2825 separate process buffer; otherwise, the client's process buffer is a newly
2826 created buffer named after the server process' BUFFER name or process
2827 NAME concatenated with the client identification string.
2828 - The connection type and the process filter and sentinel parameters are
2829 inherited from the server process' TYPE, FILTER and SENTINEL.
2830 - The client process' contact info is set according to the client's
2831 addressing information (typically an IP address and a port number).
2832 - The client process' plist is initialized from the server's plist.
2834 Notice that the FILTER and SENTINEL args are never used directly by
2835 the server process. Also, the BUFFER argument is not used directly by
2836 the server process, but via the optional :log function, accepted (and
2837 failed) connections may be logged in the server process' buffer.
2839 The original argument list, modified with the actual connection
2840 information, is available via the `process-contact' function.
2842 usage: (make-network-process &rest ARGS) */)
2848 Lisp_Object contact
;
2849 struct Lisp_Process
*p
;
2850 #ifdef HAVE_GETADDRINFO
2851 struct addrinfo ai
, *res
, *lres
;
2852 struct addrinfo hints
;
2853 char *portstring
, portbuf
[128];
2854 #else /* HAVE_GETADDRINFO */
2855 struct _emacs_addrinfo
2861 struct sockaddr
*ai_addr
;
2862 struct _emacs_addrinfo
*ai_next
;
2864 #endif /* HAVE_GETADDRINFO */
2865 struct sockaddr_in address_in
;
2866 #ifdef HAVE_LOCAL_SOCKETS
2867 struct sockaddr_un address_un
;
2872 int s
= -1, outch
, inch
;
2873 struct gcpro gcpro1
;
2874 int count
= SPECPDL_INDEX ();
2876 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2878 Lisp_Object name
, buffer
, host
, service
, address
;
2879 Lisp_Object filter
, sentinel
;
2880 int is_non_blocking_client
= 0;
2881 int is_server
= 0, backlog
= 5;
2888 /* Save arguments for process-contact and clone-process. */
2889 contact
= Flist (nargs
, args
);
2893 /* Ensure socket support is loaded if available. */
2894 init_winsock (TRUE
);
2897 /* :type TYPE (nil: stream, datagram */
2898 tem
= Fplist_get (contact
, QCtype
);
2900 socktype
= SOCK_STREAM
;
2901 #ifdef DATAGRAM_SOCKETS
2902 else if (EQ (tem
, Qdatagram
))
2903 socktype
= SOCK_DGRAM
;
2906 error ("Unsupported connection type");
2909 tem
= Fplist_get (contact
, QCserver
);
2912 /* Don't support network sockets when non-blocking mode is
2913 not available, since a blocked Emacs is not useful. */
2914 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2915 error ("Network servers not supported");
2919 backlog
= XINT (tem
);
2923 /* Make QCaddress an alias for :local (server) or :remote (client). */
2924 QCaddress
= is_server
? QClocal
: QCremote
;
2927 if (!is_server
&& socktype
== SOCK_STREAM
2928 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2930 #ifndef NON_BLOCKING_CONNECT
2931 error ("Non-blocking connect not supported");
2933 is_non_blocking_client
= 1;
2937 name
= Fplist_get (contact
, QCname
);
2938 buffer
= Fplist_get (contact
, QCbuffer
);
2939 filter
= Fplist_get (contact
, QCfilter
);
2940 sentinel
= Fplist_get (contact
, QCsentinel
);
2942 CHECK_STRING (name
);
2945 /* Let's handle TERM before things get complicated ... */
2946 host
= Fplist_get (contact
, QChost
);
2947 CHECK_STRING (host
);
2949 service
= Fplist_get (contact
, QCservice
);
2950 if (INTEGERP (service
))
2951 port
= htons ((unsigned short) XINT (service
));
2954 struct servent
*svc_info
;
2955 CHECK_STRING (service
);
2956 svc_info
= getservbyname (SDATA (service
), "tcp");
2958 error ("Unknown service: %s", SDATA (service
));
2959 port
= svc_info
->s_port
;
2962 s
= connect_server (0);
2964 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2965 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2966 send_command (s
, C_DUMB
, 1, 0);
2968 #else /* not TERM */
2970 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2971 ai
.ai_socktype
= socktype
;
2976 /* :local ADDRESS or :remote ADDRESS */
2977 address
= Fplist_get (contact
, QCaddress
);
2978 if (!NILP (address
))
2980 host
= service
= Qnil
;
2982 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2983 error ("Malformed :address");
2984 ai
.ai_family
= family
;
2985 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2986 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2990 /* :family FAMILY -- nil (for Inet), local, or integer. */
2991 tem
= Fplist_get (contact
, QCfamily
);
2994 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
3000 #ifdef HAVE_LOCAL_SOCKETS
3001 else if (EQ (tem
, Qlocal
))
3005 else if (EQ (tem
, Qipv6
))
3008 else if (EQ (tem
, Qipv4
))
3010 else if (INTEGERP (tem
))
3011 family
= XINT (tem
);
3013 error ("Unknown address family");
3015 ai
.ai_family
= family
;
3017 /* :service SERVICE -- string, integer (port number), or t (random port). */
3018 service
= Fplist_get (contact
, QCservice
);
3020 #ifdef HAVE_LOCAL_SOCKETS
3021 if (family
== AF_LOCAL
)
3023 /* Host is not used. */
3025 CHECK_STRING (service
);
3026 bzero (&address_un
, sizeof address_un
);
3027 address_un
.sun_family
= AF_LOCAL
;
3028 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
3029 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
3030 ai
.ai_addrlen
= sizeof address_un
;
3035 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3036 host
= Fplist_get (contact
, QChost
);
3039 if (EQ (host
, Qlocal
))
3040 host
= build_string ("localhost");
3041 CHECK_STRING (host
);
3044 /* Slow down polling to every ten seconds.
3045 Some kernels have a bug which causes retrying connect to fail
3046 after a connect. Polling can interfere with gethostbyname too. */
3047 #ifdef POLL_FOR_INPUT
3048 if (socktype
== SOCK_STREAM
)
3050 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
3051 bind_polling_period (10);
3055 #ifdef HAVE_GETADDRINFO
3056 /* If we have a host, use getaddrinfo to resolve both host and service.
3057 Otherwise, use getservbyname to lookup the service. */
3061 /* SERVICE can either be a string or int.
3062 Convert to a C string for later use by getaddrinfo. */
3063 if (EQ (service
, Qt
))
3065 else if (INTEGERP (service
))
3067 sprintf (portbuf
, "%ld", (long) XINT (service
));
3068 portstring
= portbuf
;
3072 CHECK_STRING (service
);
3073 portstring
= SDATA (service
);
3078 memset (&hints
, 0, sizeof (hints
));
3080 hints
.ai_family
= family
;
3081 hints
.ai_socktype
= socktype
;
3082 hints
.ai_protocol
= 0;
3083 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3085 #ifdef HAVE_GAI_STRERROR
3086 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
3088 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3094 #endif /* HAVE_GETADDRINFO */
3096 /* We end up here if getaddrinfo is not defined, or in case no hostname
3097 has been specified (e.g. for a local server process). */
3099 if (EQ (service
, Qt
))
3101 else if (INTEGERP (service
))
3102 port
= htons ((unsigned short) XINT (service
));
3105 struct servent
*svc_info
;
3106 CHECK_STRING (service
);
3107 svc_info
= getservbyname (SDATA (service
),
3108 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3110 error ("Unknown service: %s", SDATA (service
));
3111 port
= svc_info
->s_port
;
3114 bzero (&address_in
, sizeof address_in
);
3115 address_in
.sin_family
= family
;
3116 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3117 address_in
.sin_port
= port
;
3119 #ifndef HAVE_GETADDRINFO
3122 struct hostent
*host_info_ptr
;
3124 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3125 as it may `hang' Emacs for a very long time. */
3128 host_info_ptr
= gethostbyname (SDATA (host
));
3133 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
3134 host_info_ptr
->h_length
);
3135 family
= host_info_ptr
->h_addrtype
;
3136 address_in
.sin_family
= family
;
3139 /* Attempt to interpret host as numeric inet address */
3141 IN_ADDR numeric_addr
;
3142 numeric_addr
= inet_addr ((char *) SDATA (host
));
3143 if (NUMERIC_ADDR_ERROR
)
3144 error ("Unknown host \"%s\"", SDATA (host
));
3146 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
3147 sizeof (address_in
.sin_addr
));
3151 #endif /* not HAVE_GETADDRINFO */
3153 ai
.ai_family
= family
;
3154 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3155 ai
.ai_addrlen
= sizeof address_in
;
3159 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
3160 when connect is interrupted. So let's not let it get interrupted.
3161 Note we do not turn off polling, because polling is only used
3162 when not interrupt_input, and thus not normally used on the systems
3163 which have this bug. On systems which use polling, there's no way
3164 to quit if polling is turned off. */
3166 && !is_server
&& socktype
== SOCK_STREAM
)
3168 /* Comment from KFS: The original open-network-stream code
3169 didn't unwind protect this, but it seems like the proper
3170 thing to do. In any case, I don't see how it could harm to
3171 do this -- and it makes cleanup (using unbind_to) easier. */
3172 record_unwind_protect (unwind_request_sigio
, Qnil
);
3176 /* Do this in case we never enter the for-loop below. */
3177 count1
= SPECPDL_INDEX ();
3180 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3186 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3193 #ifdef DATAGRAM_SOCKETS
3194 if (!is_server
&& socktype
== SOCK_DGRAM
)
3196 #endif /* DATAGRAM_SOCKETS */
3198 #ifdef NON_BLOCKING_CONNECT
3199 if (is_non_blocking_client
)
3202 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3204 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3216 /* Make us close S if quit. */
3217 record_unwind_protect (close_file_unwind
, make_number (s
));
3219 /* Parse network options in the arg list.
3220 We simply ignore anything which isn't a known option (including other keywords).
3221 An error is signalled if setting a known option fails. */
3222 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3223 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3227 /* Configure as a server socket. */
3229 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3230 explicit :reuseaddr key to override this. */
3231 #ifdef HAVE_LOCAL_SOCKETS
3232 if (family
!= AF_LOCAL
)
3234 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3237 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3238 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3241 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3242 report_file_error ("Cannot bind server socket", Qnil
);
3244 #ifdef HAVE_GETSOCKNAME
3245 if (EQ (service
, Qt
))
3247 struct sockaddr_in sa1
;
3248 int len1
= sizeof (sa1
);
3249 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3251 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3252 service
= make_number (ntohs (sa1
.sin_port
));
3253 contact
= Fplist_put (contact
, QCservice
, service
);
3258 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3259 report_file_error ("Cannot listen on server socket", Qnil
);
3267 /* This turns off all alarm-based interrupts; the
3268 bind_polling_period call above doesn't always turn all the
3269 short-interval ones off, especially if interrupt_input is
3272 It'd be nice to be able to control the connect timeout
3273 though. Would non-blocking connect calls be portable?
3275 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3277 turn_on_atimers (0);
3279 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3282 turn_on_atimers (1);
3284 if (ret
== 0 || xerrno
== EISCONN
)
3286 /* The unwind-protect will be discarded afterwards.
3287 Likewise for immediate_quit. */
3291 #ifdef NON_BLOCKING_CONNECT
3293 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3297 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3305 /* Discard the unwind protect closing S. */
3306 specpdl_ptr
= specpdl
+ count1
;
3310 if (xerrno
== EINTR
)
3316 #ifdef DATAGRAM_SOCKETS
3317 if (socktype
== SOCK_DGRAM
)
3319 if (datagram_address
[s
].sa
)
3321 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3322 datagram_address
[s
].len
= lres
->ai_addrlen
;
3326 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3327 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3330 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3331 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3332 conv_lisp_to_sockaddr (rfamily
, remote
,
3333 datagram_address
[s
].sa
, rlen
);
3337 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3340 contact
= Fplist_put (contact
, QCaddress
,
3341 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3342 #ifdef HAVE_GETSOCKNAME
3345 struct sockaddr_in sa1
;
3346 int len1
= sizeof (sa1
);
3347 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3348 contact
= Fplist_put (contact
, QClocal
,
3349 conv_sockaddr_to_lisp (&sa1
, len1
));
3356 #ifdef HAVE_GETADDRINFO
3365 /* Discard the unwind protect for closing S, if any. */
3366 specpdl_ptr
= specpdl
+ count1
;
3368 /* Unwind bind_polling_period and request_sigio. */
3369 unbind_to (count
, Qnil
);
3373 /* If non-blocking got this far - and failed - assume non-blocking is
3374 not supported after all. This is probably a wrong assumption, but
3375 the normal blocking calls to open-network-stream handles this error
3377 if (is_non_blocking_client
)
3382 report_file_error ("make server process failed", contact
);
3384 report_file_error ("make client process failed", contact
);
3387 #endif /* not TERM */
3393 buffer
= Fget_buffer_create (buffer
);
3394 proc
= make_process (name
);
3396 chan_process
[inch
] = proc
;
3399 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3402 fcntl (inch
, F_SETFL
, O_NDELAY
);
3406 p
= XPROCESS (proc
);
3408 p
->childp
= contact
;
3409 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3412 p
->sentinel
= sentinel
;
3414 p
->filter_multibyte
= !NILP (buffer_defaults
.enable_multibyte_characters
);
3415 /* Override the above only if :filter-multibyte is specified. */
3416 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3417 p
->filter_multibyte
= !NILP (Fplist_get (contact
, QCfilter_multibyte
));
3418 p
->log
= Fplist_get (contact
, QClog
);
3419 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3420 p
->kill_without_query
= 1;
3421 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3426 if (is_server
&& socktype
== SOCK_STREAM
)
3427 p
->status
= Qlisten
;
3429 /* Make the process marker point into the process buffer (if any). */
3430 if (BUFFERP (buffer
))
3431 set_marker_both (p
->mark
, buffer
,
3432 BUF_ZV (XBUFFER (buffer
)),
3433 BUF_ZV_BYTE (XBUFFER (buffer
)));
3435 #ifdef NON_BLOCKING_CONNECT
3436 if (is_non_blocking_client
)
3438 /* We may get here if connect did succeed immediately. However,
3439 in that case, we still need to signal this like a non-blocking
3441 p
->status
= Qconnect
;
3442 if (!FD_ISSET (inch
, &connect_wait_mask
))
3444 FD_SET (inch
, &connect_wait_mask
);
3445 num_pending_connects
++;
3450 /* A server may have a client filter setting of Qt, but it must
3451 still listen for incoming connects unless it is stopped. */
3452 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3453 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3455 FD_SET (inch
, &input_wait_mask
);
3456 FD_SET (inch
, &non_keyboard_wait_mask
);
3459 if (inch
> max_process_desc
)
3460 max_process_desc
= inch
;
3462 tem
= Fplist_member (contact
, QCcoding
);
3463 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3464 tem
= Qnil
; /* No error message (too late!). */
3467 /* Setup coding systems for communicating with the network stream. */
3468 struct gcpro gcpro1
;
3469 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3470 Lisp_Object coding_systems
= Qt
;
3471 Lisp_Object args
[5], val
;
3475 val
= XCAR (XCDR (tem
));
3479 else if (!NILP (Vcoding_system_for_read
))
3480 val
= Vcoding_system_for_read
;
3481 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3482 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3483 /* We dare not decode end-of-line format by setting VAL to
3484 Qraw_text, because the existing Emacs Lisp libraries
3485 assume that they receive bare code including a sequene of
3490 if (NILP (host
) || NILP (service
))
3491 coding_systems
= Qnil
;
3494 args
[0] = Qopen_network_stream
, args
[1] = name
,
3495 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3497 coding_systems
= Ffind_operation_coding_system (5, args
);
3500 if (CONSP (coding_systems
))
3501 val
= XCAR (coding_systems
);
3502 else if (CONSP (Vdefault_process_coding_system
))
3503 val
= XCAR (Vdefault_process_coding_system
);
3507 p
->decode_coding_system
= val
;
3511 val
= XCAR (XCDR (tem
));
3515 else if (!NILP (Vcoding_system_for_write
))
3516 val
= Vcoding_system_for_write
;
3517 else if (NILP (current_buffer
->enable_multibyte_characters
))
3521 if (EQ (coding_systems
, Qt
))
3523 if (NILP (host
) || NILP (service
))
3524 coding_systems
= Qnil
;
3527 args
[0] = Qopen_network_stream
, args
[1] = name
,
3528 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3530 coding_systems
= Ffind_operation_coding_system (5, args
);
3534 if (CONSP (coding_systems
))
3535 val
= XCDR (coding_systems
);
3536 else if (CONSP (Vdefault_process_coding_system
))
3537 val
= XCDR (Vdefault_process_coding_system
);
3541 p
->encode_coding_system
= val
;
3543 setup_process_coding_systems (proc
);
3545 p
->decoding_buf
= make_uninit_string (0);
3546 p
->decoding_carryover
= 0;
3547 p
->encoding_buf
= make_uninit_string (0);
3549 p
->inherit_coding_system_flag
3550 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
3555 #endif /* HAVE_SOCKETS */
3558 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3561 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3562 doc
: /* Return an alist of all network interfaces and their network address.
3563 Each element is a cons, the car of which is a string containing the
3564 interface name, and the cdr is the network address in internal
3565 format; see the description of ADDRESS in `make-network-process'. */)
3568 struct ifconf ifconf
;
3569 struct ifreq
*ifreqs
= NULL
;
3574 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3580 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3581 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3588 ifconf
.ifc_len
= buf_size
;
3589 ifconf
.ifc_req
= ifreqs
;
3590 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3596 if (ifconf
.ifc_len
== buf_size
)
3600 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3603 while (--ifaces
>= 0)
3605 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3606 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3607 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3609 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3610 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3611 res
= Fcons (Fcons (build_string (namebuf
),
3612 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3613 sizeof (struct sockaddr
))),
3619 #endif /* SIOCGIFCONF */
3621 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3628 static struct ifflag_def ifflag_table
[] = {
3632 #ifdef IFF_BROADCAST
3633 { IFF_BROADCAST
, "broadcast" },
3636 { IFF_DEBUG
, "debug" },
3639 { IFF_LOOPBACK
, "loopback" },
3641 #ifdef IFF_POINTOPOINT
3642 { IFF_POINTOPOINT
, "pointopoint" },
3645 { IFF_RUNNING
, "running" },
3648 { IFF_NOARP
, "noarp" },
3651 { IFF_PROMISC
, "promisc" },
3653 #ifdef IFF_NOTRAILERS
3654 { IFF_NOTRAILERS
, "notrailers" },
3657 { IFF_ALLMULTI
, "allmulti" },
3660 { IFF_MASTER
, "master" },
3663 { IFF_SLAVE
, "slave" },
3665 #ifdef IFF_MULTICAST
3666 { IFF_MULTICAST
, "multicast" },
3669 { IFF_PORTSEL
, "portsel" },
3671 #ifdef IFF_AUTOMEDIA
3672 { IFF_AUTOMEDIA
, "automedia" },
3675 { IFF_DYNAMIC
, "dynamic" },
3678 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3681 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3684 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3687 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3690 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3695 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3696 doc
: /* Return information about network interface named IFNAME.
3697 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3698 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3699 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3700 FLAGS is the current flags of the interface. */)
3705 Lisp_Object res
= Qnil
;
3710 CHECK_STRING (ifname
);
3712 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3713 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3715 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3720 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3721 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3723 int flags
= rq
.ifr_flags
;
3724 struct ifflag_def
*fp
;
3728 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3730 if (flags
& fp
->flag_bit
)
3732 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3733 flags
-= fp
->flag_bit
;
3736 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3738 if (flags
& (1 << fnum
))
3740 elt
= Fcons (make_number (fnum
), elt
);
3745 res
= Fcons (elt
, res
);
3748 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3749 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3751 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3752 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3756 for (n
= 0; n
< 6; n
++)
3757 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3758 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3761 res
= Fcons (elt
, res
);
3764 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
3765 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3768 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3769 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3771 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3775 res
= Fcons (elt
, res
);
3778 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3779 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3782 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3785 res
= Fcons (elt
, res
);
3788 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3789 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3792 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3795 res
= Fcons (elt
, res
);
3799 return any
? res
: Qnil
;
3802 #endif /* HAVE_SOCKETS */
3804 /* Turn off input and output for process PROC. */
3807 deactivate_process (proc
)
3810 register int inchannel
, outchannel
;
3811 register struct Lisp_Process
*p
= XPROCESS (proc
);
3813 inchannel
= p
->infd
;
3814 outchannel
= p
->outfd
;
3816 #ifdef ADAPTIVE_READ_BUFFERING
3817 if (p
->read_output_delay
> 0)
3819 if (--process_output_delay_count
< 0)
3820 process_output_delay_count
= 0;
3821 p
->read_output_delay
= 0;
3822 p
->read_output_skip
= 0;
3828 /* Beware SIGCHLD hereabouts. */
3829 flush_pending_output (inchannel
);
3832 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3833 sys$
dassgn (outchannel
);
3834 vs
= get_vms_process_pointer (p
->pid
);
3836 give_back_vms_process_stuff (vs
);
3839 emacs_close (inchannel
);
3840 if (outchannel
>= 0 && outchannel
!= inchannel
)
3841 emacs_close (outchannel
);
3846 #ifdef DATAGRAM_SOCKETS
3847 if (DATAGRAM_CHAN_P (inchannel
))
3849 xfree (datagram_address
[inchannel
].sa
);
3850 datagram_address
[inchannel
].sa
= 0;
3851 datagram_address
[inchannel
].len
= 0;
3854 chan_process
[inchannel
] = Qnil
;
3855 FD_CLR (inchannel
, &input_wait_mask
);
3856 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3857 #ifdef NON_BLOCKING_CONNECT
3858 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3860 FD_CLR (inchannel
, &connect_wait_mask
);
3861 if (--num_pending_connects
< 0)
3865 if (inchannel
== max_process_desc
)
3868 /* We just closed the highest-numbered process input descriptor,
3869 so recompute the highest-numbered one now. */
3870 max_process_desc
= 0;
3871 for (i
= 0; i
< MAXDESC
; i
++)
3872 if (!NILP (chan_process
[i
]))
3873 max_process_desc
= i
;
3878 /* Close all descriptors currently in use for communication
3879 with subprocess. This is used in a newly-forked subprocess
3880 to get rid of irrelevant descriptors. */
3883 close_process_descs ()
3887 for (i
= 0; i
< MAXDESC
; i
++)
3889 Lisp_Object process
;
3890 process
= chan_process
[i
];
3891 if (!NILP (process
))
3893 int in
= XPROCESS (process
)->infd
;
3894 int out
= XPROCESS (process
)->outfd
;
3897 if (out
>= 0 && in
!= out
)
3904 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3906 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3907 It is read into the process' buffers or given to their filter functions.
3908 Non-nil arg PROCESS means do not return until some output has been received
3911 Non-nil second arg SECONDS and third arg MILLISEC are number of
3912 seconds and milliseconds to wait; return after that much time whether
3913 or not there is input. If SECONDS is a floating point number,
3914 it specifies a fractional number of seconds to wait.
3916 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3917 from PROCESS, suspending reading output from other processes.
3918 If JUST-THIS-ONE is an integer, don't run any timers either.
3919 Return non-nil iff we received any output before the timeout expired. */)
3920 (process
, seconds
, millisec
, just_this_one
)
3921 register Lisp_Object process
, seconds
, millisec
, just_this_one
;
3923 int secs
, usecs
= 0;
3925 if (! NILP (process
))
3926 CHECK_PROCESS (process
);
3928 just_this_one
= Qnil
;
3930 if (!NILP (seconds
))
3932 if (INTEGERP (seconds
))
3933 secs
= XINT (seconds
);
3934 else if (FLOATP (seconds
))
3936 double timeout
= XFLOAT_DATA (seconds
);
3937 secs
= (int) timeout
;
3938 usecs
= (int) ((timeout
- (double) secs
) * 1000000);
3941 wrong_type_argument (Qnumberp
, seconds
);
3943 if (INTEGERP (millisec
))
3946 usecs
+= XINT (millisec
) * 1000;
3947 carry
= usecs
/ 1000000;
3949 if ((usecs
-= carry
* 1000000) < 0)
3956 if (secs
< 0 || (secs
== 0 && usecs
== 0))
3957 secs
= -1, usecs
= 0;
3960 secs
= NILP (process
) ? -1 : 0;
3963 (wait_reading_process_output (secs
, usecs
, 0, 0,
3965 !NILP (process
) ? XPROCESS (process
) : NULL
,
3966 NILP (just_this_one
) ? 0 :
3967 !INTEGERP (just_this_one
) ? 1 : -1)
3971 /* Accept a connection for server process SERVER on CHANNEL. */
3973 static int connect_counter
= 0;
3976 server_accept_connection (server
, channel
)
3980 Lisp_Object proc
, caller
, name
, buffer
;
3981 Lisp_Object contact
, host
, service
;
3982 struct Lisp_Process
*ps
= XPROCESS (server
);
3983 struct Lisp_Process
*p
;
3987 struct sockaddr_in in
;
3989 struct sockaddr_in6 in6
;
3991 #ifdef HAVE_LOCAL_SOCKETS
3992 struct sockaddr_un un
;
3995 int len
= sizeof saddr
;
3997 s
= accept (channel
, &saddr
.sa
, &len
);
4006 if (code
== EWOULDBLOCK
)
4010 if (!NILP (ps
->log
))
4011 call3 (ps
->log
, server
, Qnil
,
4012 concat3 (build_string ("accept failed with code"),
4013 Fnumber_to_string (make_number (code
)),
4014 build_string ("\n")));
4020 /* Setup a new process to handle the connection. */
4022 /* Generate a unique identification of the caller, and build contact
4023 information for this process. */
4026 switch (saddr
.sa
.sa_family
)
4030 Lisp_Object args
[5];
4031 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4032 args
[0] = build_string ("%d.%d.%d.%d");
4033 args
[1] = make_number (*ip
++);
4034 args
[2] = make_number (*ip
++);
4035 args
[3] = make_number (*ip
++);
4036 args
[4] = make_number (*ip
++);
4037 host
= Fformat (5, args
);
4038 service
= make_number (ntohs (saddr
.in
.sin_port
));
4040 args
[0] = build_string (" <%s:%d>");
4043 caller
= Fformat (3, args
);
4050 Lisp_Object args
[9];
4051 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4053 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4054 for (i
= 0; i
< 8; i
++)
4055 args
[i
+1] = make_number (ntohs(ip6
[i
]));
4056 host
= Fformat (9, args
);
4057 service
= make_number (ntohs (saddr
.in
.sin_port
));
4059 args
[0] = build_string (" <[%s]:%d>");
4062 caller
= Fformat (3, args
);
4067 #ifdef HAVE_LOCAL_SOCKETS
4071 caller
= Fnumber_to_string (make_number (connect_counter
));
4072 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
4076 /* Create a new buffer name for this process if it doesn't have a
4077 filter. The new buffer name is based on the buffer name or
4078 process name of the server process concatenated with the caller
4081 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4085 buffer
= ps
->buffer
;
4087 buffer
= Fbuffer_name (buffer
);
4092 buffer
= concat2 (buffer
, caller
);
4093 buffer
= Fget_buffer_create (buffer
);
4097 /* Generate a unique name for the new server process. Combine the
4098 server process name with the caller identification. */
4100 name
= concat2 (ps
->name
, caller
);
4101 proc
= make_process (name
);
4103 chan_process
[s
] = proc
;
4106 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4109 fcntl (s
, F_SETFL
, O_NDELAY
);
4113 p
= XPROCESS (proc
);
4115 /* Build new contact information for this setup. */
4116 contact
= Fcopy_sequence (ps
->childp
);
4117 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4118 contact
= Fplist_put (contact
, QChost
, host
);
4119 if (!NILP (service
))
4120 contact
= Fplist_put (contact
, QCservice
, service
);
4121 contact
= Fplist_put (contact
, QCremote
,
4122 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4123 #ifdef HAVE_GETSOCKNAME
4125 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4126 contact
= Fplist_put (contact
, QClocal
,
4127 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4130 p
->childp
= contact
;
4131 p
->plist
= Fcopy_sequence (ps
->plist
);
4134 p
->sentinel
= ps
->sentinel
;
4135 p
->filter
= ps
->filter
;
4142 /* Client processes for accepted connections are not stopped initially. */
4143 if (!EQ (p
->filter
, Qt
))
4145 FD_SET (s
, &input_wait_mask
);
4146 FD_SET (s
, &non_keyboard_wait_mask
);
4149 if (s
> max_process_desc
)
4150 max_process_desc
= s
;
4152 /* Setup coding system for new process based on server process.
4153 This seems to be the proper thing to do, as the coding system
4154 of the new process should reflect the settings at the time the
4155 server socket was opened; not the current settings. */
4157 p
->decode_coding_system
= ps
->decode_coding_system
;
4158 p
->encode_coding_system
= ps
->encode_coding_system
;
4159 setup_process_coding_systems (proc
);
4161 p
->decoding_buf
= make_uninit_string (0);
4162 p
->decoding_carryover
= 0;
4163 p
->encoding_buf
= make_uninit_string (0);
4165 p
->inherit_coding_system_flag
4166 = (NILP (buffer
) ? 0 : ps
->inherit_coding_system_flag
);
4168 if (!NILP (ps
->log
))
4169 call3 (ps
->log
, server
, proc
,
4170 concat3 (build_string ("accept from "),
4171 (STRINGP (host
) ? host
: build_string ("-")),
4172 build_string ("\n")));
4174 if (!NILP (p
->sentinel
))
4175 exec_sentinel (proc
,
4176 concat3 (build_string ("open from "),
4177 (STRINGP (host
) ? host
: build_string ("-")),
4178 build_string ("\n")));
4181 /* This variable is different from waiting_for_input in keyboard.c.
4182 It is used to communicate to a lisp process-filter/sentinel (via the
4183 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4184 for user-input when that process-filter was called.
4185 waiting_for_input cannot be used as that is by definition 0 when
4186 lisp code is being evalled.
4187 This is also used in record_asynch_buffer_change.
4188 For that purpose, this must be 0
4189 when not inside wait_reading_process_output. */
4190 static int waiting_for_user_input_p
;
4193 wait_reading_process_output_unwind (data
)
4196 waiting_for_user_input_p
= XINT (data
);
4200 /* This is here so breakpoints can be put on it. */
4202 wait_reading_process_output_1 ()
4206 /* Use a wrapper around select to work around a bug in gdb 5.3.
4207 Normally, the wrapper is optimzed away by inlining.
4209 If emacs is stopped inside select, the gdb backtrace doesn't
4210 show the function which called select, so it is practically
4211 impossible to step through wait_reading_process_output. */
4215 select_wrapper (n
, rfd
, wfd
, xfd
, tmo
)
4217 SELECT_TYPE
*rfd
, *wfd
, *xfd
;
4220 return select (n
, rfd
, wfd
, xfd
, tmo
);
4222 #define select select_wrapper
4225 /* Read and dispose of subprocess output while waiting for timeout to
4226 elapse and/or keyboard input to be available.
4229 timeout in seconds, or
4230 zero for no limit, or
4231 -1 means gobble data immediately available but don't wait for any.
4234 an additional duration to wait, measured in microseconds.
4235 If this is nonzero and time_limit is 0, then the timeout
4236 consists of MICROSECS only.
4238 READ_KBD is a lisp value:
4239 0 to ignore keyboard input, or
4240 1 to return when input is available, or
4241 -1 meaning caller will actually read the input, so don't throw to
4242 the quit handler, or
4244 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4245 output that arrives.
4247 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4248 (and gobble terminal input into the buffer if any arrives).
4250 If WAIT_PROC is specified, wait until something arrives from that
4251 process. The return value is true iff we read some input from
4254 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4255 (suspending output from other processes). A negative value
4256 means don't run any timers either.
4258 If WAIT_PROC is specified, then the function returns true iff we
4259 received input from that process before the timeout elapsed.
4260 Otherwise, return true iff we received input from any process. */
4263 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
4264 wait_for_cell
, wait_proc
, just_wait_proc
)
4265 int time_limit
, microsecs
, read_kbd
, do_display
;
4266 Lisp_Object wait_for_cell
;
4267 struct Lisp_Process
*wait_proc
;
4270 register int channel
, nfds
;
4271 SELECT_TYPE Available
;
4272 #ifdef NON_BLOCKING_CONNECT
4273 SELECT_TYPE Connecting
;
4276 int check_delay
, no_avail
;
4279 EMACS_TIME timeout
, end_time
;
4280 int wait_channel
= -1;
4281 int got_some_input
= 0;
4282 int count
= SPECPDL_INDEX ();
4284 FD_ZERO (&Available
);
4285 #ifdef NON_BLOCKING_CONNECT
4286 FD_ZERO (&Connecting
);
4289 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4290 if (wait_proc
!= NULL
)
4291 wait_channel
= wait_proc
->infd
;
4293 record_unwind_protect (wait_reading_process_output_unwind
,
4294 make_number (waiting_for_user_input_p
));
4295 waiting_for_user_input_p
= read_kbd
;
4297 /* Since we may need to wait several times,
4298 compute the absolute time to return at. */
4299 if (time_limit
|| microsecs
)
4301 EMACS_GET_TIME (end_time
);
4302 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4303 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4305 #ifdef POLL_INTERRUPTED_SYS_CALL
4306 /* AlainF 5-Jul-1996
4307 HP-UX 10.10 seem to have problems with signals coming in
4308 Causes "poll: interrupted system call" messages when Emacs is run
4310 Turn off periodic alarms (in case they are in use),
4311 and then turn off any other atimers. */
4313 turn_on_atimers (0);
4314 #endif /* POLL_INTERRUPTED_SYS_CALL */
4318 int timeout_reduced_for_timers
= 0;
4320 /* If calling from keyboard input, do not quit
4321 since we want to return C-g as an input character.
4322 Otherwise, do pending quit if requested. */
4326 else if (interrupt_input_pending
)
4327 handle_async_input ();
4330 /* Exit now if the cell we're waiting for became non-nil. */
4331 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4334 /* Compute time from now till when time limit is up */
4335 /* Exit if already run out */
4336 if (time_limit
== -1)
4338 /* -1 specified for timeout means
4339 gobble output available now
4340 but don't wait at all. */
4342 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4344 else if (time_limit
|| microsecs
)
4346 EMACS_GET_TIME (timeout
);
4347 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4348 if (EMACS_TIME_NEG_P (timeout
))
4353 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4356 /* Normally we run timers here.
4357 But not if wait_for_cell; in those cases,
4358 the wait is supposed to be short,
4359 and those callers cannot handle running arbitrary Lisp code here. */
4360 if (NILP (wait_for_cell
)
4361 && just_wait_proc
>= 0)
4363 EMACS_TIME timer_delay
;
4367 int old_timers_run
= timers_run
;
4368 struct buffer
*old_buffer
= current_buffer
;
4370 timer_delay
= timer_check (1);
4372 /* If a timer has run, this might have changed buffers
4373 an alike. Make read_key_sequence aware of that. */
4374 if (timers_run
!= old_timers_run
4375 && old_buffer
!= current_buffer
4376 && waiting_for_user_input_p
== -1)
4377 record_asynch_buffer_change ();
4379 if (timers_run
!= old_timers_run
&& do_display
)
4380 /* We must retry, since a timer may have requeued itself
4381 and that could alter the time_delay. */
4382 redisplay_preserve_echo_area (9);
4386 while (!detect_input_pending ());
4388 /* If there is unread keyboard input, also return. */
4390 && requeued_events_pending_p ())
4393 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4395 EMACS_TIME difference
;
4396 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4397 if (EMACS_TIME_NEG_P (difference
))
4399 timeout
= timer_delay
;
4400 timeout_reduced_for_timers
= 1;
4403 /* If time_limit is -1, we are not going to wait at all. */
4404 else if (time_limit
!= -1)
4406 /* This is so a breakpoint can be put here. */
4407 wait_reading_process_output_1 ();
4411 /* Cause C-g and alarm signals to take immediate action,
4412 and cause input available signals to zero out timeout.
4414 It is important that we do this before checking for process
4415 activity. If we get a SIGCHLD after the explicit checks for
4416 process activity, timeout is the only way we will know. */
4418 set_waiting_for_input (&timeout
);
4420 /* If status of something has changed, and no input is
4421 available, notify the user of the change right away. After
4422 this explicit check, we'll let the SIGCHLD handler zap
4423 timeout to get our attention. */
4424 if (update_tick
!= process_tick
&& do_display
)
4427 #ifdef NON_BLOCKING_CONNECT
4431 Atemp
= input_wait_mask
;
4433 /* On Mac OS X 10.0, the SELECT system call always says input is
4434 present (for reading) at stdin, even when none is. This
4435 causes the call to SELECT below to return 1 and
4436 status_notify not to be called. As a result output of
4437 subprocesses are incorrectly discarded.
4441 IF_NON_BLOCKING_CONNECT (Ctemp
= connect_wait_mask
);
4443 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4444 if ((select (max (max (max_process_desc
, max_keyboard_desc
),
4447 #ifdef NON_BLOCKING_CONNECT
4448 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4452 (SELECT_TYPE
*)0, &timeout
)
4455 /* It's okay for us to do this and then continue with
4456 the loop, since timeout has already been zeroed out. */
4457 clear_waiting_for_input ();
4458 status_notify (NULL
);
4462 /* Don't wait for output from a non-running process. Just
4463 read whatever data has already been received. */
4464 if (wait_proc
&& wait_proc
->raw_status_new
)
4465 update_status (wait_proc
);
4467 && ! EQ (wait_proc
->status
, Qrun
)
4468 && ! EQ (wait_proc
->status
, Qconnect
))
4470 int nread
, total_nread
= 0;
4472 clear_waiting_for_input ();
4473 XSETPROCESS (proc
, wait_proc
);
4475 /* Read data from the process, until we exhaust it. */
4476 while (wait_proc
->infd
>= 0)
4478 nread
= read_process_output (proc
, wait_proc
->infd
);
4484 total_nread
+= nread
;
4486 else if (nread
== -1 && EIO
== errno
)
4490 else if (nread
== -1 && EAGAIN
== errno
)
4494 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4498 if (total_nread
> 0 && do_display
)
4499 redisplay_preserve_echo_area (10);
4504 /* Wait till there is something to do */
4506 if (wait_proc
&& just_wait_proc
)
4508 if (wait_proc
->infd
< 0) /* Terminated */
4510 FD_SET (wait_proc
->infd
, &Available
);
4512 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4514 else if (!NILP (wait_for_cell
))
4516 Available
= non_process_wait_mask
;
4518 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4523 Available
= non_keyboard_wait_mask
;
4525 Available
= input_wait_mask
;
4526 IF_NON_BLOCKING_CONNECT (check_connect
= (num_pending_connects
> 0));
4527 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4530 /* If frame size has changed or the window is newly mapped,
4531 redisplay now, before we start to wait. There is a race
4532 condition here; if a SIGIO arrives between now and the select
4533 and indicates that a frame is trashed, the select may block
4534 displaying a trashed screen. */
4535 if (frame_garbaged
&& do_display
)
4537 clear_waiting_for_input ();
4538 redisplay_preserve_echo_area (11);
4540 set_waiting_for_input (&timeout
);
4544 if (read_kbd
&& detect_input_pending ())
4551 #ifdef NON_BLOCKING_CONNECT
4553 Connecting
= connect_wait_mask
;
4556 #ifdef ADAPTIVE_READ_BUFFERING
4557 /* Set the timeout for adaptive read buffering if any
4558 process has non-zero read_output_skip and non-zero
4559 read_output_delay, and we are not reading output for a
4560 specific wait_channel. It is not executed if
4561 Vprocess_adaptive_read_buffering is nil. */
4562 if (process_output_skip
&& check_delay
> 0)
4564 int usecs
= EMACS_USECS (timeout
);
4565 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4566 usecs
= READ_OUTPUT_DELAY_MAX
;
4567 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4569 proc
= chan_process
[channel
];
4572 /* Find minimum non-zero read_output_delay among the
4573 processes with non-zero read_output_skip. */
4574 if (XPROCESS (proc
)->read_output_delay
> 0)
4577 if (!XPROCESS (proc
)->read_output_skip
)
4579 FD_CLR (channel
, &Available
);
4580 XPROCESS (proc
)->read_output_skip
= 0;
4581 if (XPROCESS (proc
)->read_output_delay
< usecs
)
4582 usecs
= XPROCESS (proc
)->read_output_delay
;
4585 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4586 process_output_skip
= 0;
4590 nfds
= select (max (max (max_process_desc
, max_keyboard_desc
),
4593 #ifdef NON_BLOCKING_CONNECT
4594 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4598 (SELECT_TYPE
*)0, &timeout
);
4603 /* Make C-g and alarm signals set flags again */
4604 clear_waiting_for_input ();
4606 /* If we woke up due to SIGWINCH, actually change size now. */
4607 do_pending_window_change (0);
4609 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4610 /* We wanted the full specified time, so return now. */
4614 if (xerrno
== EINTR
)
4617 /* Ultrix select seems to return ENOMEM when it is
4618 interrupted. Treat it just like EINTR. Bleah. Note
4619 that we want to test for the "ultrix" CPP symbol, not
4620 "__ultrix__"; the latter is only defined under GCC, but
4621 not by DEC's bundled CC. -JimB */
4622 else if (xerrno
== ENOMEM
)
4626 /* This happens for no known reason on ALLIANT.
4627 I am guessing that this is the right response. -- RMS. */
4628 else if (xerrno
== EFAULT
)
4631 else if (xerrno
== EBADF
)
4634 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4635 the child's closure of the pts gives the parent a SIGHUP, and
4636 the ptc file descriptor is automatically closed,
4637 yielding EBADF here or at select() call above.
4638 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4639 in m/ibmrt-aix.h), and here we just ignore the select error.
4640 Cleanup occurs c/o status_notify after SIGCLD. */
4641 no_avail
= 1; /* Cannot depend on values returned */
4647 error ("select error: %s", emacs_strerror (xerrno
));
4652 FD_ZERO (&Available
);
4653 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4656 #if defined(sun) && !defined(USG5_4)
4657 if (nfds
> 0 && keyboard_bit_set (&Available
)
4659 /* System sometimes fails to deliver SIGIO.
4661 David J. Mackenzie says that Emacs doesn't compile under
4662 Solaris if this code is enabled, thus the USG5_4 in the CPP
4663 conditional. "I haven't noticed any ill effects so far.
4664 If you find a Solaris expert somewhere, they might know
4666 kill (getpid (), SIGIO
);
4669 #if 0 /* When polling is used, interrupt_input is 0,
4670 so get_input_pending should read the input.
4671 So this should not be needed. */
4672 /* If we are using polling for input,
4673 and we see input available, make it get read now.
4674 Otherwise it might not actually get read for a second.
4675 And on hpux, since we turn off polling in wait_reading_process_output,
4676 it might never get read at all if we don't spend much time
4677 outside of wait_reading_process_output. */
4678 if (read_kbd
&& interrupt_input
4679 && keyboard_bit_set (&Available
)
4680 && input_polling_used ())
4681 kill (getpid (), SIGALRM
);
4684 /* Check for keyboard input */
4685 /* If there is any, return immediately
4686 to give it higher priority than subprocesses */
4690 int old_timers_run
= timers_run
;
4691 struct buffer
*old_buffer
= current_buffer
;
4694 if (detect_input_pending_run_timers (do_display
))
4696 swallow_events (do_display
);
4697 if (detect_input_pending_run_timers (do_display
))
4701 /* If a timer has run, this might have changed buffers
4702 an alike. Make read_key_sequence aware of that. */
4703 if (timers_run
!= old_timers_run
4704 && waiting_for_user_input_p
== -1
4705 && old_buffer
!= current_buffer
)
4706 record_asynch_buffer_change ();
4712 /* If there is unread keyboard input, also return. */
4714 && requeued_events_pending_p ())
4717 /* If we are not checking for keyboard input now,
4718 do process events (but don't run any timers).
4719 This is so that X events will be processed.
4720 Otherwise they may have to wait until polling takes place.
4721 That would causes delays in pasting selections, for example.
4723 (We used to do this only if wait_for_cell.) */
4724 if (read_kbd
== 0 && detect_input_pending ())
4726 swallow_events (do_display
);
4727 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4728 if (detect_input_pending ())
4733 /* Exit now if the cell we're waiting for became non-nil. */
4734 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4738 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4739 go read it. This can happen with X on BSD after logging out.
4740 In that case, there really is no input and no SIGIO,
4741 but select says there is input. */
4743 if (read_kbd
&& interrupt_input
4744 && keyboard_bit_set (&Available
) && ! noninteractive
)
4745 kill (getpid (), SIGIO
);
4749 got_some_input
|= nfds
> 0;
4751 /* If checking input just got us a size-change event from X,
4752 obey it now if we should. */
4753 if (read_kbd
|| ! NILP (wait_for_cell
))
4754 do_pending_window_change (0);
4756 /* Check for data from a process. */
4757 if (no_avail
|| nfds
== 0)
4760 /* Really FIRST_PROC_DESC should be 0 on Unix,
4761 but this is safer in the short run. */
4762 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4764 if (FD_ISSET (channel
, &Available
)
4765 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4769 /* If waiting for this channel, arrange to return as
4770 soon as no more input to be processed. No more
4772 if (wait_channel
== channel
)
4778 proc
= chan_process
[channel
];
4782 /* If this is a server stream socket, accept connection. */
4783 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4785 server_accept_connection (proc
, channel
);
4789 /* Read data from the process, starting with our
4790 buffered-ahead character if we have one. */
4792 nread
= read_process_output (proc
, channel
);
4795 /* Since read_process_output can run a filter,
4796 which can call accept-process-output,
4797 don't try to read from any other processes
4798 before doing the select again. */
4799 FD_ZERO (&Available
);
4802 redisplay_preserve_echo_area (12);
4805 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4808 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4809 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4811 else if (nread
== -1 && errno
== EAGAIN
)
4815 else if (nread
== -1 && errno
== EAGAIN
)
4817 /* Note that we cannot distinguish between no input
4818 available now and a closed pipe.
4819 With luck, a closed pipe will be accompanied by
4820 subprocess termination and SIGCHLD. */
4821 else if (nread
== 0 && !NETCONN_P (proc
))
4823 #endif /* O_NDELAY */
4824 #endif /* O_NONBLOCK */
4826 /* On some OSs with ptys, when the process on one end of
4827 a pty exits, the other end gets an error reading with
4828 errno = EIO instead of getting an EOF (0 bytes read).
4829 Therefore, if we get an error reading and errno =
4830 EIO, just continue, because the child process has
4831 exited and should clean itself up soon (e.g. when we
4834 However, it has been known to happen that the SIGCHLD
4835 got lost. So raise the signal again just in case.
4837 else if (nread
== -1 && errno
== EIO
)
4839 /* Clear the descriptor now, so we only raise the signal once. */
4840 FD_CLR (channel
, &input_wait_mask
);
4841 FD_CLR (channel
, &non_keyboard_wait_mask
);
4843 kill (getpid (), SIGCHLD
);
4845 #endif /* HAVE_PTYS */
4846 /* If we can detect process termination, don't consider the process
4847 gone just because its pipe is closed. */
4849 else if (nread
== 0 && !NETCONN_P (proc
))
4854 /* Preserve status of processes already terminated. */
4855 XPROCESS (proc
)->tick
= ++process_tick
;
4856 deactivate_process (proc
);
4857 if (XPROCESS (proc
)->raw_status_new
)
4858 update_status (XPROCESS (proc
));
4859 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4860 XPROCESS (proc
)->status
4861 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4864 #ifdef NON_BLOCKING_CONNECT
4865 if (check_connect
&& FD_ISSET (channel
, &Connecting
)
4866 && FD_ISSET (channel
, &connect_wait_mask
))
4868 struct Lisp_Process
*p
;
4870 FD_CLR (channel
, &connect_wait_mask
);
4871 if (--num_pending_connects
< 0)
4874 proc
= chan_process
[channel
];
4878 p
= XPROCESS (proc
);
4881 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4882 So only use it on systems where it is known to work. */
4884 int xlen
= sizeof(xerrno
);
4885 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4890 struct sockaddr pname
;
4891 int pnamelen
= sizeof(pname
);
4893 /* If connection failed, getpeername will fail. */
4895 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4897 /* Obtain connect failure code through error slippage. */
4900 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4907 p
->tick
= ++process_tick
;
4908 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4909 deactivate_process (proc
);
4914 /* Execute the sentinel here. If we had relied on
4915 status_notify to do it later, it will read input
4916 from the process before calling the sentinel. */
4917 exec_sentinel (proc
, build_string ("open\n"));
4918 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4920 FD_SET (p
->infd
, &input_wait_mask
);
4921 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
4925 #endif /* NON_BLOCKING_CONNECT */
4926 } /* end for each file descriptor */
4927 } /* end while exit conditions not met */
4929 unbind_to (count
, Qnil
);
4931 /* If calling from keyboard input, do not quit
4932 since we want to return C-g as an input character.
4933 Otherwise, do pending quit if requested. */
4936 /* Prevent input_pending from remaining set if we quit. */
4937 clear_input_pending ();
4940 #ifdef POLL_INTERRUPTED_SYS_CALL
4941 /* AlainF 5-Jul-1996
4942 HP-UX 10.10 seems to have problems with signals coming in
4943 Causes "poll: interrupted system call" messages when Emacs is run
4945 Turn periodic alarms back on */
4947 #endif /* POLL_INTERRUPTED_SYS_CALL */
4949 return got_some_input
;
4952 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4955 read_process_output_call (fun_and_args
)
4956 Lisp_Object fun_and_args
;
4958 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4962 read_process_output_error_handler (error
)
4965 cmd_error_internal (error
, "error in process filter: ");
4967 update_echo_area ();
4968 Fsleep_for (make_number (2), Qnil
);
4972 /* Read pending output from the process channel,
4973 starting with our buffered-ahead character if we have one.
4974 Yield number of decoded characters read.
4976 This function reads at most 4096 characters.
4977 If you want to read all available subprocess output,
4978 you must call it repeatedly until it returns zero.
4980 The characters read are decoded according to PROC's coding-system
4984 read_process_output (proc
, channel
)
4986 register int channel
;
4988 register int nbytes
;
4990 register Lisp_Object outstream
;
4991 register struct buffer
*old
= current_buffer
;
4992 register struct Lisp_Process
*p
= XPROCESS (proc
);
4993 register int opoint
;
4994 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4995 int carryover
= p
->decoding_carryover
;
4999 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5001 vs
= get_vms_process_pointer (p
->pid
);
5005 return (0); /* Really weird if it does this */
5006 if (!(vs
->iosb
[0] & 1))
5007 return -1; /* I/O error */
5010 error ("Could not get VMS process pointer");
5011 chars
= vs
->inputBuffer
;
5012 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
5015 start_vms_process_read (vs
); /* Crank up the next read on the process */
5016 return 1; /* Nothing worth printing, say we got 1 */
5020 /* The data carried over in the previous decoding (which are at
5021 the tail of decoding buffer) should be prepended to the new
5022 data read to decode all together. */
5023 chars
= (char *) alloca (nbytes
+ carryover
);
5024 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
5025 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
5029 chars
= (char *) alloca (carryover
+ readmax
);
5031 /* See the comment above. */
5032 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
5034 #ifdef DATAGRAM_SOCKETS
5035 /* We have a working select, so proc_buffered_char is always -1. */
5036 if (DATAGRAM_CHAN_P (channel
))
5038 int len
= datagram_address
[channel
].len
;
5039 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5040 0, datagram_address
[channel
].sa
, &len
);
5044 if (proc_buffered_char
[channel
] < 0)
5046 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
5047 #ifdef ADAPTIVE_READ_BUFFERING
5048 if (nbytes
> 0 && p
->adaptive_read_buffering
)
5050 int delay
= p
->read_output_delay
;
5053 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5056 process_output_delay_count
++;
5057 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5060 else if (delay
> 0 && (nbytes
== readmax
))
5062 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5064 process_output_delay_count
--;
5066 p
->read_output_delay
= delay
;
5069 p
->read_output_skip
= 1;
5070 process_output_skip
= 1;
5077 chars
[carryover
] = proc_buffered_char
[channel
];
5078 proc_buffered_char
[channel
] = -1;
5079 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
5083 nbytes
= nbytes
+ 1;
5085 #endif /* not VMS */
5087 p
->decoding_carryover
= 0;
5089 /* At this point, NBYTES holds number of bytes just received
5090 (including the one in proc_buffered_char[channel]). */
5093 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5095 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5098 /* Now set NBYTES how many bytes we must decode. */
5099 nbytes
+= carryover
;
5101 /* Read and dispose of the process output. */
5102 outstream
= p
->filter
;
5103 if (!NILP (outstream
))
5105 /* We inhibit quit here instead of just catching it so that
5106 hitting ^G when a filter happens to be running won't screw
5108 int count
= SPECPDL_INDEX ();
5109 Lisp_Object odeactivate
;
5110 Lisp_Object obuffer
, okeymap
;
5112 int outer_running_asynch_code
= running_asynch_code
;
5113 int waiting
= waiting_for_user_input_p
;
5115 /* No need to gcpro these, because all we do with them later
5116 is test them for EQness, and none of them should be a string. */
5117 odeactivate
= Vdeactivate_mark
;
5118 XSETBUFFER (obuffer
, current_buffer
);
5119 okeymap
= current_buffer
->keymap
;
5121 specbind (Qinhibit_quit
, Qt
);
5122 specbind (Qlast_nonmenu_event
, Qt
);
5124 /* In case we get recursively called,
5125 and we already saved the match data nonrecursively,
5126 save the same match data in safely recursive fashion. */
5127 if (outer_running_asynch_code
)
5130 /* Don't clobber the CURRENT match data, either! */
5131 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5132 restore_search_regs ();
5133 record_unwind_save_match_data ();
5134 Fset_match_data (tem
, Qt
);
5137 /* For speed, if a search happens within this code,
5138 save the match data in a special nonrecursive fashion. */
5139 running_asynch_code
= 1;
5141 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
5142 text
= coding
->dst_object
;
5143 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5144 /* A new coding system might be found. */
5145 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5147 p
->decode_coding_system
= Vlast_coding_system_used
;
5149 /* Don't call setup_coding_system for
5150 proc_decode_coding_system[channel] here. It is done in
5151 detect_coding called via decode_coding above. */
5153 /* If a coding system for encoding is not yet decided, we set
5154 it as the same as coding-system for decoding.
5156 But, before doing that we must check if
5157 proc_encode_coding_system[p->outfd] surely points to a
5158 valid memory because p->outfd will be changed once EOF is
5159 sent to the process. */
5160 if (NILP (p
->encode_coding_system
)
5161 && proc_encode_coding_system
[p
->outfd
])
5163 p
->encode_coding_system
5164 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5165 setup_coding_system (p
->encode_coding_system
,
5166 proc_encode_coding_system
[p
->outfd
]);
5170 if (coding
->carryover_bytes
> 0)
5172 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5173 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5174 bcopy (coding
->carryover
, SDATA (p
->decoding_buf
),
5175 coding
->carryover_bytes
);
5176 p
->decoding_carryover
= coding
->carryover_bytes
;
5178 /* Adjust the multibyteness of TEXT to that of the filter. */
5179 if (!p
->filter_multibyte
!= !STRING_MULTIBYTE (text
))
5180 text
= (STRING_MULTIBYTE (text
)
5181 ? Fstring_as_unibyte (text
)
5182 : Fstring_to_multibyte (text
));
5183 if (SBYTES (text
) > 0)
5184 internal_condition_case_1 (read_process_output_call
,
5186 Fcons (proc
, Fcons (text
, Qnil
))),
5187 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5188 read_process_output_error_handler
);
5190 /* If we saved the match data nonrecursively, restore it now. */
5191 restore_search_regs ();
5192 running_asynch_code
= outer_running_asynch_code
;
5194 /* Handling the process output should not deactivate the mark. */
5195 Vdeactivate_mark
= odeactivate
;
5197 /* Restore waiting_for_user_input_p as it was
5198 when we were called, in case the filter clobbered it. */
5199 waiting_for_user_input_p
= waiting
;
5201 #if 0 /* Call record_asynch_buffer_change unconditionally,
5202 because we might have changed minor modes or other things
5203 that affect key bindings. */
5204 if (! EQ (Fcurrent_buffer (), obuffer
)
5205 || ! EQ (current_buffer
->keymap
, okeymap
))
5207 /* But do it only if the caller is actually going to read events.
5208 Otherwise there's no need to make him wake up, and it could
5209 cause trouble (for example it would make sit_for return). */
5210 if (waiting_for_user_input_p
== -1)
5211 record_asynch_buffer_change ();
5214 start_vms_process_read (vs
);
5216 unbind_to (count
, Qnil
);
5220 /* If no filter, write into buffer if it isn't dead. */
5221 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5223 Lisp_Object old_read_only
;
5224 int old_begv
, old_zv
;
5225 int old_begv_byte
, old_zv_byte
;
5226 Lisp_Object odeactivate
;
5227 int before
, before_byte
;
5232 odeactivate
= Vdeactivate_mark
;
5234 Fset_buffer (p
->buffer
);
5236 opoint_byte
= PT_BYTE
;
5237 old_read_only
= current_buffer
->read_only
;
5240 old_begv_byte
= BEGV_BYTE
;
5241 old_zv_byte
= ZV_BYTE
;
5243 current_buffer
->read_only
= Qnil
;
5245 /* Insert new output into buffer
5246 at the current end-of-output marker,
5247 thus preserving logical ordering of input and output. */
5248 if (XMARKER (p
->mark
)->buffer
)
5249 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5250 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5253 SET_PT_BOTH (ZV
, ZV_BYTE
);
5255 before_byte
= PT_BYTE
;
5257 /* If the output marker is outside of the visible region, save
5258 the restriction and widen. */
5259 if (! (BEGV
<= PT
&& PT
<= ZV
))
5262 decode_coding_c_string (coding
, chars
, nbytes
, Qt
);
5263 text
= coding
->dst_object
;
5264 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5265 /* A new coding system might be found. See the comment in the
5266 similar code in the previous `if' block. */
5267 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5269 p
->decode_coding_system
= Vlast_coding_system_used
;
5270 if (NILP (p
->encode_coding_system
)
5271 && proc_encode_coding_system
[p
->outfd
])
5273 p
->encode_coding_system
5274 = coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
);
5275 setup_coding_system (p
->encode_coding_system
,
5276 proc_encode_coding_system
[p
->outfd
]);
5279 if (coding
->carryover_bytes
> 0)
5281 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5282 p
->decoding_buf
= make_uninit_string (coding
->carryover_bytes
);
5283 bcopy (coding
->carryover
, SDATA (p
->decoding_buf
),
5284 coding
->carryover_bytes
);
5285 p
->decoding_carryover
= coding
->carryover_bytes
;
5287 /* Adjust the multibyteness of TEXT to that of the buffer. */
5288 if (NILP (current_buffer
->enable_multibyte_characters
)
5289 != ! STRING_MULTIBYTE (text
))
5290 text
= (STRING_MULTIBYTE (text
)
5291 ? Fstring_as_unibyte (text
)
5292 : Fstring_to_multibyte (text
));
5293 /* Insert before markers in case we are inserting where
5294 the buffer's mark is, and the user's next command is Meta-y. */
5295 insert_from_string_before_markers (text
, 0, 0,
5296 SCHARS (text
), SBYTES (text
), 0);
5298 /* Make sure the process marker's position is valid when the
5299 process buffer is changed in the signal_after_change above.
5300 W3 is known to do that. */
5301 if (BUFFERP (p
->buffer
)
5302 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5303 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5305 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5307 update_mode_lines
++;
5309 /* Make sure opoint and the old restrictions
5310 float ahead of any new text just as point would. */
5311 if (opoint
>= before
)
5313 opoint
+= PT
- before
;
5314 opoint_byte
+= PT_BYTE
- before_byte
;
5316 if (old_begv
> before
)
5318 old_begv
+= PT
- before
;
5319 old_begv_byte
+= PT_BYTE
- before_byte
;
5321 if (old_zv
>= before
)
5323 old_zv
+= PT
- before
;
5324 old_zv_byte
+= PT_BYTE
- before_byte
;
5327 /* If the restriction isn't what it should be, set it. */
5328 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5329 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5331 /* Handling the process output should not deactivate the mark. */
5332 Vdeactivate_mark
= odeactivate
;
5334 current_buffer
->read_only
= old_read_only
;
5335 SET_PT_BOTH (opoint
, opoint_byte
);
5336 set_buffer_internal (old
);
5339 start_vms_process_read (vs
);
5344 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5346 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5347 This is intended for use by asynchronous process output filters and sentinels. */)
5350 return (waiting_for_user_input_p
? Qt
: Qnil
);
5353 /* Sending data to subprocess */
5355 jmp_buf send_process_frame
;
5356 Lisp_Object process_sent_to
;
5359 send_process_trap ()
5361 SIGNAL_THREAD_CHECK (SIGPIPE
);
5366 sigunblock (sigmask (SIGPIPE
));
5367 longjmp (send_process_frame
, 1);
5370 /* Send some data to process PROC.
5371 BUF is the beginning of the data; LEN is the number of characters.
5372 OBJECT is the Lisp object that the data comes from. If OBJECT is
5373 nil or t, it means that the data comes from C string.
5375 If OBJECT is not nil, the data is encoded by PROC's coding-system
5376 for encoding before it is sent.
5378 This function can evaluate Lisp code and can garbage collect. */
5381 send_process (proc
, buf
, len
, object
)
5382 volatile Lisp_Object proc
;
5383 unsigned char *volatile buf
;
5385 volatile Lisp_Object object
;
5387 /* Use volatile to protect variables from being clobbered by longjmp. */
5388 struct Lisp_Process
*p
= XPROCESS (proc
);
5390 struct coding_system
*coding
;
5391 struct gcpro gcpro1
;
5392 SIGTYPE (*volatile old_sigpipe
) ();
5397 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5400 if (p
->raw_status_new
)
5402 if (! EQ (p
->status
, Qrun
))
5403 error ("Process %s not running", SDATA (p
->name
));
5405 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5407 coding
= proc_encode_coding_system
[p
->outfd
];
5408 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5410 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5411 || (BUFFERP (object
)
5412 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5415 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
5416 /* The coding system for encoding was changed to raw-text
5417 because we sent a unibyte text previously. Now we are
5418 sending a multibyte text, thus we must encode it by the
5419 original coding system specified for the current process. */
5420 setup_coding_system (p
->encode_coding_system
, coding
);
5421 coding
->src_multibyte
= 1;
5425 /* For sending a unibyte text, character code conversion should
5426 not take place but EOL conversion should. So, setup raw-text
5427 or one of the subsidiary if we have not yet done it. */
5428 if (CODING_REQUIRE_ENCODING (coding
))
5430 if (CODING_REQUIRE_FLUSHING (coding
))
5432 /* But, before changing the coding, we must flush out data. */
5433 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5434 send_process (proc
, "", 0, Qt
);
5435 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
5437 setup_coding_system (raw_text_coding_system
5438 (Vlast_coding_system_used
),
5440 coding
->src_multibyte
= 0;
5443 coding
->dst_multibyte
= 0;
5445 if (CODING_REQUIRE_ENCODING (coding
))
5447 coding
->dst_object
= Qt
;
5448 if (BUFFERP (object
))
5450 int from_byte
, from
, to
;
5451 int save_pt
, save_pt_byte
;
5452 struct buffer
*cur
= current_buffer
;
5454 set_buffer_internal (XBUFFER (object
));
5455 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
5457 from_byte
= PTR_BYTE_POS (buf
);
5458 from
= BYTE_TO_CHAR (from_byte
);
5459 to
= BYTE_TO_CHAR (from_byte
+ len
);
5460 TEMP_SET_PT_BOTH (from
, from_byte
);
5461 encode_coding_object (coding
, object
, from
, from_byte
,
5462 to
, from_byte
+ len
, Qt
);
5463 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
5464 set_buffer_internal (cur
);
5466 else if (STRINGP (object
))
5468 encode_coding_string (coding
, object
, 1);
5472 coding
->dst_object
= make_unibyte_string (buf
, len
);
5473 coding
->produced
= len
;
5476 len
= coding
->produced
;
5477 buf
= SDATA (coding
->dst_object
);
5481 vs
= get_vms_process_pointer (p
->pid
);
5483 error ("Could not find this process: %x", p
->pid
);
5484 else if (write_to_vms_process (vs
, buf
, len
))
5488 if (pty_max_bytes
== 0)
5490 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5491 pty_max_bytes
= fpathconf (p
->outfd
, _PC_MAX_CANON
);
5492 if (pty_max_bytes
< 0)
5493 pty_max_bytes
= 250;
5495 pty_max_bytes
= 250;
5497 /* Deduct one, to leave space for the eof. */
5501 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5502 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5503 when returning with longjmp despite being declared volatile. */
5504 if (!setjmp (send_process_frame
))
5506 process_sent_to
= proc
;
5511 /* Decide how much data we can send in one batch.
5512 Long lines need to be split into multiple batches. */
5515 /* Starting this at zero is always correct when not the first
5516 iteration because the previous iteration ended by sending C-d.
5517 It may not be correct for the first iteration
5518 if a partial line was sent in a separate send_process call.
5519 If that proves worth handling, we need to save linepos
5520 in the process object. */
5522 unsigned char *ptr
= (unsigned char *) buf
;
5523 unsigned char *end
= (unsigned char *) buf
+ len
;
5525 /* Scan through this text for a line that is too long. */
5526 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5534 /* If we found one, break the line there
5535 and put in a C-d to force the buffer through. */
5539 /* Send this batch, using one or more write calls. */
5542 int outfd
= p
->outfd
;
5543 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5544 #ifdef DATAGRAM_SOCKETS
5545 if (DATAGRAM_CHAN_P (outfd
))
5547 rv
= sendto (outfd
, (char *) buf
, this,
5548 0, datagram_address
[outfd
].sa
,
5549 datagram_address
[outfd
].len
);
5550 if (rv
< 0 && errno
== EMSGSIZE
)
5552 signal (SIGPIPE
, old_sigpipe
);
5553 report_file_error ("sending datagram",
5554 Fcons (proc
, Qnil
));
5560 rv
= emacs_write (outfd
, (char *) buf
, this);
5561 #ifdef ADAPTIVE_READ_BUFFERING
5562 if (p
->read_output_delay
> 0
5563 && p
->adaptive_read_buffering
== 1)
5565 p
->read_output_delay
= 0;
5566 process_output_delay_count
--;
5567 p
->read_output_skip
= 0;
5571 signal (SIGPIPE
, old_sigpipe
);
5577 || errno
== EWOULDBLOCK
5583 /* Buffer is full. Wait, accepting input;
5584 that may allow the program
5585 to finish doing output and read more. */
5589 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5590 /* A gross hack to work around a bug in FreeBSD.
5591 In the following sequence, read(2) returns
5595 write(2) 954 bytes, get EAGAIN
5596 read(2) 1024 bytes in process_read_output
5597 read(2) 11 bytes in process_read_output
5599 That is, read(2) returns more bytes than have
5600 ever been written successfully. The 1033 bytes
5601 read are the 1022 bytes written successfully
5602 after processing (for example with CRs added if
5603 the terminal is set up that way which it is
5604 here). The same bytes will be seen again in a
5605 later read(2), without the CRs. */
5607 if (errno
== EAGAIN
)
5610 ioctl (p
->outfd
, TIOCFLUSH
, &flags
);
5612 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5614 /* Running filters might relocate buffers or strings.
5615 Arrange to relocate BUF. */
5616 if (BUFFERP (object
))
5617 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5618 else if (STRINGP (object
))
5619 offset
= buf
- SDATA (object
);
5621 #ifdef EMACS_HAS_USECS
5622 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5624 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5627 if (BUFFERP (object
))
5628 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5629 else if (STRINGP (object
))
5630 buf
= offset
+ SDATA (object
);
5635 /* This is a real error. */
5636 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5643 /* If we sent just part of the string, put in an EOF
5644 to force it through, before we send the rest. */
5646 Fprocess_send_eof (proc
);
5649 #endif /* not VMS */
5652 signal (SIGPIPE
, old_sigpipe
);
5654 proc
= process_sent_to
;
5655 p
= XPROCESS (proc
);
5657 p
->raw_status_new
= 0;
5658 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5659 p
->tick
= ++process_tick
;
5660 deactivate_process (proc
);
5662 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5664 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5671 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5673 doc
: /* Send current contents of region as input to PROCESS.
5674 PROCESS may be a process, a buffer, the name of a process or buffer, or
5675 nil, indicating the current buffer's process.
5676 Called from program, takes three arguments, PROCESS, START and END.
5677 If the region is more than 500 characters long,
5678 it is sent in several bunches. This may happen even for shorter regions.
5679 Output from processes can arrive in between bunches. */)
5680 (process
, start
, end
)
5681 Lisp_Object process
, start
, end
;
5686 proc
= get_process (process
);
5687 validate_region (&start
, &end
);
5689 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5690 move_gap (XINT (start
));
5692 start1
= CHAR_TO_BYTE (XINT (start
));
5693 end1
= CHAR_TO_BYTE (XINT (end
));
5694 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5695 Fcurrent_buffer ());
5700 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5702 doc
: /* Send PROCESS the contents of STRING as input.
5703 PROCESS may be a process, a buffer, the name of a process or buffer, or
5704 nil, indicating the current buffer's process.
5705 If STRING is more than 500 characters long,
5706 it is sent in several bunches. This may happen even for shorter strings.
5707 Output from processes can arrive in between bunches. */)
5709 Lisp_Object process
, string
;
5712 CHECK_STRING (string
);
5713 proc
= get_process (process
);
5714 send_process (proc
, SDATA (string
),
5715 SBYTES (string
), string
);
5719 /* Return the foreground process group for the tty/pty that
5720 the process P uses. */
5722 emacs_get_tty_pgrp (p
)
5723 struct Lisp_Process
*p
;
5728 if (ioctl (p
->infd
, TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5731 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5732 master side. Try the slave side. */
5733 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5737 ioctl (fd
, TIOCGPGRP
, &gid
);
5741 #endif /* defined (TIOCGPGRP ) */
5746 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5747 Sprocess_running_child_p
, 0, 1, 0,
5748 doc
: /* Return t if PROCESS has given the terminal to a child.
5749 If the operating system does not make it possible to find out,
5750 return t unconditionally. */)
5752 Lisp_Object process
;
5754 /* Initialize in case ioctl doesn't exist or gives an error,
5755 in a way that will cause returning t. */
5758 struct Lisp_Process
*p
;
5760 proc
= get_process (process
);
5761 p
= XPROCESS (proc
);
5763 if (!EQ (p
->childp
, Qt
))
5764 error ("Process %s is not a subprocess",
5767 error ("Process %s is not active",
5770 gid
= emacs_get_tty_pgrp (p
);
5777 /* send a signal number SIGNO to PROCESS.
5778 If CURRENT_GROUP is t, that means send to the process group
5779 that currently owns the terminal being used to communicate with PROCESS.
5780 This is used for various commands in shell mode.
5781 If CURRENT_GROUP is lambda, that means send to the process group
5782 that currently owns the terminal, but only if it is NOT the shell itself.
5784 If NOMSG is zero, insert signal-announcements into process's buffers
5787 If we can, we try to signal PROCESS by sending control characters
5788 down the pty. This allows us to signal inferiors who have changed
5789 their uid, for which killpg would return an EPERM error. */
5792 process_send_signal (process
, signo
, current_group
, nomsg
)
5793 Lisp_Object process
;
5795 Lisp_Object current_group
;
5799 register struct Lisp_Process
*p
;
5803 proc
= get_process (process
);
5804 p
= XPROCESS (proc
);
5806 if (!EQ (p
->childp
, Qt
))
5807 error ("Process %s is not a subprocess",
5810 error ("Process %s is not active",
5814 current_group
= Qnil
;
5816 /* If we are using pgrps, get a pgrp number and make it negative. */
5817 if (NILP (current_group
))
5818 /* Send the signal to the shell's process group. */
5822 #ifdef SIGNALS_VIA_CHARACTERS
5823 /* If possible, send signals to the entire pgrp
5824 by sending an input character to it. */
5826 /* TERMIOS is the latest and bestest, and seems most likely to
5827 work. If the system has it, use it. */
5830 cc_t
*sig_char
= NULL
;
5832 tcgetattr (p
->infd
, &t
);
5837 sig_char
= &t
.c_cc
[VINTR
];
5841 sig_char
= &t
.c_cc
[VQUIT
];
5845 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5846 sig_char
= &t
.c_cc
[VSWTCH
];
5848 sig_char
= &t
.c_cc
[VSUSP
];
5853 if (sig_char
&& *sig_char
!= CDISABLE
)
5855 send_process (proc
, sig_char
, 1, Qnil
);
5858 /* If we can't send the signal with a character,
5859 fall through and send it another way. */
5860 #else /* ! HAVE_TERMIOS */
5862 /* On Berkeley descendants, the following IOCTL's retrieve the
5863 current control characters. */
5864 #if defined (TIOCGLTC) && defined (TIOCGETC)
5872 ioctl (p
->infd
, TIOCGETC
, &c
);
5873 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5876 ioctl (p
->infd
, TIOCGETC
, &c
);
5877 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5881 ioctl (p
->infd
, TIOCGLTC
, &lc
);
5882 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5884 #endif /* ! defined (SIGTSTP) */
5887 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5889 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5896 ioctl (p
->infd
, TCGETA
, &t
);
5897 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5900 ioctl (p
->infd
, TCGETA
, &t
);
5901 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5905 ioctl (p
->infd
, TCGETA
, &t
);
5906 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5908 #endif /* ! defined (SIGTSTP) */
5910 #else /* ! defined (TCGETA) */
5911 Your configuration files are messed up
.
5912 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5913 you'd better be using one of the alternatives above! */
5914 #endif /* ! defined (TCGETA) */
5915 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5916 /* In this case, the code above should alway returns. */
5918 #endif /* ! defined HAVE_TERMIOS */
5920 /* The code above may fall through if it can't
5921 handle the signal. */
5922 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5925 /* Get the current pgrp using the tty itself, if we have that.
5926 Otherwise, use the pty to get the pgrp.
5927 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5928 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5929 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5930 His patch indicates that if TIOCGPGRP returns an error, then
5931 we should just assume that p->pid is also the process group id. */
5933 gid
= emacs_get_tty_pgrp (p
);
5936 /* If we can't get the information, assume
5937 the shell owns the tty. */
5940 /* It is not clear whether anything really can set GID to -1.
5941 Perhaps on some system one of those ioctls can or could do so.
5942 Or perhaps this is vestigial. */
5945 #else /* ! defined (TIOCGPGRP ) */
5946 /* Can't select pgrps on this system, so we know that
5947 the child itself heads the pgrp. */
5949 #endif /* ! defined (TIOCGPGRP ) */
5951 /* If current_group is lambda, and the shell owns the terminal,
5952 don't send any signal. */
5953 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
5961 p
->raw_status_new
= 0;
5963 p
->tick
= ++process_tick
;
5965 status_notify (NULL
);
5967 #endif /* ! defined (SIGCONT) */
5970 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5975 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5980 sys$
forcex (&(p
->pid
), 0, 1);
5983 flush_pending_output (p
->infd
);
5987 /* If we don't have process groups, send the signal to the immediate
5988 subprocess. That isn't really right, but it's better than any
5989 obvious alternative. */
5992 kill (p
->pid
, signo
);
5996 /* gid may be a pid, or minus a pgrp's number */
5998 if (!NILP (current_group
))
6000 if (ioctl (p
->infd
, TIOCSIGSEND
, signo
) == -1)
6001 EMACS_KILLPG (gid
, signo
);
6008 #else /* ! defined (TIOCSIGSEND) */
6009 EMACS_KILLPG (gid
, signo
);
6010 #endif /* ! defined (TIOCSIGSEND) */
6013 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
6014 doc
: /* Interrupt process PROCESS.
6015 PROCESS may be a process, a buffer, or the name of a process or buffer.
6016 No arg or nil means current buffer's process.
6017 Second arg CURRENT-GROUP non-nil means send signal to
6018 the current process-group of the process's controlling terminal
6019 rather than to the process's own process group.
6020 If the process is a shell, this means interrupt current subjob
6021 rather than the shell.
6023 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6024 don't send the signal. */)
6025 (process
, current_group
)
6026 Lisp_Object process
, current_group
;
6028 process_send_signal (process
, SIGINT
, current_group
, 0);
6032 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
6033 doc
: /* Kill process PROCESS. May be process or name of one.
6034 See function `interrupt-process' for more details on usage. */)
6035 (process
, current_group
)
6036 Lisp_Object process
, current_group
;
6038 process_send_signal (process
, SIGKILL
, current_group
, 0);
6042 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
6043 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
6044 See function `interrupt-process' for more details on usage. */)
6045 (process
, current_group
)
6046 Lisp_Object process
, current_group
;
6048 process_send_signal (process
, SIGQUIT
, current_group
, 0);
6052 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
6053 doc
: /* Stop process PROCESS. May be process or name of one.
6054 See function `interrupt-process' for more details on usage.
6055 If PROCESS is a network process, inhibit handling of incoming traffic. */)
6056 (process
, current_group
)
6057 Lisp_Object process
, current_group
;
6060 if (PROCESSP (process
) && NETCONN_P (process
))
6062 struct Lisp_Process
*p
;
6064 p
= XPROCESS (process
);
6065 if (NILP (p
->command
)
6068 FD_CLR (p
->infd
, &input_wait_mask
);
6069 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6076 error ("No SIGTSTP support");
6078 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6083 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6084 doc
: /* Continue process PROCESS. May be process or name of one.
6085 See function `interrupt-process' for more details on usage.
6086 If PROCESS is a network process, resume handling of incoming traffic. */)
6087 (process
, current_group
)
6088 Lisp_Object process
, current_group
;
6091 if (PROCESSP (process
) && NETCONN_P (process
))
6093 struct Lisp_Process
*p
;
6095 p
= XPROCESS (process
);
6096 if (EQ (p
->command
, Qt
)
6098 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6100 FD_SET (p
->infd
, &input_wait_mask
);
6101 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
6108 process_send_signal (process
, SIGCONT
, current_group
, 0);
6110 error ("No SIGCONT support");
6115 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6116 2, 2, "sProcess (name or number): \nnSignal code: ",
6117 doc
: /* Send PROCESS the signal with code SIGCODE.
6118 PROCESS may also be a number specifying the process id of the
6119 process to signal; in this case, the process need not be a child of
6121 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6123 Lisp_Object process
, sigcode
;
6127 if (INTEGERP (process
))
6129 pid
= XINT (process
);
6133 if (FLOATP (process
))
6135 pid
= (pid_t
) XFLOAT_DATA (process
);
6139 if (STRINGP (process
))
6142 if (tem
= Fget_process (process
), NILP (tem
))
6144 pid
= XINT (Fstring_to_number (process
, make_number (10)));
6151 process
= get_process (process
);
6156 CHECK_PROCESS (process
);
6157 pid
= XPROCESS (process
)->pid
;
6159 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6163 #define parse_signal(NAME, VALUE) \
6164 else if (!xstricmp (name, NAME)) \
6165 XSETINT (sigcode, VALUE)
6167 if (INTEGERP (sigcode
))
6171 unsigned char *name
;
6173 CHECK_SYMBOL (sigcode
);
6174 name
= SDATA (SYMBOL_NAME (sigcode
));
6176 if (!strncmp(name
, "SIG", 3) || !strncmp(name
, "sig", 3))
6182 parse_signal ("usr1", SIGUSR1
);
6185 parse_signal ("usr2", SIGUSR2
);
6188 parse_signal ("term", SIGTERM
);
6191 parse_signal ("hup", SIGHUP
);
6194 parse_signal ("int", SIGINT
);
6197 parse_signal ("quit", SIGQUIT
);
6200 parse_signal ("ill", SIGILL
);
6203 parse_signal ("abrt", SIGABRT
);
6206 parse_signal ("emt", SIGEMT
);
6209 parse_signal ("kill", SIGKILL
);
6212 parse_signal ("fpe", SIGFPE
);
6215 parse_signal ("bus", SIGBUS
);
6218 parse_signal ("segv", SIGSEGV
);
6221 parse_signal ("sys", SIGSYS
);
6224 parse_signal ("pipe", SIGPIPE
);
6227 parse_signal ("alrm", SIGALRM
);
6230 parse_signal ("urg", SIGURG
);
6233 parse_signal ("stop", SIGSTOP
);
6236 parse_signal ("tstp", SIGTSTP
);
6239 parse_signal ("cont", SIGCONT
);
6242 parse_signal ("chld", SIGCHLD
);
6245 parse_signal ("ttin", SIGTTIN
);
6248 parse_signal ("ttou", SIGTTOU
);
6251 parse_signal ("io", SIGIO
);
6254 parse_signal ("xcpu", SIGXCPU
);
6257 parse_signal ("xfsz", SIGXFSZ
);
6260 parse_signal ("vtalrm", SIGVTALRM
);
6263 parse_signal ("prof", SIGPROF
);
6266 parse_signal ("winch", SIGWINCH
);
6269 parse_signal ("info", SIGINFO
);
6272 error ("Undefined signal name %s", name
);
6277 return make_number (kill (pid
, XINT (sigcode
)));
6280 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6281 doc
: /* Make PROCESS see end-of-file in its input.
6282 EOF comes after any text already sent to it.
6283 PROCESS may be a process, a buffer, the name of a process or buffer, or
6284 nil, indicating the current buffer's process.
6285 If PROCESS is a network connection, or is a process communicating
6286 through a pipe (as opposed to a pty), then you cannot send any more
6287 text to PROCESS after you call this function. */)
6289 Lisp_Object process
;
6292 struct coding_system
*coding
;
6294 if (DATAGRAM_CONN_P (process
))
6297 proc
= get_process (process
);
6298 coding
= proc_encode_coding_system
[XPROCESS (proc
)->outfd
];
6300 /* Make sure the process is really alive. */
6301 if (XPROCESS (proc
)->raw_status_new
)
6302 update_status (XPROCESS (proc
));
6303 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6304 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6306 if (CODING_REQUIRE_FLUSHING (coding
))
6308 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6309 send_process (proc
, "", 0, Qnil
);
6313 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6315 if (XPROCESS (proc
)->pty_flag
)
6316 send_process (proc
, "\004", 1, Qnil
);
6319 int old_outfd
, new_outfd
;
6321 #ifdef HAVE_SHUTDOWN
6322 /* If this is a network connection, or socketpair is used
6323 for communication with the subprocess, call shutdown to cause EOF.
6324 (In some old system, shutdown to socketpair doesn't work.
6325 Then we just can't win.) */
6326 if (XPROCESS (proc
)->pid
== 0
6327 || XPROCESS (proc
)->outfd
== XPROCESS (proc
)->infd
)
6328 shutdown (XPROCESS (proc
)->outfd
, 1);
6329 /* In case of socketpair, outfd == infd, so don't close it. */
6330 if (XPROCESS (proc
)->outfd
!= XPROCESS (proc
)->infd
)
6331 emacs_close (XPROCESS (proc
)->outfd
);
6332 #else /* not HAVE_SHUTDOWN */
6333 emacs_close (XPROCESS (proc
)->outfd
);
6334 #endif /* not HAVE_SHUTDOWN */
6335 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6338 old_outfd
= XPROCESS (proc
)->outfd
;
6340 if (!proc_encode_coding_system
[new_outfd
])
6341 proc_encode_coding_system
[new_outfd
]
6342 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6343 bcopy (proc_encode_coding_system
[old_outfd
],
6344 proc_encode_coding_system
[new_outfd
],
6345 sizeof (struct coding_system
));
6346 bzero (proc_encode_coding_system
[old_outfd
],
6347 sizeof (struct coding_system
));
6349 XPROCESS (proc
)->outfd
= new_outfd
;
6355 /* Kill all processes associated with `buffer'.
6356 If `buffer' is nil, kill all processes */
6359 kill_buffer_processes (buffer
)
6362 Lisp_Object tail
, proc
;
6364 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6366 proc
= XCDR (XCAR (tail
));
6368 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6370 if (NETCONN_P (proc
))
6371 Fdelete_process (proc
);
6372 else if (XPROCESS (proc
)->infd
>= 0)
6373 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6378 /* On receipt of a signal that a child status has changed, loop asking
6379 about children with changed statuses until the system says there
6382 All we do is change the status; we do not run sentinels or print
6383 notifications. That is saved for the next time keyboard input is
6384 done, in order to avoid timing errors.
6386 ** WARNING: this can be called during garbage collection.
6387 Therefore, it must not be fooled by the presence of mark bits in
6390 ** USG WARNING: Although it is not obvious from the documentation
6391 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6392 signal() before executing at least one wait(), otherwise the
6393 handler will be called again, resulting in an infinite loop. The
6394 relevant portion of the documentation reads "SIGCLD signals will be
6395 queued and the signal-catching function will be continually
6396 reentered until the queue is empty". Invoking signal() causes the
6397 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6400 ** Malloc WARNING: This should never call malloc either directly or
6401 indirectly; if it does, that is a bug */
6405 sigchld_handler (signo
)
6408 int old_errno
= errno
;
6410 register struct Lisp_Process
*p
;
6411 extern EMACS_TIME
*input_available_clear_time
;
6413 SIGNAL_THREAD_CHECK (signo
);
6417 sigheld
|= sigbit (SIGCHLD
);
6429 #endif /* no WUNTRACED */
6430 /* Keep trying to get a status until we get a definitive result. */
6434 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6436 while (pid
< 0 && errno
== EINTR
);
6440 /* PID == 0 means no processes found, PID == -1 means a real
6441 failure. We have done all our job, so return. */
6443 /* USG systems forget handlers when they are used;
6444 must reestablish each time */
6445 #if defined (USG) && !defined (POSIX_SIGNALS)
6446 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6449 sigheld
&= ~sigbit (SIGCHLD
);
6457 #endif /* no WNOHANG */
6459 /* Find the process that signaled us, and record its status. */
6461 /* The process can have been deleted by Fdelete_process. */
6462 for (tail
= deleted_pid_list
; CONSP (tail
); tail
= XCDR (tail
))
6464 Lisp_Object xpid
= XCAR (tail
);
6465 if ((INTEGERP (xpid
) && pid
== (pid_t
) XINT (xpid
))
6466 || (FLOATP (xpid
) && pid
== (pid_t
) XFLOAT_DATA (xpid
)))
6468 XSETCAR (tail
, Qnil
);
6469 goto sigchld_end_of_loop
;
6473 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6475 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6477 proc
= XCDR (XCAR (tail
));
6478 p
= XPROCESS (proc
);
6479 if (EQ (p
->childp
, Qt
) && p
->pid
== pid
)
6484 /* Look for an asynchronous process whose pid hasn't been filled
6487 for (tail
= Vprocess_alist
; CONSP (tail
); tail
= XCDR (tail
))
6489 proc
= XCDR (XCAR (tail
));
6490 p
= XPROCESS (proc
);
6496 /* Change the status of the process that was found. */
6499 union { int i
; WAITTYPE wt
; } u
;
6500 int clear_desc_flag
= 0;
6502 p
->tick
= ++process_tick
;
6504 p
->raw_status
= u
.i
;
6505 p
->raw_status_new
= 1;
6507 /* If process has terminated, stop waiting for its output. */
6508 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6510 clear_desc_flag
= 1;
6512 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6513 if (clear_desc_flag
)
6515 FD_CLR (p
->infd
, &input_wait_mask
);
6516 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6519 /* Tell wait_reading_process_output that it needs to wake up and
6521 if (input_available_clear_time
)
6522 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6525 /* There was no asynchronous process found for that pid: we have
6526 a synchronous process. */
6529 synch_process_alive
= 0;
6531 /* Report the status of the synchronous process. */
6533 synch_process_retcode
= WRETCODE (w
);
6534 else if (WIFSIGNALED (w
))
6535 synch_process_termsig
= WTERMSIG (w
);
6537 /* Tell wait_reading_process_output that it needs to wake up and
6539 if (input_available_clear_time
)
6540 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6543 sigchld_end_of_loop
:
6546 /* On some systems, we must return right away.
6547 If any more processes want to signal us, we will
6549 Otherwise (on systems that have WNOHANG), loop around
6550 to use up all the processes that have something to tell us. */
6551 #if (defined WINDOWSNT \
6552 || (defined USG && !defined GNU_LINUX \
6553 && !(defined HPUX && defined WNOHANG)))
6554 #if defined (USG) && ! defined (POSIX_SIGNALS)
6555 signal (signo
, sigchld_handler
);
6559 #endif /* USG, but not HPUX with WNOHANG */
6562 #endif /* SIGCHLD */
6566 exec_sentinel_unwind (data
)
6569 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6574 exec_sentinel_error_handler (error
)
6577 cmd_error_internal (error
, "error in process sentinel: ");
6579 update_echo_area ();
6580 Fsleep_for (make_number (2), Qnil
);
6585 exec_sentinel (proc
, reason
)
6586 Lisp_Object proc
, reason
;
6588 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6589 register struct Lisp_Process
*p
= XPROCESS (proc
);
6590 int count
= SPECPDL_INDEX ();
6591 int outer_running_asynch_code
= running_asynch_code
;
6592 int waiting
= waiting_for_user_input_p
;
6594 if (inhibit_sentinels
)
6597 /* No need to gcpro these, because all we do with them later
6598 is test them for EQness, and none of them should be a string. */
6599 odeactivate
= Vdeactivate_mark
;
6600 XSETBUFFER (obuffer
, current_buffer
);
6601 okeymap
= current_buffer
->keymap
;
6603 sentinel
= p
->sentinel
;
6604 if (NILP (sentinel
))
6607 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6608 assure that it gets restored no matter how the sentinel exits. */
6610 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6611 /* Inhibit quit so that random quits don't screw up a running filter. */
6612 specbind (Qinhibit_quit
, Qt
);
6613 specbind (Qlast_nonmenu_event
, Qt
);
6615 /* In case we get recursively called,
6616 and we already saved the match data nonrecursively,
6617 save the same match data in safely recursive fashion. */
6618 if (outer_running_asynch_code
)
6621 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6622 restore_search_regs ();
6623 record_unwind_save_match_data ();
6624 Fset_match_data (tem
, Qt
);
6627 /* For speed, if a search happens within this code,
6628 save the match data in a special nonrecursive fashion. */
6629 running_asynch_code
= 1;
6631 internal_condition_case_1 (read_process_output_call
,
6633 Fcons (proc
, Fcons (reason
, Qnil
))),
6634 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6635 exec_sentinel_error_handler
);
6637 /* If we saved the match data nonrecursively, restore it now. */
6638 restore_search_regs ();
6639 running_asynch_code
= outer_running_asynch_code
;
6641 Vdeactivate_mark
= odeactivate
;
6643 /* Restore waiting_for_user_input_p as it was
6644 when we were called, in case the filter clobbered it. */
6645 waiting_for_user_input_p
= waiting
;
6648 if (! EQ (Fcurrent_buffer (), obuffer
)
6649 || ! EQ (current_buffer
->keymap
, okeymap
))
6651 /* But do it only if the caller is actually going to read events.
6652 Otherwise there's no need to make him wake up, and it could
6653 cause trouble (for example it would make sit_for return). */
6654 if (waiting_for_user_input_p
== -1)
6655 record_asynch_buffer_change ();
6657 unbind_to (count
, Qnil
);
6660 /* Report all recent events of a change in process status
6661 (either run the sentinel or output a message).
6662 This is usually done while Emacs is waiting for keyboard input
6663 but can be done at other times. */
6666 status_notify (deleting_process
)
6667 struct Lisp_Process
*deleting_process
;
6669 register Lisp_Object proc
, buffer
;
6670 Lisp_Object tail
, msg
;
6671 struct gcpro gcpro1
, gcpro2
;
6675 /* We need to gcpro tail; if read_process_output calls a filter
6676 which deletes a process and removes the cons to which tail points
6677 from Vprocess_alist, and then causes a GC, tail is an unprotected
6681 /* Set this now, so that if new processes are created by sentinels
6682 that we run, we get called again to handle their status changes. */
6683 update_tick
= process_tick
;
6685 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6688 register struct Lisp_Process
*p
;
6690 proc
= Fcdr (Fcar (tail
));
6691 p
= XPROCESS (proc
);
6693 if (p
->tick
!= p
->update_tick
)
6695 p
->update_tick
= p
->tick
;
6697 /* If process is still active, read any output that remains. */
6698 while (! EQ (p
->filter
, Qt
)
6699 && ! EQ (p
->status
, Qconnect
)
6700 && ! EQ (p
->status
, Qlisten
)
6701 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6703 && p
!= deleting_process
6704 && read_process_output (proc
, p
->infd
) > 0);
6708 /* Get the text to use for the message. */
6709 if (p
->raw_status_new
)
6711 msg
= status_message (p
);
6713 /* If process is terminated, deactivate it or delete it. */
6715 if (CONSP (p
->status
))
6716 symbol
= XCAR (p
->status
);
6718 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6719 || EQ (symbol
, Qclosed
))
6721 if (delete_exited_processes
)
6722 remove_process (proc
);
6724 deactivate_process (proc
);
6727 /* The actions above may have further incremented p->tick.
6728 So set p->update_tick again
6729 so that an error in the sentinel will not cause
6730 this code to be run again. */
6731 p
->update_tick
= p
->tick
;
6732 /* Now output the message suitably. */
6733 if (!NILP (p
->sentinel
))
6734 exec_sentinel (proc
, msg
);
6735 /* Don't bother with a message in the buffer
6736 when a process becomes runnable. */
6737 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6739 Lisp_Object ro
, tem
;
6740 struct buffer
*old
= current_buffer
;
6741 int opoint
, opoint_byte
;
6742 int before
, before_byte
;
6744 ro
= XBUFFER (buffer
)->read_only
;
6746 /* Avoid error if buffer is deleted
6747 (probably that's why the process is dead, too) */
6748 if (NILP (XBUFFER (buffer
)->name
))
6750 Fset_buffer (buffer
);
6753 opoint_byte
= PT_BYTE
;
6754 /* Insert new output into buffer
6755 at the current end-of-output marker,
6756 thus preserving logical ordering of input and output. */
6757 if (XMARKER (p
->mark
)->buffer
)
6758 Fgoto_char (p
->mark
);
6760 SET_PT_BOTH (ZV
, ZV_BYTE
);
6763 before_byte
= PT_BYTE
;
6765 tem
= current_buffer
->read_only
;
6766 current_buffer
->read_only
= Qnil
;
6767 insert_string ("\nProcess ");
6768 Finsert (1, &p
->name
);
6769 insert_string (" ");
6771 current_buffer
->read_only
= tem
;
6772 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6774 if (opoint
>= before
)
6775 SET_PT_BOTH (opoint
+ (PT
- before
),
6776 opoint_byte
+ (PT_BYTE
- before_byte
));
6778 SET_PT_BOTH (opoint
, opoint_byte
);
6780 set_buffer_internal (old
);
6785 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6786 redisplay_preserve_echo_area (13);
6792 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6793 Sset_process_coding_system
, 1, 3, 0,
6794 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6795 DECODING will be used to decode subprocess output and ENCODING to
6796 encode subprocess input. */)
6797 (process
, decoding
, encoding
)
6798 register Lisp_Object process
, decoding
, encoding
;
6800 register struct Lisp_Process
*p
;
6802 CHECK_PROCESS (process
);
6803 p
= XPROCESS (process
);
6805 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6807 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6808 Fcheck_coding_system (decoding
);
6809 Fcheck_coding_system (encoding
);
6810 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
6811 p
->decode_coding_system
= decoding
;
6812 p
->encode_coding_system
= encoding
;
6813 setup_process_coding_systems (process
);
6818 DEFUN ("process-coding-system",
6819 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6820 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6822 register Lisp_Object process
;
6824 CHECK_PROCESS (process
);
6825 return Fcons (XPROCESS (process
)->decode_coding_system
,
6826 XPROCESS (process
)->encode_coding_system
);
6829 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6830 Sset_process_filter_multibyte
, 2, 2, 0,
6831 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6832 If FLAG is non-nil, the filter is given multibyte strings.
6833 If FLAG is nil, the filter is given unibyte strings. In this case,
6834 all character code conversion except for end-of-line conversion is
6837 Lisp_Object process
, flag
;
6839 register struct Lisp_Process
*p
;
6841 CHECK_PROCESS (process
);
6842 p
= XPROCESS (process
);
6843 p
->filter_multibyte
= !NILP (flag
);
6844 setup_process_coding_systems (process
);
6849 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6850 Sprocess_filter_multibyte_p
, 1, 1, 0,
6851 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6853 Lisp_Object process
;
6855 register struct Lisp_Process
*p
;
6857 CHECK_PROCESS (process
);
6858 p
= XPROCESS (process
);
6860 return (p
->filter_multibyte
? Qt
: Qnil
);
6865 /* The first time this is called, assume keyboard input comes from DESC
6866 instead of from where we used to expect it.
6867 Subsequent calls mean assume input keyboard can come from DESC
6868 in addition to other places. */
6870 static int add_keyboard_wait_descriptor_called_flag
;
6873 add_keyboard_wait_descriptor (desc
)
6876 if (! add_keyboard_wait_descriptor_called_flag
)
6877 FD_CLR (0, &input_wait_mask
);
6878 add_keyboard_wait_descriptor_called_flag
= 1;
6879 FD_SET (desc
, &input_wait_mask
);
6880 FD_SET (desc
, &non_process_wait_mask
);
6881 if (desc
> max_keyboard_desc
)
6882 max_keyboard_desc
= desc
;
6885 static int add_gpm_wait_descriptor_called_flag
;
6888 add_gpm_wait_descriptor (desc
)
6891 if (! add_gpm_wait_descriptor_called_flag
)
6892 FD_CLR (0, &input_wait_mask
);
6893 add_gpm_wait_descriptor_called_flag
= 1;
6894 FD_SET (desc
, &input_wait_mask
);
6895 FD_SET (desc
, &gpm_wait_mask
);
6896 if (desc
> max_gpm_desc
)
6897 max_gpm_desc
= desc
;
6900 /* From now on, do not expect DESC to give keyboard input. */
6903 delete_keyboard_wait_descriptor (desc
)
6907 int lim
= max_keyboard_desc
;
6909 FD_CLR (desc
, &input_wait_mask
);
6910 FD_CLR (desc
, &non_process_wait_mask
);
6912 if (desc
== max_keyboard_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
, &gpm_wait_mask
))
6917 max_keyboard_desc
= fd
;
6921 delete_gpm_wait_descriptor (desc
)
6925 int lim
= max_gpm_desc
;
6927 FD_CLR (desc
, &input_wait_mask
);
6928 FD_CLR (desc
, &non_process_wait_mask
);
6930 if (desc
== max_gpm_desc
)
6931 for (fd
= 0; fd
< lim
; fd
++)
6932 if (FD_ISSET (fd
, &input_wait_mask
)
6933 && !FD_ISSET (fd
, &non_keyboard_wait_mask
)
6934 && !FD_ISSET (fd
, &non_process_wait_mask
))
6938 /* Return nonzero if *MASK has a bit set
6939 that corresponds to one of the keyboard input descriptors. */
6942 keyboard_bit_set (mask
)
6947 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6948 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6949 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6960 inhibit_sentinels
= 0;
6964 if (! noninteractive
|| initialized
)
6966 signal (SIGCHLD
, sigchld_handler
);
6969 FD_ZERO (&input_wait_mask
);
6970 FD_ZERO (&non_keyboard_wait_mask
);
6971 FD_ZERO (&non_process_wait_mask
);
6972 max_process_desc
= 0;
6974 #ifdef NON_BLOCKING_CONNECT
6975 FD_ZERO (&connect_wait_mask
);
6976 num_pending_connects
= 0;
6979 #ifdef ADAPTIVE_READ_BUFFERING
6980 process_output_delay_count
= 0;
6981 process_output_skip
= 0;
6984 FD_SET (0, &input_wait_mask
);
6986 Vprocess_alist
= Qnil
;
6988 deleted_pid_list
= Qnil
;
6990 for (i
= 0; i
< MAXDESC
; i
++)
6992 chan_process
[i
] = Qnil
;
6993 proc_buffered_char
[i
] = -1;
6995 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6996 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6997 #ifdef DATAGRAM_SOCKETS
6998 bzero (datagram_address
, sizeof datagram_address
);
7003 Lisp_Object subfeatures
= Qnil
;
7004 struct socket_options
*sopt
;
7006 #define ADD_SUBFEATURE(key, val) \
7007 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
7009 #ifdef NON_BLOCKING_CONNECT
7010 ADD_SUBFEATURE (QCnowait
, Qt
);
7012 #ifdef DATAGRAM_SOCKETS
7013 ADD_SUBFEATURE (QCtype
, Qdatagram
);
7015 #ifdef HAVE_LOCAL_SOCKETS
7016 ADD_SUBFEATURE (QCfamily
, Qlocal
);
7018 ADD_SUBFEATURE (QCfamily
, Qipv4
);
7020 ADD_SUBFEATURE (QCfamily
, Qipv6
);
7022 #ifdef HAVE_GETSOCKNAME
7023 ADD_SUBFEATURE (QCservice
, Qt
);
7025 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
7026 ADD_SUBFEATURE (QCserver
, Qt
);
7029 for (sopt
= socket_options
; sopt
->name
; sopt
++)
7030 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
7032 Fprovide (intern ("make-network-process"), subfeatures
);
7034 #endif /* HAVE_SOCKETS */
7036 #if defined (DARWIN) || defined (MAC_OSX)
7037 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7038 processes. As such, we only change the default value. */
7041 char *release
= get_operating_system_release();
7042 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
7043 && release
[1] == '.')) {
7044 Vprocess_connection_type
= Qnil
;
7053 Qprocessp
= intern ("processp");
7054 staticpro (&Qprocessp
);
7055 Qrun
= intern ("run");
7057 Qstop
= intern ("stop");
7059 Qsignal
= intern ("signal");
7060 staticpro (&Qsignal
);
7062 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7065 Qexit = intern ("exit");
7066 staticpro (&Qexit); */
7068 Qopen
= intern ("open");
7070 Qclosed
= intern ("closed");
7071 staticpro (&Qclosed
);
7072 Qconnect
= intern ("connect");
7073 staticpro (&Qconnect
);
7074 Qfailed
= intern ("failed");
7075 staticpro (&Qfailed
);
7076 Qlisten
= intern ("listen");
7077 staticpro (&Qlisten
);
7078 Qlocal
= intern ("local");
7079 staticpro (&Qlocal
);
7080 Qipv4
= intern ("ipv4");
7083 Qipv6
= intern ("ipv6");
7086 Qdatagram
= intern ("datagram");
7087 staticpro (&Qdatagram
);
7089 QCname
= intern (":name");
7090 staticpro (&QCname
);
7091 QCbuffer
= intern (":buffer");
7092 staticpro (&QCbuffer
);
7093 QChost
= intern (":host");
7094 staticpro (&QChost
);
7095 QCservice
= intern (":service");
7096 staticpro (&QCservice
);
7097 QCtype
= intern (":type");
7098 staticpro (&QCtype
);
7099 QClocal
= intern (":local");
7100 staticpro (&QClocal
);
7101 QCremote
= intern (":remote");
7102 staticpro (&QCremote
);
7103 QCcoding
= intern (":coding");
7104 staticpro (&QCcoding
);
7105 QCserver
= intern (":server");
7106 staticpro (&QCserver
);
7107 QCnowait
= intern (":nowait");
7108 staticpro (&QCnowait
);
7109 QCsentinel
= intern (":sentinel");
7110 staticpro (&QCsentinel
);
7111 QClog
= intern (":log");
7113 QCnoquery
= intern (":noquery");
7114 staticpro (&QCnoquery
);
7115 QCstop
= intern (":stop");
7116 staticpro (&QCstop
);
7117 QCoptions
= intern (":options");
7118 staticpro (&QCoptions
);
7119 QCplist
= intern (":plist");
7120 staticpro (&QCplist
);
7121 QCfilter_multibyte
= intern (":filter-multibyte");
7122 staticpro (&QCfilter_multibyte
);
7124 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
7125 staticpro (&Qlast_nonmenu_event
);
7127 staticpro (&Vprocess_alist
);
7129 staticpro (&deleted_pid_list
);
7132 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
7133 doc
: /* *Non-nil means delete processes immediately when they exit.
7134 A value of nil means don't delete them until `list-processes' is run. */);
7136 delete_exited_processes
= 1;
7138 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
7139 doc
: /* Control type of device used to communicate with subprocesses.
7140 Values are nil to use a pipe, or t or `pty' to use a pty.
7141 The value has no effect if the system has no ptys or if all ptys are busy:
7142 then a pipe is used in any case.
7143 The value takes effect when `start-process' is called. */);
7144 Vprocess_connection_type
= Qt
;
7146 #ifdef ADAPTIVE_READ_BUFFERING
7147 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
7148 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7149 On some systems, when Emacs reads the output from a subprocess, the output data
7150 is read in very small blocks, potentially resulting in very poor performance.
7151 This behavior can be remedied to some extent by setting this variable to a
7152 non-nil value, as it will automatically delay reading from such processes, to
7153 allow them to produce more output before Emacs tries to read it.
7154 If the value is t, the delay is reset after each write to the process; any other
7155 non-nil value means that the delay is not reset on write.
7156 The variable takes effect when `start-process' is called. */);
7157 Vprocess_adaptive_read_buffering
= Qt
;
7160 defsubr (&Sprocessp
);
7161 defsubr (&Sget_process
);
7162 defsubr (&Sget_buffer_process
);
7163 defsubr (&Sdelete_process
);
7164 defsubr (&Sprocess_status
);
7165 defsubr (&Sprocess_exit_status
);
7166 defsubr (&Sprocess_id
);
7167 defsubr (&Sprocess_name
);
7168 defsubr (&Sprocess_tty_name
);
7169 defsubr (&Sprocess_command
);
7170 defsubr (&Sset_process_buffer
);
7171 defsubr (&Sprocess_buffer
);
7172 defsubr (&Sprocess_mark
);
7173 defsubr (&Sset_process_filter
);
7174 defsubr (&Sprocess_filter
);
7175 defsubr (&Sset_process_sentinel
);
7176 defsubr (&Sprocess_sentinel
);
7177 defsubr (&Sset_process_window_size
);
7178 defsubr (&Sset_process_inherit_coding_system_flag
);
7179 defsubr (&Sprocess_inherit_coding_system_flag
);
7180 defsubr (&Sset_process_query_on_exit_flag
);
7181 defsubr (&Sprocess_query_on_exit_flag
);
7182 defsubr (&Sprocess_contact
);
7183 defsubr (&Sprocess_plist
);
7184 defsubr (&Sset_process_plist
);
7185 defsubr (&Slist_processes
);
7186 defsubr (&Sprocess_list
);
7187 defsubr (&Sstart_process
);
7189 defsubr (&Sset_network_process_option
);
7190 defsubr (&Smake_network_process
);
7191 defsubr (&Sformat_network_address
);
7192 #endif /* HAVE_SOCKETS */
7193 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7195 defsubr (&Snetwork_interface_list
);
7197 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7198 defsubr (&Snetwork_interface_info
);
7200 #endif /* HAVE_SOCKETS ... */
7201 #ifdef DATAGRAM_SOCKETS
7202 defsubr (&Sprocess_datagram_address
);
7203 defsubr (&Sset_process_datagram_address
);
7205 defsubr (&Saccept_process_output
);
7206 defsubr (&Sprocess_send_region
);
7207 defsubr (&Sprocess_send_string
);
7208 defsubr (&Sinterrupt_process
);
7209 defsubr (&Skill_process
);
7210 defsubr (&Squit_process
);
7211 defsubr (&Sstop_process
);
7212 defsubr (&Scontinue_process
);
7213 defsubr (&Sprocess_running_child_p
);
7214 defsubr (&Sprocess_send_eof
);
7215 defsubr (&Ssignal_process
);
7216 defsubr (&Swaiting_for_user_input_p
);
7217 /* defsubr (&Sprocess_connection); */
7218 defsubr (&Sset_process_coding_system
);
7219 defsubr (&Sprocess_coding_system
);
7220 defsubr (&Sset_process_filter_multibyte
);
7221 defsubr (&Sprocess_filter_multibyte_p
);
7225 #else /* not subprocesses */
7227 #include <sys/types.h>
7231 #include "systime.h"
7232 #include "character.h"
7234 #include "termopts.h"
7235 #include "sysselect.h"
7237 extern int frame_garbaged
;
7239 extern EMACS_TIME
timer_check ();
7240 extern int timers_run
;
7244 /* As described above, except assuming that there are no subprocesses:
7246 Wait for timeout to elapse and/or keyboard input to be available.
7249 timeout in seconds, or
7250 zero for no limit, or
7251 -1 means gobble data immediately available but don't wait for any.
7253 read_kbd is a Lisp_Object:
7254 0 to ignore keyboard input, or
7255 1 to return when input is available, or
7256 -1 means caller will actually read the input, so don't throw to
7259 see full version for other parameters. We know that wait_proc will
7260 always be NULL, since `subprocesses' isn't defined.
7262 do_display != 0 means redisplay should be done to show subprocess
7263 output that arrives.
7265 Return true iff we received input from any process. */
7268 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
7269 wait_for_cell
, wait_proc
, just_wait_proc
)
7270 int time_limit
, microsecs
, read_kbd
, do_display
;
7271 Lisp_Object wait_for_cell
;
7272 struct Lisp_Process
*wait_proc
;
7276 EMACS_TIME end_time
, timeout
;
7277 SELECT_TYPE waitchannels
;
7280 /* What does time_limit really mean? */
7281 if (time_limit
|| microsecs
)
7283 EMACS_GET_TIME (end_time
);
7284 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
7285 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
7288 /* Turn off periodic alarms (in case they are in use)
7289 and then turn off any other atimers,
7290 because the select emulator uses alarms. */
7292 turn_on_atimers (0);
7296 int timeout_reduced_for_timers
= 0;
7298 /* If calling from keyboard input, do not quit
7299 since we want to return C-g as an input character.
7300 Otherwise, do pending quit if requested. */
7304 /* Exit now if the cell we're waiting for became non-nil. */
7305 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7308 /* Compute time from now till when time limit is up */
7309 /* Exit if already run out */
7310 if (time_limit
== -1)
7312 /* -1 specified for timeout means
7313 gobble output available now
7314 but don't wait at all. */
7316 EMACS_SET_SECS_USECS (timeout
, 0, 0);
7318 else if (time_limit
|| microsecs
)
7320 EMACS_GET_TIME (timeout
);
7321 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
7322 if (EMACS_TIME_NEG_P (timeout
))
7327 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
7330 /* If our caller will not immediately handle keyboard events,
7331 run timer events directly.
7332 (Callers that will immediately read keyboard events
7333 call timer_delay on their own.) */
7334 if (NILP (wait_for_cell
))
7336 EMACS_TIME timer_delay
;
7340 int old_timers_run
= timers_run
;
7341 timer_delay
= timer_check (1);
7342 if (timers_run
!= old_timers_run
&& do_display
)
7343 /* We must retry, since a timer may have requeued itself
7344 and that could alter the time delay. */
7345 redisplay_preserve_echo_area (14);
7349 while (!detect_input_pending ());
7351 /* If there is unread keyboard input, also return. */
7353 && requeued_events_pending_p ())
7356 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
7358 EMACS_TIME difference
;
7359 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
7360 if (EMACS_TIME_NEG_P (difference
))
7362 timeout
= timer_delay
;
7363 timeout_reduced_for_timers
= 1;
7368 /* Cause C-g and alarm signals to take immediate action,
7369 and cause input available signals to zero out timeout. */
7371 set_waiting_for_input (&timeout
);
7373 /* Wait till there is something to do. */
7375 if (! read_kbd
&& NILP (wait_for_cell
))
7376 FD_ZERO (&waitchannels
);
7378 FD_SET (0, &waitchannels
);
7380 /* If a frame has been newly mapped and needs updating,
7381 reprocess its display stuff. */
7382 if (frame_garbaged
&& do_display
)
7384 clear_waiting_for_input ();
7385 redisplay_preserve_echo_area (15);
7387 set_waiting_for_input (&timeout
);
7390 if (read_kbd
&& detect_input_pending ())
7393 FD_ZERO (&waitchannels
);
7396 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7401 /* Make C-g and alarm signals set flags again */
7402 clear_waiting_for_input ();
7404 /* If we woke up due to SIGWINCH, actually change size now. */
7405 do_pending_window_change (0);
7407 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7408 /* We waited the full specified time, so return now. */
7413 /* If the system call was interrupted, then go around the
7415 if (xerrno
== EINTR
)
7416 FD_ZERO (&waitchannels
);
7418 error ("select error: %s", emacs_strerror (xerrno
));
7421 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7422 /* System sometimes fails to deliver SIGIO. */
7423 kill (getpid (), SIGIO
);
7426 if (read_kbd
&& interrupt_input
&& (waitchannels
& 1))
7427 kill (getpid (), SIGIO
);
7430 /* Check for keyboard input */
7433 && detect_input_pending_run_timers (do_display
))
7435 swallow_events (do_display
);
7436 if (detect_input_pending_run_timers (do_display
))
7440 /* If there is unread keyboard input, also return. */
7442 && requeued_events_pending_p ())
7445 /* If wait_for_cell. check for keyboard input
7446 but don't run any timers.
7447 ??? (It seems wrong to me to check for keyboard
7448 input at all when wait_for_cell, but the code
7449 has been this way since July 1994.
7450 Try changing this after version 19.31.) */
7451 if (! NILP (wait_for_cell
)
7452 && detect_input_pending ())
7454 swallow_events (do_display
);
7455 if (detect_input_pending ())
7459 /* Exit now if the cell we're waiting for became non-nil. */
7460 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7470 /* Don't confuse make-docfile by having two doc strings for this function.
7471 make-docfile does not pay attention to #if, for good reason! */
7472 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7475 register Lisp_Object name
;
7480 /* Don't confuse make-docfile by having two doc strings for this function.
7481 make-docfile does not pay attention to #if, for good reason! */
7482 DEFUN ("process-inherit-coding-system-flag",
7483 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7487 register Lisp_Object process
;
7489 /* Ignore the argument and return the value of
7490 inherit-process-coding-system. */
7491 return inherit_process_coding_system
? Qt
: Qnil
;
7494 /* Kill all processes associated with `buffer'.
7495 If `buffer' is nil, kill all processes.
7496 Since we have no subprocesses, this does nothing. */
7499 kill_buffer_processes (buffer
)
7512 QCtype
= intern (":type");
7513 staticpro (&QCtype
);
7515 defsubr (&Sget_buffer_process
);
7516 defsubr (&Sprocess_inherit_coding_system_flag
);
7520 #endif /* not subprocesses */
7522 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7523 (do not change this comment) */