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 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
27 /* This file is split into two parts by the following preprocessor
28 conditional. The 'then' clause contains all of the support for
29 asynchronous subprocesses. The 'else' clause contains stub
30 versions of some of the asynchronous subprocess routines that are
31 often called elsewhere in Emacs, so we don't have to #ifdef the
32 sections that call them. */
40 #include <sys/types.h> /* some typedefs are used in sys/file.h */
43 #ifdef HAVE_INTTYPES_H
50 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
53 #endif /* not WINDOWSNT */
55 #ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
56 #include <sys/socket.h>
58 #include <netinet/in.h>
59 #include <arpa/inet.h>
60 #ifdef NEED_NET_ERRNO_H
61 #include <net/errno.h>
62 #endif /* NEED_NET_ERRNO_H */
64 /* Are local (unix) sockets supported? */
65 #if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM)
66 #if !defined (AF_LOCAL) && defined (AF_UNIX)
67 #define AF_LOCAL AF_UNIX
70 #define HAVE_LOCAL_SOCKETS
74 #endif /* HAVE_SOCKETS */
76 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
81 /* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
82 #ifdef HAVE_BROKEN_INET_ADDR
83 #define IN_ADDR struct in_addr
84 #define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
86 #define IN_ADDR unsigned long
87 #define NUMERIC_ADDR_ERROR (numeric_addr == -1)
90 #if defined(BSD_SYSTEM) || defined(STRIDE)
91 #include <sys/ioctl.h>
92 #if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
94 #endif /* HAVE_PTYS and no O_NDELAY */
95 #endif /* BSD_SYSTEM || STRIDE */
97 #ifdef BROKEN_O_NONBLOCK
99 #endif /* BROKEN_O_NONBLOCK */
105 /* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
107 #if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
108 /* sys/ioctl.h may have been included already */
110 #include <sys/ioctl.h>
117 #include <sys/sysmacros.h> /* for "minor" */
118 #endif /* not IRIS */
121 #include <sys/wait.h>
124 /* Disable IPv6 support for w32 until someone figures out how to do it
141 #include "termhooks.h"
142 #include "termopts.h"
143 #include "commands.h"
144 #include "keyboard.h"
146 #include "blockinput.h"
147 #include "dispextern.h"
148 #include "composite.h"
151 Lisp_Object Qprocessp
;
152 Lisp_Object Qrun
, Qstop
, Qsignal
;
153 Lisp_Object Qopen
, Qclosed
, Qconnect
, Qfailed
, Qlisten
;
154 Lisp_Object Qlocal
, Qipv4
, Qdatagram
;
158 Lisp_Object QCname
, QCbuffer
, QChost
, QCservice
, QCtype
;
159 Lisp_Object QClocal
, QCremote
, QCcoding
;
160 Lisp_Object QCserver
, QCnowait
, QCnoquery
, QCstop
;
161 Lisp_Object QCsentinel
, QClog
, QCoptions
, QCplist
;
162 Lisp_Object QCfilter_multibyte
;
163 Lisp_Object Qlast_nonmenu_event
;
164 /* QCfamily is declared and initialized in xfaces.c,
165 QCfilter in keyboard.c. */
166 extern Lisp_Object QCfamily
, QCfilter
;
168 /* Qexit is declared and initialized in eval.c. */
170 /* QCfamily is defined in xfaces.c. */
171 extern Lisp_Object QCfamily
;
172 /* QCfilter is defined in keyboard.c. */
173 extern Lisp_Object QCfilter
;
175 /* a process object is a network connection when its childp field is neither
176 Qt nor Qnil but is instead a property list (KEY VAL ...). */
179 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
180 #define NETCONN1_P(p) (GC_CONSP ((p)->childp))
182 #define NETCONN_P(p) 0
183 #define NETCONN1_P(p) 0
184 #endif /* HAVE_SOCKETS */
186 /* Define first descriptor number available for subprocesses. */
188 #define FIRST_PROC_DESC 1
190 #define FIRST_PROC_DESC 3
193 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
196 #if !defined (SIGCHLD) && defined (SIGCLD)
197 #define SIGCHLD SIGCLD
200 #include "syssignal.h"
204 extern char *get_operating_system_release ();
210 extern char *sys_errlist
[];
217 /* t means use pty, nil means use a pipe,
218 maybe other values to come. */
219 static Lisp_Object Vprocess_connection_type
;
223 #include <sys/socket.h>
227 /* These next two vars are non-static since sysdep.c uses them in the
228 emulation of `select'. */
229 /* Number of events of change of status of a process. */
231 /* Number of events for which the user or sentinel has been notified. */
234 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
236 #ifdef BROKEN_NON_BLOCKING_CONNECT
237 #undef NON_BLOCKING_CONNECT
239 #ifndef NON_BLOCKING_CONNECT
242 #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
243 #if defined (O_NONBLOCK) || defined (O_NDELAY)
244 #if defined (EWOULDBLOCK) || defined (EINPROGRESS)
245 #define NON_BLOCKING_CONNECT
246 #endif /* EWOULDBLOCK || EINPROGRESS */
247 #endif /* O_NONBLOCK || O_NDELAY */
248 #endif /* HAVE_GETPEERNAME || GNU_LINUX */
249 #endif /* HAVE_SELECT */
250 #endif /* HAVE_SOCKETS */
251 #endif /* NON_BLOCKING_CONNECT */
252 #endif /* BROKEN_NON_BLOCKING_CONNECT */
254 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
255 this system. We need to read full packets, so we need a
256 "non-destructive" select. So we require either native select,
257 or emulation of select using FIONREAD. */
259 #ifdef BROKEN_DATAGRAM_SOCKETS
260 #undef DATAGRAM_SOCKETS
262 #ifndef DATAGRAM_SOCKETS
264 #if defined (HAVE_SELECT) || defined (FIONREAD)
265 #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
266 #define DATAGRAM_SOCKETS
267 #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
268 #endif /* HAVE_SELECT || FIONREAD */
269 #endif /* HAVE_SOCKETS */
270 #endif /* DATAGRAM_SOCKETS */
271 #endif /* BROKEN_DATAGRAM_SOCKETS */
274 #undef NON_BLOCKING_CONNECT
275 #undef DATAGRAM_SOCKETS
278 #if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
279 #ifdef EMACS_HAS_USECS
280 #define ADAPTIVE_READ_BUFFERING
284 #ifdef ADAPTIVE_READ_BUFFERING
285 #define READ_OUTPUT_DELAY_INCREMENT 10000
286 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
287 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
289 /* Number of processes which have a non-zero read_output_delay,
290 and therefore might be delayed for adaptive read buffering. */
292 static int process_output_delay_count
;
294 /* Non-zero if any process has non-nil read_output_skip. */
296 static int process_output_skip
;
298 /* Non-nil means to delay reading process output to improve buffering.
299 A value of t means that delay is reset after each send, any other
300 non-nil value does not reset the delay. A value of nil disables
301 adaptive read buffering completely. */
302 static Lisp_Object Vprocess_adaptive_read_buffering
;
304 #define process_output_delay_count 0
308 #include "sysselect.h"
310 static int keyboard_bit_set
P_ ((SELECT_TYPE
*));
311 static void deactivate_process
P_ ((Lisp_Object
));
312 static void status_notify
P_ ((struct Lisp_Process
*));
313 static int read_process_output
P_ ((Lisp_Object
, int));
315 /* If we support a window system, turn on the code to poll periodically
316 to detect C-g. It isn't actually used when doing interrupt input. */
317 #ifdef HAVE_WINDOW_SYSTEM
318 #define POLL_FOR_INPUT
321 static Lisp_Object
get_process ();
322 static void exec_sentinel ();
324 extern EMACS_TIME
timer_check ();
325 extern int timers_run
;
327 /* Mask of bits indicating the descriptors that we wait for input on. */
329 static SELECT_TYPE input_wait_mask
;
331 /* Mask that excludes keyboard input descriptor (s). */
333 static SELECT_TYPE non_keyboard_wait_mask
;
335 /* Mask that excludes process input descriptor (s). */
337 static SELECT_TYPE non_process_wait_mask
;
339 #ifdef NON_BLOCKING_CONNECT
340 /* Mask of bits indicating the descriptors that we wait for connect to
341 complete on. Once they complete, they are removed from this mask
342 and added to the input_wait_mask and non_keyboard_wait_mask. */
344 static SELECT_TYPE connect_wait_mask
;
346 /* Number of bits set in connect_wait_mask. */
347 static int num_pending_connects
;
349 #define IF_NON_BLOCKING_CONNECT(s) s
351 #define IF_NON_BLOCKING_CONNECT(s)
354 /* The largest descriptor currently in use for a process object. */
355 static int max_process_desc
;
357 /* The largest descriptor currently in use for keyboard input. */
358 static int max_keyboard_desc
;
360 /* Nonzero means delete a process right away if it exits. */
361 static int delete_exited_processes
;
363 /* Indexed by descriptor, gives the process (if any) for that descriptor */
364 Lisp_Object chan_process
[MAXDESC
];
366 /* Alist of elements (NAME . PROCESS) */
367 Lisp_Object Vprocess_alist
;
369 /* Buffered-ahead input char from process, indexed by channel.
370 -1 means empty (no char is buffered).
371 Used on sys V where the only way to tell if there is any
372 output from the process is to read at least one char.
373 Always -1 on systems that support FIONREAD. */
375 /* Don't make static; need to access externally. */
376 int proc_buffered_char
[MAXDESC
];
378 /* Table of `struct coding-system' for each process. */
379 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
380 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
382 #ifdef DATAGRAM_SOCKETS
383 /* Table of `partner address' for datagram sockets. */
384 struct sockaddr_and_len
{
387 } datagram_address
[MAXDESC
];
388 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
389 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
391 #define DATAGRAM_CHAN_P(chan) (0)
392 #define DATAGRAM_CONN_P(proc) (0)
395 /* Maximum number of bytes to send to a pty without an eof. */
396 static int pty_max_bytes
;
398 /* Nonzero means don't run process sentinels. This is used
400 int inhibit_sentinels
;
406 /* The file name of the pty opened by allocate_pty. */
408 static char pty_name
[24];
411 /* Compute the Lisp form of the process status, p->status, from
412 the numeric status that was returned by `wait'. */
414 static Lisp_Object
status_convert ();
418 struct Lisp_Process
*p
;
420 union { int i
; WAITTYPE wt
; } u
;
421 eassert (p
->raw_status_new
);
423 p
->status
= status_convert (u
.wt
);
424 p
->raw_status_new
= 0;
427 /* Convert a process status word in Unix format to
428 the list that we use internally. */
435 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
436 else if (WIFEXITED (w
))
437 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
438 WCOREDUMP (w
) ? Qt
: Qnil
));
439 else if (WIFSIGNALED (w
))
440 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
441 WCOREDUMP (w
) ? Qt
: Qnil
));
446 /* Given a status-list, extract the three pieces of information
447 and store them individually through the three pointers. */
450 decode_status (l
, symbol
, code
, coredump
)
468 *code
= XFASTINT (XCAR (tem
));
470 *coredump
= !NILP (tem
);
474 /* Return a string describing a process status list. */
478 struct Lisp_Process
*p
;
480 Lisp_Object status
= p
->status
;
483 Lisp_Object string
, string2
;
485 decode_status (status
, &symbol
, &code
, &coredump
);
487 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
490 synchronize_system_messages_locale ();
491 signame
= strsignal (code
);
494 string
= build_string (signame
);
495 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
496 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
497 return concat2 (string
, string2
);
499 else if (EQ (symbol
, Qexit
))
502 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
504 return build_string ("finished\n");
505 string
= Fnumber_to_string (make_number (code
));
506 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
507 return concat3 (build_string ("exited abnormally with code "),
510 else if (EQ (symbol
, Qfailed
))
512 string
= Fnumber_to_string (make_number (code
));
513 string2
= build_string ("\n");
514 return concat3 (build_string ("failed with code "),
518 return Fcopy_sequence (Fsymbol_name (symbol
));
523 /* Open an available pty, returning a file descriptor.
524 Return -1 on failure.
525 The file name of the terminal corresponding to the pty
526 is left in the variable pty_name. */
537 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
538 for (i
= 0; i
< 16; i
++)
541 struct stat stb
; /* Used in some PTY_OPEN. */
542 #ifdef PTY_NAME_SPRINTF
545 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
546 #endif /* no PTY_NAME_SPRINTF */
550 #else /* no PTY_OPEN */
553 /* Unusual IRIS code */
554 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
557 if (fstat (fd
, &stb
) < 0)
559 # else /* not IRIS */
560 { /* Some systems name their pseudoterminals so that there are gaps in
561 the usual sequence - for example, on HP9000/S700 systems, there
562 are no pseudoterminals with names ending in 'f'. So we wait for
563 three failures in a row before deciding that we've reached the
565 int failed_count
= 0;
567 if (stat (pty_name
, &stb
) < 0)
570 if (failed_count
>= 3)
577 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
579 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
581 # endif /* not IRIS */
583 #endif /* no PTY_OPEN */
587 /* check to make certain that both sides are available
588 this avoids a nasty yet stupid bug in rlogins */
589 #ifdef PTY_TTY_NAME_SPRINTF
592 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
593 #endif /* no PTY_TTY_NAME_SPRINTF */
595 if (access (pty_name
, 6) != 0)
598 # if !defined(IRIS) && !defined(__sgi)
604 #endif /* not UNIPLUS */
611 #endif /* HAVE_PTYS */
617 register Lisp_Object val
, tem
, name1
;
618 register struct Lisp_Process
*p
;
622 p
= allocate_process ();
624 XSETINT (p
->infd
, -1);
625 XSETINT (p
->outfd
, -1);
626 XSETFASTINT (p
->tick
, 0);
627 XSETFASTINT (p
->update_tick
, 0);
629 p
->raw_status_new
= 0;
631 p
->mark
= Fmake_marker ();
633 #ifdef ADAPTIVE_READ_BUFFERING
634 p
->adaptive_read_buffering
= Qnil
;
635 XSETFASTINT (p
->read_output_delay
, 0);
636 p
->read_output_skip
= Qnil
;
639 /* If name is already in use, modify it until it is unused. */
644 tem
= Fget_process (name1
);
645 if (NILP (tem
)) break;
646 sprintf (suffix
, "<%d>", i
);
647 name1
= concat2 (name
, build_string (suffix
));
651 XSETPROCESS (val
, p
);
652 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
657 remove_process (proc
)
658 register Lisp_Object proc
;
660 register Lisp_Object pair
;
662 pair
= Frassq (proc
, Vprocess_alist
);
663 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
665 deactivate_process (proc
);
668 /* Setup coding systems of PROCESS. */
671 setup_process_coding_systems (process
)
674 struct Lisp_Process
*p
= XPROCESS (process
);
675 int inch
= XINT (p
->infd
);
676 int outch
= XINT (p
->outfd
);
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 setup_coding_system (p
->decode_coding_system
,
685 proc_decode_coding_system
[inch
]);
686 if (! NILP (p
->filter
))
688 if (NILP (p
->filter_multibyte
))
689 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
691 else if (BUFFERP (p
->buffer
))
693 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
694 setup_raw_text_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
]);
702 if (proc_encode_coding_system
[outch
]->eol_type
== CODING_EOL_UNDECIDED
)
703 proc_encode_coding_system
[outch
]->eol_type
= system_eol_type
;
706 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
707 doc
: /* Return t if OBJECT is a process. */)
711 return PROCESSP (object
) ? Qt
: Qnil
;
714 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
715 doc
: /* Return the process named NAME, or nil if there is none. */)
717 register Lisp_Object name
;
722 return Fcdr (Fassoc (name
, Vprocess_alist
));
725 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
726 doc
: /* Return the (or a) process associated with BUFFER.
727 BUFFER may be a buffer or the name of one. */)
729 register Lisp_Object buffer
;
731 register Lisp_Object buf
, tail
, proc
;
733 if (NILP (buffer
)) return Qnil
;
734 buf
= Fget_buffer (buffer
);
735 if (NILP (buf
)) return Qnil
;
737 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
739 proc
= Fcdr (Fcar (tail
));
740 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
746 /* This is how commands for the user decode process arguments. It
747 accepts a process, a process name, a buffer, a buffer name, or nil.
748 Buffers denote the first process in the buffer, and nil denotes the
753 register Lisp_Object name
;
755 register Lisp_Object proc
, obj
;
758 obj
= Fget_process (name
);
760 obj
= Fget_buffer (name
);
762 error ("Process %s does not exist", SDATA (name
));
764 else if (NILP (name
))
765 obj
= Fcurrent_buffer ();
769 /* Now obj should be either a buffer object or a process object.
773 proc
= Fget_buffer_process (obj
);
775 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
787 /* Fdelete_process promises to immediately forget about the process, but in
788 reality, Emacs needs to remember those processes until they have been
789 treated by sigchld_handler; otherwise this handler would consider the
790 process as being synchronous and say that the synchronous process is
792 static Lisp_Object deleted_pid_list
;
795 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
796 doc
: /* Delete PROCESS: kill it and forget about it immediately.
797 PROCESS may be a process, a buffer, the name of a process or buffer, or
798 nil, indicating the current buffer's process. */)
800 register Lisp_Object process
;
802 register struct Lisp_Process
*p
;
804 process
= get_process (process
);
805 p
= XPROCESS (process
);
807 p
->raw_status_new
= 0;
810 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
811 XSETINT (p
->tick
, ++process_tick
);
814 else if (XINT (p
->infd
) >= 0)
818 /* Assignment to EMACS_INT stops GCC whining about limited range
820 EMACS_INT pid
= p
->pid
;
822 /* No problem storing the pid here, as it is still in Vprocess_alist. */
823 deleted_pid_list
= Fcons (make_fixnum_or_float (pid
),
824 /* GC treated elements set to nil. */
825 Fdelq (Qnil
, deleted_pid_list
));
826 /* If the process has already signaled, remove it from the list. */
827 if (p
->raw_status_new
)
830 if (CONSP (p
->status
))
831 symbol
= XCAR (p
->status
);
832 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
834 = Fdelete (make_fixnum_or_float (pid
), deleted_pid_list
);
838 Fkill_process (process
, Qnil
);
839 /* Do this now, since remove_process will make sigchld_handler do nothing. */
841 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
842 XSETINT (p
->tick
, ++process_tick
);
846 remove_process (process
);
850 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
851 doc
: /* Return the status of PROCESS.
852 The returned value is one of the following symbols:
853 run -- for a process that is running.
854 stop -- for a process stopped but continuable.
855 exit -- for a process that has exited.
856 signal -- for a process that has got a fatal signal.
857 open -- for a network stream connection that is open.
858 listen -- for a network stream server that is listening.
859 closed -- for a network stream connection that is closed.
860 connect -- when waiting for a non-blocking connection to complete.
861 failed -- when a non-blocking connection has failed.
862 nil -- if arg is a process name and no such process exists.
863 PROCESS may be a process, a buffer, the name of a process, or
864 nil, indicating the current buffer's process. */)
866 register Lisp_Object process
;
868 register struct Lisp_Process
*p
;
869 register Lisp_Object status
;
871 if (STRINGP (process
))
872 process
= Fget_process (process
);
874 process
= get_process (process
);
879 p
= XPROCESS (process
);
880 if (p
->raw_status_new
)
884 status
= XCAR (status
);
887 if (EQ (status
, Qexit
))
889 else if (EQ (p
->command
, Qt
))
891 else if (EQ (status
, Qrun
))
897 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
899 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
900 If PROCESS has not yet exited or died, return 0. */)
902 register Lisp_Object process
;
904 CHECK_PROCESS (process
);
905 if (XPROCESS (process
)->raw_status_new
)
906 update_status (XPROCESS (process
));
907 if (CONSP (XPROCESS (process
)->status
))
908 return XCAR (XCDR (XPROCESS (process
)->status
));
909 return make_number (0);
912 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
913 doc
: /* Return the process id of PROCESS.
914 This is the pid of the external process which PROCESS uses or talks to.
915 For a network connection, this value is nil. */)
917 register Lisp_Object process
;
919 /* Assignment to EMACS_INT stops GCC whining about limited range of
923 CHECK_PROCESS (process
);
924 pid
= XPROCESS (process
)->pid
;
925 return (pid
? make_fixnum_or_float (pid
) : Qnil
);
928 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
929 doc
: /* Return the name of PROCESS, as a string.
930 This is the name of the program invoked in PROCESS,
931 possibly modified to make it unique among process names. */)
933 register Lisp_Object process
;
935 CHECK_PROCESS (process
);
936 return XPROCESS (process
)->name
;
939 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
940 doc
: /* Return the command that was executed to start PROCESS.
941 This is a list of strings, the first string being the program executed
942 and the rest of the strings being the arguments given to it.
943 For a non-child channel, this is nil. */)
945 register Lisp_Object process
;
947 CHECK_PROCESS (process
);
948 return XPROCESS (process
)->command
;
951 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
952 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
953 This is the terminal that the process itself reads and writes on,
954 not the name of the pty that Emacs uses to talk with that terminal. */)
956 register Lisp_Object process
;
958 CHECK_PROCESS (process
);
959 return XPROCESS (process
)->tty_name
;
962 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
964 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
966 register Lisp_Object process
, buffer
;
968 struct Lisp_Process
*p
;
970 CHECK_PROCESS (process
);
972 CHECK_BUFFER (buffer
);
973 p
= XPROCESS (process
);
976 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
977 setup_process_coding_systems (process
);
981 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
983 doc
: /* Return the buffer PROCESS is associated with.
984 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
986 register Lisp_Object process
;
988 CHECK_PROCESS (process
);
989 return XPROCESS (process
)->buffer
;
992 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
994 doc
: /* Return the marker for the end of the last output from PROCESS. */)
996 register Lisp_Object process
;
998 CHECK_PROCESS (process
);
999 return XPROCESS (process
)->mark
;
1002 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
1004 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
1005 t means stop accepting output from the process.
1007 When a process has a filter, its buffer is not used for output.
1008 Instead, each time it does output, the entire string of output is
1009 passed to the filter.
1011 The filter gets two arguments: the process and the string of output.
1012 The string argument is normally a multibyte string, except:
1013 - if the process' input coding system is no-conversion or raw-text,
1014 it is a unibyte string (the non-converted input), or else
1015 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1016 string (the result of converting the decoded input multibyte
1017 string to unibyte with `string-make-unibyte'). */)
1019 register Lisp_Object process
, filter
;
1021 struct Lisp_Process
*p
;
1023 CHECK_PROCESS (process
);
1024 p
= XPROCESS (process
);
1026 /* Don't signal an error if the process' input file descriptor
1027 is closed. This could make debugging Lisp more difficult,
1028 for example when doing something like
1030 (setq process (start-process ...))
1032 (set-process-filter process ...) */
1034 if (XINT (p
->infd
) >= 0)
1036 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
1038 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
1039 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
1041 else if (EQ (p
->filter
, Qt
)
1042 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
1044 FD_SET (XINT (p
->infd
), &input_wait_mask
);
1045 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
1051 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
1052 setup_process_coding_systems (process
);
1056 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1058 doc
: /* Returns the filter function of PROCESS; nil if none.
1059 See `set-process-filter' for more info on filter functions. */)
1061 register Lisp_Object process
;
1063 CHECK_PROCESS (process
);
1064 return XPROCESS (process
)->filter
;
1067 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1069 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1070 The sentinel is called as a function when the process changes state.
1071 It gets two arguments: the process, and a string describing the change. */)
1073 register Lisp_Object process
, sentinel
;
1075 struct Lisp_Process
*p
;
1077 CHECK_PROCESS (process
);
1078 p
= XPROCESS (process
);
1080 p
->sentinel
= sentinel
;
1082 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1086 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1088 doc
: /* Return the sentinel of PROCESS; nil if none.
1089 See `set-process-sentinel' for more info on sentinels. */)
1091 register Lisp_Object process
;
1093 CHECK_PROCESS (process
);
1094 return XPROCESS (process
)->sentinel
;
1097 DEFUN ("set-process-window-size", Fset_process_window_size
,
1098 Sset_process_window_size
, 3, 3, 0,
1099 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1100 (process
, height
, width
)
1101 register Lisp_Object process
, height
, width
;
1103 CHECK_PROCESS (process
);
1104 CHECK_NATNUM (height
);
1105 CHECK_NATNUM (width
);
1107 if (XINT (XPROCESS (process
)->infd
) < 0
1108 || set_window_size (XINT (XPROCESS (process
)->infd
),
1109 XINT (height
), XINT (width
)) <= 0)
1115 DEFUN ("set-process-inherit-coding-system-flag",
1116 Fset_process_inherit_coding_system_flag
,
1117 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1118 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1119 If the second argument FLAG is non-nil, then the variable
1120 `buffer-file-coding-system' of the buffer associated with PROCESS
1121 will be bound to the value of the coding system used to decode
1124 This is useful when the coding system specified for the process buffer
1125 leaves either the character code conversion or the end-of-line conversion
1126 unspecified, or if the coding system used to decode the process output
1127 is more appropriate for saving the process buffer.
1129 Binding the variable `inherit-process-coding-system' to non-nil before
1130 starting the process is an alternative way of setting the inherit flag
1131 for the process which will run. */)
1133 register Lisp_Object process
, flag
;
1135 CHECK_PROCESS (process
);
1136 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
1140 DEFUN ("process-inherit-coding-system-flag",
1141 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1143 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1144 If this flag is t, `buffer-file-coding-system' of the buffer
1145 associated with PROCESS will inherit the coding system used to decode
1146 the process output. */)
1148 register Lisp_Object process
;
1150 CHECK_PROCESS (process
);
1151 return XPROCESS (process
)->inherit_coding_system_flag
;
1154 DEFUN ("set-process-query-on-exit-flag",
1155 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1157 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1158 If the second argument FLAG is non-nil, Emacs will query the user before
1159 exiting if PROCESS is running. */)
1161 register Lisp_Object process
, flag
;
1163 CHECK_PROCESS (process
);
1164 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
1168 DEFUN ("process-query-on-exit-flag",
1169 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1171 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1173 register Lisp_Object process
;
1175 CHECK_PROCESS (process
);
1176 return Fnull (XPROCESS (process
)->kill_without_query
);
1179 #ifdef DATAGRAM_SOCKETS
1180 Lisp_Object
Fprocess_datagram_address ();
1183 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1185 doc
: /* Return the contact info of PROCESS; t for a real child.
1186 For a net connection, the value depends on the optional KEY arg.
1187 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1188 if KEY is t, the complete contact information for the connection is
1189 returned, else the specific value for the keyword KEY is returned.
1190 See `make-network-process' for a list of keywords. */)
1192 register Lisp_Object process
, key
;
1194 Lisp_Object contact
;
1196 CHECK_PROCESS (process
);
1197 contact
= XPROCESS (process
)->childp
;
1199 #ifdef DATAGRAM_SOCKETS
1200 if (DATAGRAM_CONN_P (process
)
1201 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1202 contact
= Fplist_put (contact
, QCremote
,
1203 Fprocess_datagram_address (process
));
1206 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1209 return Fcons (Fplist_get (contact
, QChost
),
1210 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1211 return Fplist_get (contact
, key
);
1214 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1216 doc
: /* Return the plist of PROCESS. */)
1218 register Lisp_Object process
;
1220 CHECK_PROCESS (process
);
1221 return XPROCESS (process
)->plist
;
1224 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1226 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1228 register Lisp_Object process
, plist
;
1230 CHECK_PROCESS (process
);
1233 XPROCESS (process
)->plist
= plist
;
1237 #if 0 /* Turned off because we don't currently record this info
1238 in the process. Perhaps add it. */
1239 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1240 doc
: /* Return the connection type of PROCESS.
1241 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1242 a socket connection. */)
1244 Lisp_Object process
;
1246 return XPROCESS (process
)->type
;
1251 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1253 doc
: /* Convert network ADDRESS from internal format to a string.
1254 A 4 or 5 element vector represents an IPv4 address (with port number).
1255 An 8 or 9 element vector represents an IPv6 address (with port number).
1256 If optional second argument OMIT-PORT is non-nil, don't include a port
1257 number in the string, even when present in ADDRESS.
1258 Returns nil if format of ADDRESS is invalid. */)
1259 (address
, omit_port
)
1260 Lisp_Object address
, omit_port
;
1265 if (STRINGP (address
)) /* AF_LOCAL */
1268 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1270 register struct Lisp_Vector
*p
= XVECTOR (address
);
1271 Lisp_Object args
[10];
1274 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1276 args
[0] = build_string ("%d.%d.%d.%d");
1279 else if (p
->size
== 5)
1281 args
[0] = build_string ("%d.%d.%d.%d:%d");
1284 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1286 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1289 else if (p
->size
== 9)
1291 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1297 for (i
= 0; i
< nargs
; i
++)
1298 args
[i
+1] = p
->contents
[i
];
1299 return Fformat (nargs
+1, args
);
1302 if (CONSP (address
))
1304 Lisp_Object args
[2];
1305 args
[0] = build_string ("<Family %d>");
1306 args
[1] = Fcar (address
);
1307 return Fformat (2, args
);
1315 list_processes_1 (query_only
)
1316 Lisp_Object query_only
;
1318 register Lisp_Object tail
, tem
;
1319 Lisp_Object proc
, minspace
, tem1
;
1320 register struct Lisp_Process
*p
;
1322 int w_proc
, w_buffer
, w_tty
;
1324 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1326 w_proc
= 4; /* Proc */
1327 w_buffer
= 6; /* Buffer */
1328 w_tty
= 0; /* Omit if no ttys */
1330 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1334 proc
= Fcdr (Fcar (tail
));
1335 p
= XPROCESS (proc
);
1336 if (NILP (p
->childp
))
1338 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1340 if (STRINGP (p
->name
)
1341 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1343 if (!NILP (p
->buffer
))
1345 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1346 w_buffer
= 8; /* (Killed) */
1347 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1350 if (STRINGP (p
->tty_name
)
1351 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1355 XSETFASTINT (i_status
, w_proc
+ 1);
1356 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1359 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1360 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1363 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1366 XSETFASTINT (minspace
, 1);
1368 set_buffer_internal (XBUFFER (Vstandard_output
));
1369 current_buffer
->undo_list
= Qt
;
1371 current_buffer
->truncate_lines
= Qt
;
1373 write_string ("Proc", -1);
1374 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1375 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1378 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1380 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1381 write_string ("\n", -1);
1383 write_string ("----", -1);
1384 Findent_to (i_status
, minspace
); write_string ("------", -1);
1385 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1388 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1390 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1391 write_string ("\n", -1);
1393 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1397 proc
= Fcdr (Fcar (tail
));
1398 p
= XPROCESS (proc
);
1399 if (NILP (p
->childp
))
1401 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1404 Finsert (1, &p
->name
);
1405 Findent_to (i_status
, minspace
);
1407 if (p
->raw_status_new
)
1410 if (CONSP (p
->status
))
1411 symbol
= XCAR (p
->status
);
1414 if (EQ (symbol
, Qsignal
))
1417 tem
= Fcar (Fcdr (p
->status
));
1419 if (XINT (tem
) < NSIG
)
1420 write_string (sys_errlist
[XINT (tem
)], -1);
1423 Fprinc (symbol
, Qnil
);
1425 else if (NETCONN1_P (p
))
1427 if (EQ (symbol
, Qexit
))
1428 write_string ("closed", -1);
1429 else if (EQ (p
->command
, Qt
))
1430 write_string ("stopped", -1);
1431 else if (EQ (symbol
, Qrun
))
1432 write_string ("open", -1);
1434 Fprinc (symbol
, Qnil
);
1437 Fprinc (symbol
, Qnil
);
1439 if (EQ (symbol
, Qexit
))
1442 tem
= Fcar (Fcdr (p
->status
));
1445 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1446 write_string (tembuf
, -1);
1450 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
) || EQ (symbol
, Qclosed
))
1453 Findent_to (i_buffer
, minspace
);
1454 if (NILP (p
->buffer
))
1455 insert_string ("(none)");
1456 else if (NILP (XBUFFER (p
->buffer
)->name
))
1457 insert_string ("(Killed)");
1459 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1463 Findent_to (i_tty
, minspace
);
1464 if (STRINGP (p
->tty_name
))
1465 Finsert (1, &p
->tty_name
);
1468 Findent_to (i_command
, minspace
);
1470 if (EQ (p
->status
, Qlisten
))
1472 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1473 if (INTEGERP (port
))
1474 port
= Fnumber_to_string (port
);
1476 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1477 sprintf (tembuf
, "(network %s server on %s)\n",
1478 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1479 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1480 insert_string (tembuf
);
1482 else if (NETCONN1_P (p
))
1484 /* For a local socket, there is no host name,
1485 so display service instead. */
1486 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1487 if (!STRINGP (host
))
1489 host
= Fplist_get (p
->childp
, QCservice
);
1490 if (INTEGERP (host
))
1491 host
= Fnumber_to_string (host
);
1494 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1495 sprintf (tembuf
, "(network %s connection to %s)\n",
1496 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1497 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1498 insert_string (tembuf
);
1510 insert_string (" ");
1512 insert_string ("\n");
1516 status_notify (NULL
);
1520 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1521 doc
: /* Display a list of all processes.
1522 If optional argument QUERY-ONLY is non-nil, only processes with
1523 the query-on-exit flag set will be listed.
1524 Any process listed as exited or signaled is actually eliminated
1525 after the listing is made. */)
1527 Lisp_Object query_only
;
1529 internal_with_output_to_temp_buffer ("*Process List*",
1530 list_processes_1
, query_only
);
1534 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1535 doc
: /* Return a list of all processes. */)
1538 return Fmapcar (Qcdr
, Vprocess_alist
);
1541 /* Starting asynchronous inferior processes. */
1543 static Lisp_Object
start_process_unwind ();
1545 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1546 doc
: /* Start a program in a subprocess. Return the process object for it.
1547 NAME is name for process. It is modified if necessary to make it unique.
1548 BUFFER is the buffer (or buffer name) to associate with the process.
1549 Process output goes at end of that buffer, unless you specify
1550 an output stream or filter function to handle the output.
1551 BUFFER may be also nil, meaning that this process is not associated
1553 PROGRAM is the program file name. It is searched for in PATH.
1554 Remaining arguments are strings to give program as arguments.
1556 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1559 register Lisp_Object
*args
;
1561 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1563 register unsigned char *new_argv
;
1566 register unsigned char **new_argv
;
1569 int count
= SPECPDL_INDEX ();
1573 buffer
= Fget_buffer_create (buffer
);
1575 /* Make sure that the child will be able to chdir to the current
1576 buffer's current directory, or its unhandled equivalent. We
1577 can't just have the child check for an error when it does the
1578 chdir, since it's in a vfork.
1580 We have to GCPRO around this because Fexpand_file_name and
1581 Funhandled_file_name_directory might call a file name handling
1582 function. The argument list is protected by the caller, so all
1583 we really have to worry about is buffer. */
1585 struct gcpro gcpro1
, gcpro2
;
1587 current_dir
= current_buffer
->directory
;
1589 GCPRO2 (buffer
, current_dir
);
1592 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1594 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1595 report_file_error ("Setting current directory",
1596 Fcons (current_buffer
->directory
, Qnil
));
1602 CHECK_STRING (name
);
1606 CHECK_STRING (program
);
1608 proc
= make_process (name
);
1609 /* If an error occurs and we can't start the process, we want to
1610 remove it from the process list. This means that each error
1611 check in create_process doesn't need to call remove_process
1612 itself; it's all taken care of here. */
1613 record_unwind_protect (start_process_unwind
, proc
);
1615 XPROCESS (proc
)->childp
= Qt
;
1616 XPROCESS (proc
)->plist
= Qnil
;
1617 XPROCESS (proc
)->buffer
= buffer
;
1618 XPROCESS (proc
)->sentinel
= Qnil
;
1619 XPROCESS (proc
)->filter
= Qnil
;
1620 XPROCESS (proc
)->filter_multibyte
1621 = buffer_defaults
.enable_multibyte_characters
;
1622 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1624 #ifdef ADAPTIVE_READ_BUFFERING
1625 XPROCESS (proc
)->adaptive_read_buffering
= Vprocess_adaptive_read_buffering
;
1628 /* Make the process marker point into the process buffer (if any). */
1629 if (BUFFERP (buffer
))
1630 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1631 BUF_ZV (XBUFFER (buffer
)),
1632 BUF_ZV_BYTE (XBUFFER (buffer
)));
1635 /* Decide coding systems for communicating with the process. Here
1636 we don't setup the structure coding_system nor pay attention to
1637 unibyte mode. They are done in create_process. */
1639 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1640 Lisp_Object coding_systems
= Qt
;
1641 Lisp_Object val
, *args2
;
1642 struct gcpro gcpro1
, gcpro2
;
1644 val
= Vcoding_system_for_read
;
1647 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1648 args2
[0] = Qstart_process
;
1649 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1650 GCPRO2 (proc
, current_dir
);
1651 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1653 if (CONSP (coding_systems
))
1654 val
= XCAR (coding_systems
);
1655 else if (CONSP (Vdefault_process_coding_system
))
1656 val
= XCAR (Vdefault_process_coding_system
);
1658 XPROCESS (proc
)->decode_coding_system
= val
;
1660 val
= Vcoding_system_for_write
;
1663 if (EQ (coding_systems
, Qt
))
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
);
1672 if (CONSP (coding_systems
))
1673 val
= XCDR (coding_systems
);
1674 else if (CONSP (Vdefault_process_coding_system
))
1675 val
= XCDR (Vdefault_process_coding_system
);
1677 XPROCESS (proc
)->encode_coding_system
= val
;
1681 /* Make a one member argv with all args concatenated
1682 together separated by a blank. */
1683 len
= SBYTES (program
) + 2;
1684 for (i
= 3; i
< nargs
; i
++)
1688 len
+= SBYTES (tem
) + 1; /* count the blank */
1690 new_argv
= (unsigned char *) alloca (len
);
1691 strcpy (new_argv
, SDATA (program
));
1692 for (i
= 3; i
< nargs
; i
++)
1696 strcat (new_argv
, " ");
1697 strcat (new_argv
, SDATA (tem
));
1699 /* Need to add code here to check for program existence on VMS */
1702 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1704 /* If program file name is not absolute, search our path for it.
1705 Put the name we will really use in TEM. */
1706 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1707 && !(SCHARS (program
) > 1
1708 && IS_DEVICE_SEP (SREF (program
, 1))))
1710 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1713 GCPRO4 (name
, program
, buffer
, current_dir
);
1714 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1717 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1718 tem
= Fexpand_file_name (tem
, Qnil
);
1722 if (!NILP (Ffile_directory_p (program
)))
1723 error ("Specified program for new process is a directory");
1727 /* If program file name starts with /: for quoting a magic name,
1729 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1730 && SREF (tem
, 1) == ':')
1731 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1733 /* Encode the file name and put it in NEW_ARGV.
1734 That's where the child will use it to execute the program. */
1735 tem
= ENCODE_FILE (tem
);
1736 new_argv
[0] = SDATA (tem
);
1738 /* Here we encode arguments by the coding system used for sending
1739 data to the process. We don't support using different coding
1740 systems for encoding arguments and for encoding data sent to the
1743 for (i
= 3; i
< nargs
; i
++)
1747 if (STRING_MULTIBYTE (tem
))
1748 tem
= (code_convert_string_norecord
1749 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1750 new_argv
[i
- 2] = SDATA (tem
);
1752 new_argv
[i
- 2] = 0;
1753 #endif /* not VMS */
1755 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1756 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1757 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1758 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1760 XPROCESS (proc
)->inherit_coding_system_flag
1761 = (NILP (buffer
) || !inherit_process_coding_system
1764 create_process (proc
, (char **) new_argv
, current_dir
);
1766 return unbind_to (count
, proc
);
1769 /* This function is the unwind_protect form for Fstart_process. If
1770 PROC doesn't have its pid set, then we know someone has signaled
1771 an error and the process wasn't started successfully, so we should
1772 remove it from the process list. */
1774 start_process_unwind (proc
)
1777 if (!PROCESSP (proc
))
1780 /* Was PROC started successfully? */
1781 if (XPROCESS (proc
)->pid
<= 0)
1782 remove_process (proc
);
1788 create_process_1 (timer
)
1789 struct atimer
*timer
;
1791 /* Nothing to do. */
1795 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1798 /* Mimic blocking of signals on system V, which doesn't really have it. */
1800 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1801 int sigchld_deferred
;
1804 create_process_sigchld ()
1806 signal (SIGCHLD
, create_process_sigchld
);
1808 sigchld_deferred
= 1;
1814 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1816 create_process (process
, new_argv
, current_dir
)
1817 Lisp_Object process
;
1819 Lisp_Object current_dir
;
1821 int inchannel
, outchannel
;
1824 #ifdef POSIX_SIGNALS
1827 struct sigaction sigint_action
;
1828 struct sigaction sigquit_action
;
1830 struct sigaction sighup_action
;
1832 #else /* !POSIX_SIGNALS */
1835 SIGTYPE (*sigchld
)();
1838 #endif /* !POSIX_SIGNALS */
1839 /* Use volatile to protect variables from being clobbered by longjmp. */
1840 volatile int forkin
, forkout
;
1841 volatile int pty_flag
= 0;
1843 extern char **environ
;
1846 inchannel
= outchannel
= -1;
1849 if (!NILP (Vprocess_connection_type
))
1850 outchannel
= inchannel
= allocate_pty ();
1854 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1855 /* On most USG systems it does not work to open the pty's tty here,
1856 then close it and reopen it in the child. */
1858 /* Don't let this terminal become our controlling terminal
1859 (in case we don't have one). */
1860 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1862 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1865 report_file_error ("Opening pty", Qnil
);
1866 #if defined (RTU) || defined (UNIPLUS) || defined (DONT_REOPEN_PTY)
1867 /* In the case that vfork is defined as fork, the parent process
1868 (Emacs) may send some data before the child process completes
1869 tty options setup. So we setup tty before forking. */
1870 child_setup_tty (forkout
);
1871 #endif /* RTU or UNIPLUS or DONT_REOPEN_PTY */
1873 forkin
= forkout
= -1;
1874 #endif /* not USG, or USG_SUBTTY_WORKS */
1878 #endif /* HAVE_PTYS */
1881 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1882 report_file_error ("Opening socketpair", Qnil
);
1883 outchannel
= inchannel
= sv
[0];
1884 forkout
= forkin
= sv
[1];
1886 #else /* not SKTPAIR */
1891 report_file_error ("Creating pipe", Qnil
);
1897 emacs_close (inchannel
);
1898 emacs_close (forkout
);
1899 report_file_error ("Creating pipe", Qnil
);
1904 #endif /* not SKTPAIR */
1907 /* Replaced by close_process_descs */
1908 set_exclusive_use (inchannel
);
1909 set_exclusive_use (outchannel
);
1912 /* Stride people say it's a mystery why this is needed
1913 as well as the O_NDELAY, but that it fails without this. */
1914 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1917 ioctl (inchannel
, FIONBIO
, &one
);
1922 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1923 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1926 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1927 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1931 /* Record this as an active process, with its channels.
1932 As a result, child_setup will close Emacs's side of the pipes. */
1933 chan_process
[inchannel
] = process
;
1934 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1935 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1937 /* Previously we recorded the tty descriptor used in the subprocess.
1938 It was only used for getting the foreground tty process, so now
1939 we just reopen the device (see emacs_get_tty_pgrp) as this is
1940 more portable (see USG_SUBTTY_WORKS above). */
1942 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1943 XPROCESS (process
)->status
= Qrun
;
1944 setup_process_coding_systems (process
);
1946 /* Delay interrupts until we have a chance to store
1947 the new fork's pid in its process structure */
1948 #ifdef POSIX_SIGNALS
1949 sigemptyset (&blocked
);
1951 sigaddset (&blocked
, SIGCHLD
);
1953 #ifdef HAVE_WORKING_VFORK
1954 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1955 this sets the parent's signal handlers as well as the child's.
1956 So delay all interrupts whose handlers the child might munge,
1957 and record the current handlers so they can be restored later. */
1958 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1959 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1961 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1963 #endif /* HAVE_WORKING_VFORK */
1964 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1965 #else /* !POSIX_SIGNALS */
1969 #else /* not BSD4_1 */
1970 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1971 sigsetmask (sigmask (SIGCHLD
));
1972 #else /* ordinary USG */
1974 sigchld_deferred
= 0;
1975 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1977 #endif /* ordinary USG */
1978 #endif /* not BSD4_1 */
1979 #endif /* SIGCHLD */
1980 #endif /* !POSIX_SIGNALS */
1982 FD_SET (inchannel
, &input_wait_mask
);
1983 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1984 if (inchannel
> max_process_desc
)
1985 max_process_desc
= inchannel
;
1987 /* Until we store the proper pid, enable sigchld_handler
1988 to recognize an unknown pid as standing for this process.
1989 It is very important not to let this `marker' value stay
1990 in the table after this function has returned; if it does
1991 it might cause call-process to hang and subsequent asynchronous
1992 processes to get their return values scrambled. */
1993 XPROCESS (process
)->pid
= -1;
1998 /* child_setup must clobber environ on systems with true vfork.
1999 Protect it from permanent change. */
2000 char **save_environ
= environ
;
2002 current_dir
= ENCODE_FILE (current_dir
);
2007 #endif /* not WINDOWSNT */
2009 int xforkin
= forkin
;
2010 int xforkout
= forkout
;
2012 #if 0 /* This was probably a mistake--it duplicates code later on,
2013 but fails to handle all the cases. */
2014 /* Make sure SIGCHLD is not blocked in the child. */
2015 sigsetmask (SIGEMPTYMASK
);
2018 /* Make the pty be the controlling terminal of the process. */
2020 /* First, disconnect its current controlling terminal. */
2022 /* We tried doing setsid only if pty_flag, but it caused
2023 process_set_signal to fail on SGI when using a pipe. */
2025 /* Make the pty's terminal the controlling terminal. */
2029 /* We ignore the return value
2030 because faith@cs.unc.edu says that is necessary on Linux. */
2031 ioctl (xforkin
, TIOCSCTTY
, 0);
2034 #else /* not HAVE_SETSID */
2036 /* It's very important to call setpgrp here and no time
2037 afterwards. Otherwise, we lose our controlling tty which
2038 is set when we open the pty. */
2041 #endif /* not HAVE_SETSID */
2042 #if defined (HAVE_TERMIOS) && defined (LDISC1)
2043 if (pty_flag
&& xforkin
>= 0)
2046 tcgetattr (xforkin
, &t
);
2048 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
2049 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
2052 #if defined (NTTYDISC) && defined (TIOCSETD)
2053 if (pty_flag
&& xforkin
>= 0)
2055 /* Use new line discipline. */
2056 int ldisc
= NTTYDISC
;
2057 ioctl (xforkin
, TIOCSETD
, &ldisc
);
2062 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2063 can do TIOCSPGRP only to the process's controlling tty. */
2066 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2067 I can't test it since I don't have 4.3. */
2068 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
2069 ioctl (j
, TIOCNOTTY
, 0);
2072 /* In order to get a controlling terminal on some versions
2073 of BSD, it is necessary to put the process in pgrp 0
2074 before it opens the terminal. */
2082 #endif /* TIOCNOTTY */
2084 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2085 /*** There is a suggestion that this ought to be a
2086 conditional on TIOCSPGRP,
2087 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2088 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2089 that system does seem to need this code, even though
2090 both HAVE_SETSID and TIOCSCTTY are defined. */
2091 /* Now close the pty (if we had it open) and reopen it.
2092 This makes the pty the controlling terminal of the subprocess. */
2095 #ifdef SET_CHILD_PTY_PGRP
2096 int pgrp
= getpid ();
2099 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2102 emacs_close (xforkin
);
2103 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2107 emacs_write (1, "Couldn't open the pty terminal ", 31);
2108 emacs_write (1, pty_name
, strlen (pty_name
));
2109 emacs_write (1, "\n", 1);
2113 #ifdef SET_CHILD_PTY_PGRP
2114 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
2115 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
2118 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
2120 #ifdef SETUP_SLAVE_PTY
2125 #endif /* SETUP_SLAVE_PTY */
2127 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2128 Now reenable it in the child, so it will die when we want it to. */
2130 signal (SIGHUP
, SIG_DFL
);
2132 #endif /* HAVE_PTYS */
2134 signal (SIGINT
, SIG_DFL
);
2135 signal (SIGQUIT
, SIG_DFL
);
2137 /* Stop blocking signals in the child. */
2138 #ifdef POSIX_SIGNALS
2139 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2140 #else /* !POSIX_SIGNALS */
2144 #else /* not BSD4_1 */
2145 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2146 sigsetmask (SIGEMPTYMASK
);
2147 #else /* ordinary USG */
2149 signal (SIGCHLD
, sigchld
);
2151 #endif /* ordinary USG */
2152 #endif /* not BSD4_1 */
2153 #endif /* SIGCHLD */
2154 #endif /* !POSIX_SIGNALS */
2156 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2158 child_setup_tty (xforkout
);
2159 #endif /* not RTU and not UNIPLUS and not DONT_REOPEN_PTY */
2161 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2162 new_argv
, 1, current_dir
);
2163 #else /* not WINDOWSNT */
2164 child_setup (xforkin
, xforkout
, xforkout
,
2165 new_argv
, 1, current_dir
);
2166 #endif /* not WINDOWSNT */
2168 environ
= save_environ
;
2173 /* This runs in the Emacs process. */
2177 emacs_close (forkin
);
2178 if (forkin
!= forkout
&& forkout
>= 0)
2179 emacs_close (forkout
);
2183 /* vfork succeeded. */
2184 XPROCESS (process
)->pid
= pid
;
2187 register_child (pid
, inchannel
);
2188 #endif /* WINDOWSNT */
2190 /* If the subfork execv fails, and it exits,
2191 this close hangs. I don't know why.
2192 So have an interrupt jar it loose. */
2194 struct atimer
*timer
;
2198 EMACS_SET_SECS_USECS (offset
, 1, 0);
2199 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2202 emacs_close (forkin
);
2204 cancel_atimer (timer
);
2208 if (forkin
!= forkout
&& forkout
>= 0)
2209 emacs_close (forkout
);
2213 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2216 XPROCESS (process
)->tty_name
= Qnil
;
2219 /* Restore the signal state whether vfork succeeded or not.
2220 (We will signal an error, below, if it failed.) */
2221 #ifdef POSIX_SIGNALS
2222 #ifdef HAVE_WORKING_VFORK
2223 /* Restore the parent's signal handlers. */
2224 sigaction (SIGINT
, &sigint_action
, 0);
2225 sigaction (SIGQUIT
, &sigquit_action
, 0);
2227 sigaction (SIGHUP
, &sighup_action
, 0);
2229 #endif /* HAVE_WORKING_VFORK */
2230 /* Stop blocking signals in the parent. */
2231 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2232 #else /* !POSIX_SIGNALS */
2236 #else /* not BSD4_1 */
2237 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2238 sigsetmask (SIGEMPTYMASK
);
2239 #else /* ordinary USG */
2241 signal (SIGCHLD
, sigchld
);
2242 /* Now really handle any of these signals
2243 that came in during this function. */
2244 if (sigchld_deferred
)
2245 kill (getpid (), SIGCHLD
);
2247 #endif /* ordinary USG */
2248 #endif /* not BSD4_1 */
2249 #endif /* SIGCHLD */
2250 #endif /* !POSIX_SIGNALS */
2252 /* Now generate the error if vfork failed. */
2254 report_file_error ("Doing vfork", Qnil
);
2256 #endif /* not VMS */
2261 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2262 The address family of sa is not included in the result. */
2265 conv_sockaddr_to_lisp (sa
, len
)
2266 struct sockaddr
*sa
;
2269 Lisp_Object address
;
2272 register struct Lisp_Vector
*p
;
2274 switch (sa
->sa_family
)
2278 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2279 len
= sizeof (sin
->sin_addr
) + 1;
2280 address
= Fmake_vector (make_number (len
), Qnil
);
2281 p
= XVECTOR (address
);
2282 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2283 cp
= (unsigned char *)&sin
->sin_addr
;
2289 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2290 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2291 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2292 address
= Fmake_vector (make_number (len
), Qnil
);
2293 p
= XVECTOR (address
);
2294 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2295 for (i
= 0; i
< len
; i
++)
2296 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2300 #ifdef HAVE_LOCAL_SOCKETS
2303 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2304 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2305 if (sockun
->sun_path
[i
] == 0)
2307 return make_unibyte_string (sockun
->sun_path
, i
);
2311 len
-= sizeof (sa
->sa_family
);
2312 address
= Fcons (make_number (sa
->sa_family
),
2313 Fmake_vector (make_number (len
), Qnil
));
2314 p
= XVECTOR (XCDR (address
));
2315 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2321 p
->contents
[i
++] = make_number (*cp
++);
2327 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2330 get_lisp_to_sockaddr_size (address
, familyp
)
2331 Lisp_Object address
;
2334 register struct Lisp_Vector
*p
;
2336 if (VECTORP (address
))
2338 p
= XVECTOR (address
);
2342 return sizeof (struct sockaddr_in
);
2345 else if (p
->size
== 9)
2347 *familyp
= AF_INET6
;
2348 return sizeof (struct sockaddr_in6
);
2352 #ifdef HAVE_LOCAL_SOCKETS
2353 else if (STRINGP (address
))
2355 *familyp
= AF_LOCAL
;
2356 return sizeof (struct sockaddr_un
);
2359 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2361 struct sockaddr
*sa
;
2362 *familyp
= XINT (XCAR (address
));
2363 p
= XVECTOR (XCDR (address
));
2364 return p
->size
+ sizeof (sa
->sa_family
);
2369 /* Convert an address object (vector or string) to an internal sockaddr.
2371 The address format has been basically validated by
2372 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2373 it could have come from user data. So if FAMILY is not valid,
2374 we return after zeroing *SA. */
2377 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2379 Lisp_Object address
;
2380 struct sockaddr
*sa
;
2383 register struct Lisp_Vector
*p
;
2384 register unsigned char *cp
= NULL
;
2389 if (VECTORP (address
))
2391 p
= XVECTOR (address
);
2392 if (family
== AF_INET
)
2394 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2395 len
= sizeof (sin
->sin_addr
) + 1;
2396 i
= XINT (p
->contents
[--len
]);
2397 sin
->sin_port
= htons (i
);
2398 cp
= (unsigned char *)&sin
->sin_addr
;
2399 sa
->sa_family
= family
;
2402 else if (family
== AF_INET6
)
2404 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2405 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2406 len
= sizeof (sin6
->sin6_addr
) + 1;
2407 i
= XINT (p
->contents
[--len
]);
2408 sin6
->sin6_port
= htons (i
);
2409 for (i
= 0; i
< len
; i
++)
2410 if (INTEGERP (p
->contents
[i
]))
2412 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2415 sa
->sa_family
= family
;
2420 else if (STRINGP (address
))
2422 #ifdef HAVE_LOCAL_SOCKETS
2423 if (family
== AF_LOCAL
)
2425 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2426 cp
= SDATA (address
);
2427 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2428 sockun
->sun_path
[i
] = *cp
++;
2429 sa
->sa_family
= family
;
2436 p
= XVECTOR (XCDR (address
));
2437 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2440 for (i
= 0; i
< len
; i
++)
2441 if (INTEGERP (p
->contents
[i
]))
2442 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2445 #ifdef DATAGRAM_SOCKETS
2446 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2448 doc
: /* Get the current datagram address associated with PROCESS. */)
2450 Lisp_Object process
;
2454 CHECK_PROCESS (process
);
2456 if (!DATAGRAM_CONN_P (process
))
2459 channel
= XINT (XPROCESS (process
)->infd
);
2460 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2461 datagram_address
[channel
].len
);
2464 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2466 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2467 Returns nil upon error setting address, ADDRESS otherwise. */)
2469 Lisp_Object process
, address
;
2474 CHECK_PROCESS (process
);
2476 if (!DATAGRAM_CONN_P (process
))
2479 channel
= XINT (XPROCESS (process
)->infd
);
2481 len
= get_lisp_to_sockaddr_size (address
, &family
);
2482 if (datagram_address
[channel
].len
!= len
)
2484 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2490 static struct socket_options
{
2491 /* The name of this option. Should be lowercase version of option
2492 name without SO_ prefix. */
2494 /* Option level SOL_... */
2496 /* Option number SO_... */
2498 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2499 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2500 } socket_options
[] =
2502 #ifdef SO_BINDTODEVICE
2503 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2506 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2509 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2512 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2515 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2518 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2521 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2524 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2526 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2529 /* Set option OPT to value VAL on socket S.
2531 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2532 Signals an error if setting a known option fails.
2536 set_socket_option (s
, opt
, val
)
2538 Lisp_Object opt
, val
;
2541 struct socket_options
*sopt
;
2546 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2547 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2548 if (strcmp (name
, sopt
->name
) == 0)
2551 switch (sopt
->opttype
)
2556 optval
= NILP (val
) ? 0 : 1;
2557 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2558 &optval
, sizeof (optval
));
2566 optval
= XINT (val
);
2568 error ("Bad option value for %s", name
);
2569 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2570 &optval
, sizeof (optval
));
2574 #ifdef SO_BINDTODEVICE
2577 char devname
[IFNAMSIZ
+1];
2579 /* This is broken, at least in the Linux 2.4 kernel.
2580 To unbind, the arg must be a zero integer, not the empty string.
2581 This should work on all systems. KFS. 2003-09-23. */
2582 bzero (devname
, sizeof devname
);
2585 char *arg
= (char *) SDATA (val
);
2586 int len
= min (strlen (arg
), IFNAMSIZ
);
2587 bcopy (arg
, devname
, len
);
2589 else if (!NILP (val
))
2590 error ("Bad option value for %s", name
);
2591 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2600 struct linger linger
;
2603 linger
.l_linger
= 0;
2605 linger
.l_linger
= XINT (val
);
2607 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2608 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2609 &linger
, sizeof (linger
));
2619 report_file_error ("Cannot set network option",
2620 Fcons (opt
, Fcons (val
, Qnil
)));
2621 return (1 << sopt
->optbit
);
2625 DEFUN ("set-network-process-option",
2626 Fset_network_process_option
, Sset_network_process_option
,
2628 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2629 See `make-network-process' for a list of options and values.
2630 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2631 OPTION is not a supported option, return nil instead; otherwise return t. */)
2632 (process
, option
, value
, no_error
)
2633 Lisp_Object process
, option
, value
;
2634 Lisp_Object no_error
;
2637 struct Lisp_Process
*p
;
2639 CHECK_PROCESS (process
);
2640 p
= XPROCESS (process
);
2641 if (!NETCONN1_P (p
))
2642 error ("Process is not a network process");
2646 error ("Process is not running");
2648 if (set_socket_option (s
, option
, value
))
2650 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2654 if (NILP (no_error
))
2655 error ("Unknown or unsupported option");
2661 /* A version of request_sigio suitable for a record_unwind_protect. */
2664 unwind_request_sigio (dummy
)
2667 if (interrupt_input
)
2672 /* Create a network stream/datagram client/server process. Treated
2673 exactly like a normal process when reading and writing. Primary
2674 differences are in status display and process deletion. A network
2675 connection has no PID; you cannot signal it. All you can do is
2676 stop/continue it and deactivate/close it via delete-process */
2678 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2680 doc
: /* Create and return a network server or client process.
2682 In Emacs, network connections are represented by process objects, so
2683 input and output work as for subprocesses and `delete-process' closes
2684 a network connection. However, a network process has no process id,
2685 it cannot be signaled, and the status codes are different from normal
2688 Arguments are specified as keyword/argument pairs. The following
2689 arguments are defined:
2691 :name NAME -- NAME is name for process. It is modified if necessary
2694 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2695 with the process. Process output goes at end of that buffer, unless
2696 you specify an output stream or filter function to handle the output.
2697 BUFFER may be also nil, meaning that this process is not associated
2700 :host HOST -- HOST is name of the host to connect to, or its IP
2701 address. The symbol `local' specifies the local host. If specified
2702 for a server process, it must be a valid name or address for the local
2703 host, and only clients connecting to that address will be accepted.
2705 :service SERVICE -- SERVICE is name of the service desired, or an
2706 integer specifying a port number to connect to. If SERVICE is t,
2707 a random port number is selected for the server.
2709 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2710 stream type connection, `datagram' creates a datagram type connection.
2712 :family FAMILY -- FAMILY is the address (and protocol) family for the
2713 service specified by HOST and SERVICE. The default (nil) is to use
2714 whatever address family (IPv4 or IPv6) that is defined for the host
2715 and port number specified by HOST and SERVICE. Other address families
2717 local -- for a local (i.e. UNIX) address specified by SERVICE.
2718 ipv4 -- use IPv4 address family only.
2719 ipv6 -- use IPv6 address family only.
2721 :local ADDRESS -- ADDRESS is the local address used for the connection.
2722 This parameter is ignored when opening a client process. When specified
2723 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2725 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2726 connection. This parameter is ignored when opening a stream server
2727 process. For a datagram server process, it specifies the initial
2728 setting of the remote datagram address. When specified for a client
2729 process, the FAMILY, HOST, and SERVICE args are ignored.
2731 The format of ADDRESS depends on the address family:
2732 - An IPv4 address is represented as an vector of integers [A B C D P]
2733 corresponding to numeric IP address A.B.C.D and port number P.
2734 - A local address is represented as a string with the address in the
2735 local address space.
2736 - An "unsupported family" address is represented by a cons (F . AV)
2737 where F is the family number and AV is a vector containing the socket
2738 address data with one element per address data byte. Do not rely on
2739 this format in portable code, as it may depend on implementation
2740 defined constants, data sizes, and data structure alignment.
2742 :coding CODING -- If CODING is a symbol, it specifies the coding
2743 system used for both reading and writing for this process. If CODING
2744 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2745 ENCODING is used for writing.
2747 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2748 return without waiting for the connection to complete; instead, the
2749 sentinel function will be called with second arg matching "open" (if
2750 successful) or "failed" when the connect completes. Default is to use
2751 a blocking connect (i.e. wait) for stream type connections.
2753 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2754 running when Emacs is exited.
2756 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2757 In the stopped state, a server process does not accept new
2758 connections, and a client process does not handle incoming traffic.
2759 The stopped state is cleared by `continue-process' and set by
2762 :filter FILTER -- Install FILTER as the process filter.
2764 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2765 process filter are multibyte, otherwise they are unibyte.
2766 If this keyword is not specified, the strings are multibyte iff
2767 `default-enable-multibyte-characters' is non-nil.
2769 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2771 :log LOG -- Install LOG as the server process log function. This
2772 function is called when the server accepts a network connection from a
2773 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2774 is the server process, CLIENT is the new process for the connection,
2775 and MESSAGE is a string.
2777 :plist PLIST -- Install PLIST as the new process' initial plist.
2779 :server QLEN -- if QLEN is non-nil, create a server process for the
2780 specified FAMILY, SERVICE, and connection type (stream or datagram).
2781 If QLEN is an integer, it is used as the max. length of the server's
2782 pending connection queue (also known as the backlog); the default
2783 queue length is 5. Default is to create a client process.
2785 The following network options can be specified for this connection:
2787 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2788 :dontroute BOOL -- Only send to directly connected hosts.
2789 :keepalive BOOL -- Send keep-alive messages on network stream.
2790 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2791 :oobinline BOOL -- Place out-of-band data in receive data stream.
2792 :priority INT -- Set protocol defined priority for sent packets.
2793 :reuseaddr BOOL -- Allow reusing a recently used local address
2794 (this is allowed by default for a server process).
2795 :bindtodevice NAME -- bind to interface NAME. Using this may require
2796 special privileges on some systems.
2798 Consult the relevant system programmer's manual pages for more
2799 information on using these options.
2802 A server process will listen for and accept connections from clients.
2803 When a client connection is accepted, a new network process is created
2804 for the connection with the following parameters:
2806 - The client's process name is constructed by concatenating the server
2807 process' NAME and a client identification string.
2808 - If the FILTER argument is non-nil, the client process will not get a
2809 separate process buffer; otherwise, the client's process buffer is a newly
2810 created buffer named after the server process' BUFFER name or process
2811 NAME concatenated with the client identification string.
2812 - The connection type and the process filter and sentinel parameters are
2813 inherited from the server process' TYPE, FILTER and SENTINEL.
2814 - The client process' contact info is set according to the client's
2815 addressing information (typically an IP address and a port number).
2816 - The client process' plist is initialized from the server's plist.
2818 Notice that the FILTER and SENTINEL args are never used directly by
2819 the server process. Also, the BUFFER argument is not used directly by
2820 the server process, but via the optional :log function, accepted (and
2821 failed) connections may be logged in the server process' buffer.
2823 The original argument list, modified with the actual connection
2824 information, is available via the `process-contact' function.
2826 usage: (make-network-process &rest ARGS) */)
2832 Lisp_Object contact
;
2833 struct Lisp_Process
*p
;
2834 #ifdef HAVE_GETADDRINFO
2835 struct addrinfo ai
, *res
, *lres
;
2836 struct addrinfo hints
;
2837 char *portstring
, portbuf
[128];
2838 #else /* HAVE_GETADDRINFO */
2839 struct _emacs_addrinfo
2845 struct sockaddr
*ai_addr
;
2846 struct _emacs_addrinfo
*ai_next
;
2848 #endif /* HAVE_GETADDRINFO */
2849 struct sockaddr_in address_in
;
2850 #ifdef HAVE_LOCAL_SOCKETS
2851 struct sockaddr_un address_un
;
2856 int s
= -1, outch
, inch
;
2857 struct gcpro gcpro1
;
2858 int count
= SPECPDL_INDEX ();
2860 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2862 Lisp_Object name
, buffer
, host
, service
, address
;
2863 Lisp_Object filter
, sentinel
;
2864 int is_non_blocking_client
= 0;
2865 int is_server
= 0, backlog
= 5;
2872 /* Save arguments for process-contact and clone-process. */
2873 contact
= Flist (nargs
, args
);
2877 /* Ensure socket support is loaded if available. */
2878 init_winsock (TRUE
);
2881 /* :type TYPE (nil: stream, datagram */
2882 tem
= Fplist_get (contact
, QCtype
);
2884 socktype
= SOCK_STREAM
;
2885 #ifdef DATAGRAM_SOCKETS
2886 else if (EQ (tem
, Qdatagram
))
2887 socktype
= SOCK_DGRAM
;
2890 error ("Unsupported connection type");
2893 tem
= Fplist_get (contact
, QCserver
);
2896 /* Don't support network sockets when non-blocking mode is
2897 not available, since a blocked Emacs is not useful. */
2898 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2899 error ("Network servers not supported");
2903 backlog
= XINT (tem
);
2907 /* Make QCaddress an alias for :local (server) or :remote (client). */
2908 QCaddress
= is_server
? QClocal
: QCremote
;
2911 if (!is_server
&& socktype
== SOCK_STREAM
2912 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2914 #ifndef NON_BLOCKING_CONNECT
2915 error ("Non-blocking connect not supported");
2917 is_non_blocking_client
= 1;
2921 name
= Fplist_get (contact
, QCname
);
2922 buffer
= Fplist_get (contact
, QCbuffer
);
2923 filter
= Fplist_get (contact
, QCfilter
);
2924 sentinel
= Fplist_get (contact
, QCsentinel
);
2926 CHECK_STRING (name
);
2929 /* Let's handle TERM before things get complicated ... */
2930 host
= Fplist_get (contact
, QChost
);
2931 CHECK_STRING (host
);
2933 service
= Fplist_get (contact
, QCservice
);
2934 if (INTEGERP (service
))
2935 port
= htons ((unsigned short) XINT (service
));
2938 struct servent
*svc_info
;
2939 CHECK_STRING (service
);
2940 svc_info
= getservbyname (SDATA (service
), "tcp");
2942 error ("Unknown service: %s", SDATA (service
));
2943 port
= svc_info
->s_port
;
2946 s
= connect_server (0);
2948 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2949 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2950 send_command (s
, C_DUMB
, 1, 0);
2952 #else /* not TERM */
2954 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2955 ai
.ai_socktype
= socktype
;
2960 /* :local ADDRESS or :remote ADDRESS */
2961 address
= Fplist_get (contact
, QCaddress
);
2962 if (!NILP (address
))
2964 host
= service
= Qnil
;
2966 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2967 error ("Malformed :address");
2968 ai
.ai_family
= family
;
2969 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2970 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2974 /* :family FAMILY -- nil (for Inet), local, or integer. */
2975 tem
= Fplist_get (contact
, QCfamily
);
2978 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
2984 #ifdef HAVE_LOCAL_SOCKETS
2985 else if (EQ (tem
, Qlocal
))
2989 else if (EQ (tem
, Qipv6
))
2992 else if (EQ (tem
, Qipv4
))
2994 else if (INTEGERP (tem
))
2995 family
= XINT (tem
);
2997 error ("Unknown address family");
2999 ai
.ai_family
= family
;
3001 /* :service SERVICE -- string, integer (port number), or t (random port). */
3002 service
= Fplist_get (contact
, QCservice
);
3004 #ifdef HAVE_LOCAL_SOCKETS
3005 if (family
== AF_LOCAL
)
3007 /* Host is not used. */
3009 CHECK_STRING (service
);
3010 bzero (&address_un
, sizeof address_un
);
3011 address_un
.sun_family
= AF_LOCAL
;
3012 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
3013 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
3014 ai
.ai_addrlen
= sizeof address_un
;
3019 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3020 host
= Fplist_get (contact
, QChost
);
3023 if (EQ (host
, Qlocal
))
3024 host
= build_string ("localhost");
3025 CHECK_STRING (host
);
3028 /* Slow down polling to every ten seconds.
3029 Some kernels have a bug which causes retrying connect to fail
3030 after a connect. Polling can interfere with gethostbyname too. */
3031 #ifdef POLL_FOR_INPUT
3032 if (socktype
== SOCK_STREAM
)
3034 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
3035 bind_polling_period (10);
3039 #ifdef HAVE_GETADDRINFO
3040 /* If we have a host, use getaddrinfo to resolve both host and service.
3041 Otherwise, use getservbyname to lookup the service. */
3045 /* SERVICE can either be a string or int.
3046 Convert to a C string for later use by getaddrinfo. */
3047 if (EQ (service
, Qt
))
3049 else if (INTEGERP (service
))
3051 sprintf (portbuf
, "%ld", (long) XINT (service
));
3052 portstring
= portbuf
;
3056 CHECK_STRING (service
);
3057 portstring
= SDATA (service
);
3062 memset (&hints
, 0, sizeof (hints
));
3064 hints
.ai_family
= family
;
3065 hints
.ai_socktype
= socktype
;
3066 hints
.ai_protocol
= 0;
3067 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3069 #ifdef HAVE_GAI_STRERROR
3070 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
3072 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3078 #endif /* HAVE_GETADDRINFO */
3080 /* We end up here if getaddrinfo is not defined, or in case no hostname
3081 has been specified (e.g. for a local server process). */
3083 if (EQ (service
, Qt
))
3085 else if (INTEGERP (service
))
3086 port
= htons ((unsigned short) XINT (service
));
3089 struct servent
*svc_info
;
3090 CHECK_STRING (service
);
3091 svc_info
= getservbyname (SDATA (service
),
3092 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3094 error ("Unknown service: %s", SDATA (service
));
3095 port
= svc_info
->s_port
;
3098 bzero (&address_in
, sizeof address_in
);
3099 address_in
.sin_family
= family
;
3100 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3101 address_in
.sin_port
= port
;
3103 #ifndef HAVE_GETADDRINFO
3106 struct hostent
*host_info_ptr
;
3108 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3109 as it may `hang' Emacs for a very long time. */
3112 host_info_ptr
= gethostbyname (SDATA (host
));
3117 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
3118 host_info_ptr
->h_length
);
3119 family
= host_info_ptr
->h_addrtype
;
3120 address_in
.sin_family
= family
;
3123 /* Attempt to interpret host as numeric inet address */
3125 IN_ADDR numeric_addr
;
3126 numeric_addr
= inet_addr ((char *) SDATA (host
));
3127 if (NUMERIC_ADDR_ERROR
)
3128 error ("Unknown host \"%s\"", SDATA (host
));
3130 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
3131 sizeof (address_in
.sin_addr
));
3135 #endif /* not HAVE_GETADDRINFO */
3137 ai
.ai_family
= family
;
3138 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3139 ai
.ai_addrlen
= sizeof address_in
;
3143 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
3144 when connect is interrupted. So let's not let it get interrupted.
3145 Note we do not turn off polling, because polling is only used
3146 when not interrupt_input, and thus not normally used on the systems
3147 which have this bug. On systems which use polling, there's no way
3148 to quit if polling is turned off. */
3150 && !is_server
&& socktype
== SOCK_STREAM
)
3152 /* Comment from KFS: The original open-network-stream code
3153 didn't unwind protect this, but it seems like the proper
3154 thing to do. In any case, I don't see how it could harm to
3155 do this -- and it makes cleanup (using unbind_to) easier. */
3156 record_unwind_protect (unwind_request_sigio
, Qnil
);
3160 /* Do this in case we never enter the for-loop below. */
3161 count1
= SPECPDL_INDEX ();
3164 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3170 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3177 #ifdef DATAGRAM_SOCKETS
3178 if (!is_server
&& socktype
== SOCK_DGRAM
)
3180 #endif /* DATAGRAM_SOCKETS */
3182 #ifdef NON_BLOCKING_CONNECT
3183 if (is_non_blocking_client
)
3186 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3188 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3200 /* Make us close S if quit. */
3201 record_unwind_protect (close_file_unwind
, make_number (s
));
3203 /* Parse network options in the arg list.
3204 We simply ignore anything which isn't a known option (including other keywords).
3205 An error is signalled if setting a known option fails. */
3206 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3207 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3211 /* Configure as a server socket. */
3213 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3214 explicit :reuseaddr key to override this. */
3215 #ifdef HAVE_LOCAL_SOCKETS
3216 if (family
!= AF_LOCAL
)
3218 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3221 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3222 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3225 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3226 report_file_error ("Cannot bind server socket", Qnil
);
3228 #ifdef HAVE_GETSOCKNAME
3229 if (EQ (service
, Qt
))
3231 struct sockaddr_in sa1
;
3232 int len1
= sizeof (sa1
);
3233 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3235 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3236 service
= make_number (ntohs (sa1
.sin_port
));
3237 contact
= Fplist_put (contact
, QCservice
, service
);
3242 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3243 report_file_error ("Cannot listen on server socket", Qnil
);
3251 /* This turns off all alarm-based interrupts; the
3252 bind_polling_period call above doesn't always turn all the
3253 short-interval ones off, especially if interrupt_input is
3256 It'd be nice to be able to control the connect timeout
3257 though. Would non-blocking connect calls be portable?
3259 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3261 turn_on_atimers (0);
3263 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3266 turn_on_atimers (1);
3268 if (ret
== 0 || xerrno
== EISCONN
)
3270 /* The unwind-protect will be discarded afterwards.
3271 Likewise for immediate_quit. */
3275 #ifdef NON_BLOCKING_CONNECT
3277 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3281 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3289 /* Discard the unwind protect closing S. */
3290 specpdl_ptr
= specpdl
+ count1
;
3294 if (xerrno
== EINTR
)
3300 #ifdef DATAGRAM_SOCKETS
3301 if (socktype
== SOCK_DGRAM
)
3303 if (datagram_address
[s
].sa
)
3305 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3306 datagram_address
[s
].len
= lres
->ai_addrlen
;
3310 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3311 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3314 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3315 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3316 conv_lisp_to_sockaddr (rfamily
, remote
,
3317 datagram_address
[s
].sa
, rlen
);
3321 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3324 contact
= Fplist_put (contact
, QCaddress
,
3325 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3326 #ifdef HAVE_GETSOCKNAME
3329 struct sockaddr_in sa1
;
3330 int len1
= sizeof (sa1
);
3331 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3332 contact
= Fplist_put (contact
, QClocal
,
3333 conv_sockaddr_to_lisp (&sa1
, len1
));
3340 #ifdef HAVE_GETADDRINFO
3349 /* Discard the unwind protect for closing S, if any. */
3350 specpdl_ptr
= specpdl
+ count1
;
3352 /* Unwind bind_polling_period and request_sigio. */
3353 unbind_to (count
, Qnil
);
3357 /* If non-blocking got this far - and failed - assume non-blocking is
3358 not supported after all. This is probably a wrong assumption, but
3359 the normal blocking calls to open-network-stream handles this error
3361 if (is_non_blocking_client
)
3366 report_file_error ("make server process failed", contact
);
3368 report_file_error ("make client process failed", contact
);
3371 #endif /* not TERM */
3377 buffer
= Fget_buffer_create (buffer
);
3378 proc
= make_process (name
);
3380 chan_process
[inch
] = proc
;
3383 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3386 fcntl (inch
, F_SETFL
, O_NDELAY
);
3390 p
= XPROCESS (proc
);
3392 p
->childp
= contact
;
3393 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3396 p
->sentinel
= sentinel
;
3398 p
->filter_multibyte
= buffer_defaults
.enable_multibyte_characters
;
3399 /* Override the above only if :filter-multibyte is specified. */
3400 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3401 p
->filter_multibyte
= Fplist_get (contact
, QCfilter_multibyte
);
3402 p
->log
= Fplist_get (contact
, QClog
);
3403 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3404 p
->kill_without_query
= Qt
;
3405 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3408 XSETINT (p
->infd
, inch
);
3409 XSETINT (p
->outfd
, outch
);
3410 if (is_server
&& socktype
== SOCK_STREAM
)
3411 p
->status
= Qlisten
;
3413 /* Make the process marker point into the process buffer (if any). */
3414 if (BUFFERP (buffer
))
3415 set_marker_both (p
->mark
, buffer
,
3416 BUF_ZV (XBUFFER (buffer
)),
3417 BUF_ZV_BYTE (XBUFFER (buffer
)));
3419 #ifdef NON_BLOCKING_CONNECT
3420 if (is_non_blocking_client
)
3422 /* We may get here if connect did succeed immediately. However,
3423 in that case, we still need to signal this like a non-blocking
3425 p
->status
= Qconnect
;
3426 if (!FD_ISSET (inch
, &connect_wait_mask
))
3428 FD_SET (inch
, &connect_wait_mask
);
3429 num_pending_connects
++;
3434 /* A server may have a client filter setting of Qt, but it must
3435 still listen for incoming connects unless it is stopped. */
3436 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3437 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3439 FD_SET (inch
, &input_wait_mask
);
3440 FD_SET (inch
, &non_keyboard_wait_mask
);
3443 if (inch
> max_process_desc
)
3444 max_process_desc
= inch
;
3446 tem
= Fplist_member (contact
, QCcoding
);
3447 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3448 tem
= Qnil
; /* No error message (too late!). */
3451 /* Setup coding systems for communicating with the network stream. */
3452 struct gcpro gcpro1
;
3453 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3454 Lisp_Object coding_systems
= Qt
;
3455 Lisp_Object args
[5], val
;
3459 val
= XCAR (XCDR (tem
));
3463 else if (!NILP (Vcoding_system_for_read
))
3464 val
= Vcoding_system_for_read
;
3465 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3466 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3467 /* We dare not decode end-of-line format by setting VAL to
3468 Qraw_text, because the existing Emacs Lisp libraries
3469 assume that they receive bare code including a sequene of
3474 if (NILP (host
) || NILP (service
))
3475 coding_systems
= Qnil
;
3478 args
[0] = Qopen_network_stream
, args
[1] = name
,
3479 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3481 coding_systems
= Ffind_operation_coding_system (5, args
);
3484 if (CONSP (coding_systems
))
3485 val
= XCAR (coding_systems
);
3486 else if (CONSP (Vdefault_process_coding_system
))
3487 val
= XCAR (Vdefault_process_coding_system
);
3491 p
->decode_coding_system
= val
;
3495 val
= XCAR (XCDR (tem
));
3499 else if (!NILP (Vcoding_system_for_write
))
3500 val
= Vcoding_system_for_write
;
3501 else if (NILP (current_buffer
->enable_multibyte_characters
))
3505 if (EQ (coding_systems
, Qt
))
3507 if (NILP (host
) || NILP (service
))
3508 coding_systems
= Qnil
;
3511 args
[0] = Qopen_network_stream
, args
[1] = name
,
3512 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3514 coding_systems
= Ffind_operation_coding_system (5, args
);
3518 if (CONSP (coding_systems
))
3519 val
= XCDR (coding_systems
);
3520 else if (CONSP (Vdefault_process_coding_system
))
3521 val
= XCDR (Vdefault_process_coding_system
);
3525 p
->encode_coding_system
= val
;
3527 setup_process_coding_systems (proc
);
3529 p
->decoding_buf
= make_uninit_string (0);
3530 p
->decoding_carryover
= make_number (0);
3531 p
->encoding_buf
= make_uninit_string (0);
3532 p
->encoding_carryover
= make_number (0);
3534 p
->inherit_coding_system_flag
3535 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3541 #endif /* HAVE_SOCKETS */
3544 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3547 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3548 doc
: /* Return an alist of all network interfaces and their network address.
3549 Each element is a cons, the car of which is a string containing the
3550 interface name, and the cdr is the network address in internal
3551 format; see the description of ADDRESS in `make-network-process'. */)
3554 struct ifconf ifconf
;
3555 struct ifreq
*ifreqs
= NULL
;
3560 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3566 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3567 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3574 ifconf
.ifc_len
= buf_size
;
3575 ifconf
.ifc_req
= ifreqs
;
3576 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3582 if (ifconf
.ifc_len
== buf_size
)
3586 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3589 while (--ifaces
>= 0)
3591 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3592 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3593 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3595 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3596 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3597 res
= Fcons (Fcons (build_string (namebuf
),
3598 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3599 sizeof (struct sockaddr
))),
3605 #endif /* SIOCGIFCONF */
3607 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3614 static struct ifflag_def ifflag_table
[] = {
3618 #ifdef IFF_BROADCAST
3619 { IFF_BROADCAST
, "broadcast" },
3622 { IFF_DEBUG
, "debug" },
3625 { IFF_LOOPBACK
, "loopback" },
3627 #ifdef IFF_POINTOPOINT
3628 { IFF_POINTOPOINT
, "pointopoint" },
3631 { IFF_RUNNING
, "running" },
3634 { IFF_NOARP
, "noarp" },
3637 { IFF_PROMISC
, "promisc" },
3639 #ifdef IFF_NOTRAILERS
3640 { IFF_NOTRAILERS
, "notrailers" },
3643 { IFF_ALLMULTI
, "allmulti" },
3646 { IFF_MASTER
, "master" },
3649 { IFF_SLAVE
, "slave" },
3651 #ifdef IFF_MULTICAST
3652 { IFF_MULTICAST
, "multicast" },
3655 { IFF_PORTSEL
, "portsel" },
3657 #ifdef IFF_AUTOMEDIA
3658 { IFF_AUTOMEDIA
, "automedia" },
3661 { IFF_DYNAMIC
, "dynamic" },
3664 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3667 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3670 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3673 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3676 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3681 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3682 doc
: /* Return information about network interface named IFNAME.
3683 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3684 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3685 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3686 FLAGS is the current flags of the interface. */)
3691 Lisp_Object res
= Qnil
;
3696 CHECK_STRING (ifname
);
3698 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3699 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3701 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3706 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3707 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3709 int flags
= rq
.ifr_flags
;
3710 struct ifflag_def
*fp
;
3714 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3716 if (flags
& fp
->flag_bit
)
3718 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3719 flags
-= fp
->flag_bit
;
3722 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3724 if (flags
& (1 << fnum
))
3726 elt
= Fcons (make_number (fnum
), elt
);
3731 res
= Fcons (elt
, res
);
3734 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3735 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3737 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3738 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3742 for (n
= 0; n
< 6; n
++)
3743 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3744 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3747 res
= Fcons (elt
, res
);
3750 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
3751 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3754 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3755 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3757 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3761 res
= Fcons (elt
, res
);
3764 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3765 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3768 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3771 res
= Fcons (elt
, res
);
3774 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3775 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3778 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3781 res
= Fcons (elt
, res
);
3785 return any
? res
: Qnil
;
3788 #endif /* HAVE_SOCKETS */
3790 /* Turn off input and output for process PROC. */
3793 deactivate_process (proc
)
3796 register int inchannel
, outchannel
;
3797 register struct Lisp_Process
*p
= XPROCESS (proc
);
3799 inchannel
= XINT (p
->infd
);
3800 outchannel
= XINT (p
->outfd
);
3802 #ifdef ADAPTIVE_READ_BUFFERING
3803 if (XINT (p
->read_output_delay
) > 0)
3805 if (--process_output_delay_count
< 0)
3806 process_output_delay_count
= 0;
3807 XSETINT (p
->read_output_delay
, 0);
3808 p
->read_output_skip
= Qnil
;
3814 /* Beware SIGCHLD hereabouts. */
3815 flush_pending_output (inchannel
);
3818 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3819 sys$
dassgn (outchannel
);
3820 vs
= get_vms_process_pointer (p
->pid
);
3822 give_back_vms_process_stuff (vs
);
3825 emacs_close (inchannel
);
3826 if (outchannel
>= 0 && outchannel
!= inchannel
)
3827 emacs_close (outchannel
);
3830 XSETINT (p
->infd
, -1);
3831 XSETINT (p
->outfd
, -1);
3832 #ifdef DATAGRAM_SOCKETS
3833 if (DATAGRAM_CHAN_P (inchannel
))
3835 xfree (datagram_address
[inchannel
].sa
);
3836 datagram_address
[inchannel
].sa
= 0;
3837 datagram_address
[inchannel
].len
= 0;
3840 chan_process
[inchannel
] = Qnil
;
3841 FD_CLR (inchannel
, &input_wait_mask
);
3842 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3843 #ifdef NON_BLOCKING_CONNECT
3844 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3846 FD_CLR (inchannel
, &connect_wait_mask
);
3847 if (--num_pending_connects
< 0)
3851 if (inchannel
== max_process_desc
)
3854 /* We just closed the highest-numbered process input descriptor,
3855 so recompute the highest-numbered one now. */
3856 max_process_desc
= 0;
3857 for (i
= 0; i
< MAXDESC
; i
++)
3858 if (!NILP (chan_process
[i
]))
3859 max_process_desc
= i
;
3864 /* Close all descriptors currently in use for communication
3865 with subprocess. This is used in a newly-forked subprocess
3866 to get rid of irrelevant descriptors. */
3869 close_process_descs ()
3873 for (i
= 0; i
< MAXDESC
; i
++)
3875 Lisp_Object process
;
3876 process
= chan_process
[i
];
3877 if (!NILP (process
))
3879 int in
= XINT (XPROCESS (process
)->infd
);
3880 int out
= XINT (XPROCESS (process
)->outfd
);
3883 if (out
>= 0 && in
!= out
)
3890 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3892 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3893 It is read into the process' buffers or given to their filter functions.
3894 Non-nil arg PROCESS means do not return until some output has been received
3897 Non-nil second arg SECONDS and third arg MILLISEC are number of
3898 seconds and milliseconds to wait; return after that much time whether
3899 or not there is input. If SECONDS is a floating point number,
3900 it specifies a fractional number of seconds to wait.
3902 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3903 from PROCESS, suspending reading output from other processes.
3904 If JUST-THIS-ONE is an integer, don't run any timers either.
3905 Return non-nil iff we received any output before the timeout expired. */)
3906 (process
, seconds
, millisec
, just_this_one
)
3907 register Lisp_Object process
, seconds
, millisec
, just_this_one
;
3909 int secs
, usecs
= 0;
3911 if (! NILP (process
))
3912 CHECK_PROCESS (process
);
3914 just_this_one
= Qnil
;
3916 if (!NILP (seconds
))
3918 if (INTEGERP (seconds
))
3919 secs
= XINT (seconds
);
3920 else if (FLOATP (seconds
))
3922 double timeout
= XFLOAT_DATA (seconds
);
3923 secs
= (int) timeout
;
3924 usecs
= (int) ((timeout
- (double) secs
) * 1000000);
3927 wrong_type_argument (Qnumberp
, seconds
);
3929 if (INTEGERP (millisec
))
3932 usecs
+= XINT (millisec
) * 1000;
3933 carry
= usecs
/ 1000000;
3935 if ((usecs
-= carry
* 1000000) < 0)
3942 if (secs
< 0 || (secs
== 0 && usecs
== 0))
3943 secs
= -1, usecs
= 0;
3946 secs
= NILP (process
) ? -1 : 0;
3949 (wait_reading_process_output (secs
, usecs
, 0, 0,
3951 !NILP (process
) ? XPROCESS (process
) : NULL
,
3952 NILP (just_this_one
) ? 0 :
3953 !INTEGERP (just_this_one
) ? 1 : -1)
3957 /* Accept a connection for server process SERVER on CHANNEL. */
3959 static int connect_counter
= 0;
3962 server_accept_connection (server
, channel
)
3966 Lisp_Object proc
, caller
, name
, buffer
;
3967 Lisp_Object contact
, host
, service
;
3968 struct Lisp_Process
*ps
= XPROCESS (server
);
3969 struct Lisp_Process
*p
;
3973 struct sockaddr_in in
;
3975 struct sockaddr_in6 in6
;
3977 #ifdef HAVE_LOCAL_SOCKETS
3978 struct sockaddr_un un
;
3981 int len
= sizeof saddr
;
3983 s
= accept (channel
, &saddr
.sa
, &len
);
3992 if (code
== EWOULDBLOCK
)
3996 if (!NILP (ps
->log
))
3997 call3 (ps
->log
, server
, Qnil
,
3998 concat3 (build_string ("accept failed with code"),
3999 Fnumber_to_string (make_number (code
)),
4000 build_string ("\n")));
4006 /* Setup a new process to handle the connection. */
4008 /* Generate a unique identification of the caller, and build contact
4009 information for this process. */
4012 switch (saddr
.sa
.sa_family
)
4016 Lisp_Object args
[5];
4017 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4018 args
[0] = build_string ("%d.%d.%d.%d");
4019 args
[1] = make_number (*ip
++);
4020 args
[2] = make_number (*ip
++);
4021 args
[3] = make_number (*ip
++);
4022 args
[4] = make_number (*ip
++);
4023 host
= Fformat (5, args
);
4024 service
= make_number (ntohs (saddr
.in
.sin_port
));
4026 args
[0] = build_string (" <%s:%d>");
4029 caller
= Fformat (3, args
);
4036 Lisp_Object args
[9];
4037 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4039 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4040 for (i
= 0; i
< 8; i
++)
4041 args
[i
+1] = make_number (ntohs(ip6
[i
]));
4042 host
= Fformat (9, args
);
4043 service
= make_number (ntohs (saddr
.in
.sin_port
));
4045 args
[0] = build_string (" <[%s]:%d>");
4048 caller
= Fformat (3, args
);
4053 #ifdef HAVE_LOCAL_SOCKETS
4057 caller
= Fnumber_to_string (make_number (connect_counter
));
4058 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
4062 /* Create a new buffer name for this process if it doesn't have a
4063 filter. The new buffer name is based on the buffer name or
4064 process name of the server process concatenated with the caller
4067 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4071 buffer
= ps
->buffer
;
4073 buffer
= Fbuffer_name (buffer
);
4078 buffer
= concat2 (buffer
, caller
);
4079 buffer
= Fget_buffer_create (buffer
);
4083 /* Generate a unique name for the new server process. Combine the
4084 server process name with the caller identification. */
4086 name
= concat2 (ps
->name
, caller
);
4087 proc
= make_process (name
);
4089 chan_process
[s
] = proc
;
4092 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4095 fcntl (s
, F_SETFL
, O_NDELAY
);
4099 p
= XPROCESS (proc
);
4101 /* Build new contact information for this setup. */
4102 contact
= Fcopy_sequence (ps
->childp
);
4103 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4104 contact
= Fplist_put (contact
, QChost
, host
);
4105 if (!NILP (service
))
4106 contact
= Fplist_put (contact
, QCservice
, service
);
4107 contact
= Fplist_put (contact
, QCremote
,
4108 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4109 #ifdef HAVE_GETSOCKNAME
4111 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4112 contact
= Fplist_put (contact
, QClocal
,
4113 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4116 p
->childp
= contact
;
4117 p
->plist
= Fcopy_sequence (ps
->plist
);
4120 p
->sentinel
= ps
->sentinel
;
4121 p
->filter
= ps
->filter
;
4124 XSETINT (p
->infd
, s
);
4125 XSETINT (p
->outfd
, s
);
4128 /* Client processes for accepted connections are not stopped initially. */
4129 if (!EQ (p
->filter
, Qt
))
4131 FD_SET (s
, &input_wait_mask
);
4132 FD_SET (s
, &non_keyboard_wait_mask
);
4135 if (s
> max_process_desc
)
4136 max_process_desc
= s
;
4138 /* Setup coding system for new process based on server process.
4139 This seems to be the proper thing to do, as the coding system
4140 of the new process should reflect the settings at the time the
4141 server socket was opened; not the current settings. */
4143 p
->decode_coding_system
= ps
->decode_coding_system
;
4144 p
->encode_coding_system
= ps
->encode_coding_system
;
4145 setup_process_coding_systems (proc
);
4147 p
->decoding_buf
= make_uninit_string (0);
4148 p
->decoding_carryover
= make_number (0);
4149 p
->encoding_buf
= make_uninit_string (0);
4150 p
->encoding_carryover
= make_number (0);
4152 p
->inherit_coding_system_flag
4153 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
4155 if (!NILP (ps
->log
))
4156 call3 (ps
->log
, server
, proc
,
4157 concat3 (build_string ("accept from "),
4158 (STRINGP (host
) ? host
: build_string ("-")),
4159 build_string ("\n")));
4161 if (!NILP (p
->sentinel
))
4162 exec_sentinel (proc
,
4163 concat3 (build_string ("open from "),
4164 (STRINGP (host
) ? host
: build_string ("-")),
4165 build_string ("\n")));
4168 /* This variable is different from waiting_for_input in keyboard.c.
4169 It is used to communicate to a lisp process-filter/sentinel (via the
4170 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4171 for user-input when that process-filter was called.
4172 waiting_for_input cannot be used as that is by definition 0 when
4173 lisp code is being evalled.
4174 This is also used in record_asynch_buffer_change.
4175 For that purpose, this must be 0
4176 when not inside wait_reading_process_output. */
4177 static int waiting_for_user_input_p
;
4180 wait_reading_process_output_unwind (data
)
4183 waiting_for_user_input_p
= XINT (data
);
4187 /* This is here so breakpoints can be put on it. */
4189 wait_reading_process_output_1 ()
4193 /* Use a wrapper around select to work around a bug in gdb 5.3.
4194 Normally, the wrapper is optimzed away by inlining.
4196 If emacs is stopped inside select, the gdb backtrace doesn't
4197 show the function which called select, so it is practically
4198 impossible to step through wait_reading_process_output. */
4202 select_wrapper (n
, rfd
, wfd
, xfd
, tmo
)
4204 SELECT_TYPE
*rfd
, *wfd
, *xfd
;
4207 return select (n
, rfd
, wfd
, xfd
, tmo
);
4209 #define select select_wrapper
4212 /* Read and dispose of subprocess output while waiting for timeout to
4213 elapse and/or keyboard input to be available.
4216 timeout in seconds, or
4217 zero for no limit, or
4218 -1 means gobble data immediately available but don't wait for any.
4221 an additional duration to wait, measured in microseconds.
4222 If this is nonzero and time_limit is 0, then the timeout
4223 consists of MICROSECS only.
4225 READ_KBD is a lisp value:
4226 0 to ignore keyboard input, or
4227 1 to return when input is available, or
4228 -1 meaning caller will actually read the input, so don't throw to
4229 the quit handler, or
4231 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4232 output that arrives.
4234 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4235 (and gobble terminal input into the buffer if any arrives).
4237 If WAIT_PROC is specified, wait until something arrives from that
4238 process. The return value is true iff we read some input from
4241 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4242 (suspending output from other processes). A negative value
4243 means don't run any timers either.
4245 If WAIT_PROC is specified, then the function returns true iff we
4246 received input from that process before the timeout elapsed.
4247 Otherwise, return true iff we received input from any process. */
4250 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
4251 wait_for_cell
, wait_proc
, just_wait_proc
)
4252 int time_limit
, microsecs
, read_kbd
, do_display
;
4253 Lisp_Object wait_for_cell
;
4254 struct Lisp_Process
*wait_proc
;
4257 register int channel
, nfds
;
4258 SELECT_TYPE Available
;
4259 #ifdef NON_BLOCKING_CONNECT
4260 SELECT_TYPE Connecting
;
4263 int check_delay
, no_avail
;
4266 EMACS_TIME timeout
, end_time
;
4267 int wait_channel
= -1;
4268 int got_some_input
= 0;
4269 int count
= SPECPDL_INDEX ();
4271 FD_ZERO (&Available
);
4272 #ifdef NON_BLOCKING_CONNECT
4273 FD_ZERO (&Connecting
);
4276 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4277 if (wait_proc
!= NULL
)
4278 wait_channel
= XINT (wait_proc
->infd
);
4280 record_unwind_protect (wait_reading_process_output_unwind
,
4281 make_number (waiting_for_user_input_p
));
4282 waiting_for_user_input_p
= read_kbd
;
4284 /* Since we may need to wait several times,
4285 compute the absolute time to return at. */
4286 if (time_limit
|| microsecs
)
4288 EMACS_GET_TIME (end_time
);
4289 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4290 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4292 #ifdef POLL_INTERRUPTED_SYS_CALL
4293 /* AlainF 5-Jul-1996
4294 HP-UX 10.10 seem to have problems with signals coming in
4295 Causes "poll: interrupted system call" messages when Emacs is run
4297 Turn off periodic alarms (in case they are in use),
4298 and then turn off any other atimers. */
4300 turn_on_atimers (0);
4301 #endif /* POLL_INTERRUPTED_SYS_CALL */
4305 int timeout_reduced_for_timers
= 0;
4307 /* If calling from keyboard input, do not quit
4308 since we want to return C-g as an input character.
4309 Otherwise, do pending quit if requested. */
4313 else if (interrupt_input_pending
)
4314 handle_async_input ();
4317 /* Exit now if the cell we're waiting for became non-nil. */
4318 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4321 /* Compute time from now till when time limit is up */
4322 /* Exit if already run out */
4323 if (time_limit
== -1)
4325 /* -1 specified for timeout means
4326 gobble output available now
4327 but don't wait at all. */
4329 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4331 else if (time_limit
|| microsecs
)
4333 EMACS_GET_TIME (timeout
);
4334 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4335 if (EMACS_TIME_NEG_P (timeout
))
4340 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4343 /* Normally we run timers here.
4344 But not if wait_for_cell; in those cases,
4345 the wait is supposed to be short,
4346 and those callers cannot handle running arbitrary Lisp code here. */
4347 if (NILP (wait_for_cell
)
4348 && just_wait_proc
>= 0)
4350 EMACS_TIME timer_delay
;
4354 int old_timers_run
= timers_run
;
4355 struct buffer
*old_buffer
= current_buffer
;
4357 timer_delay
= timer_check (1);
4359 /* If a timer has run, this might have changed buffers
4360 an alike. Make read_key_sequence aware of that. */
4361 if (timers_run
!= old_timers_run
4362 && old_buffer
!= current_buffer
4363 && waiting_for_user_input_p
== -1)
4364 record_asynch_buffer_change ();
4366 if (timers_run
!= old_timers_run
&& do_display
)
4367 /* We must retry, since a timer may have requeued itself
4368 and that could alter the time_delay. */
4369 redisplay_preserve_echo_area (9);
4373 while (!detect_input_pending ());
4375 /* If there is unread keyboard input, also return. */
4377 && requeued_events_pending_p ())
4380 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4382 EMACS_TIME difference
;
4383 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4384 if (EMACS_TIME_NEG_P (difference
))
4386 timeout
= timer_delay
;
4387 timeout_reduced_for_timers
= 1;
4390 /* If time_limit is -1, we are not going to wait at all. */
4391 else if (time_limit
!= -1)
4393 /* This is so a breakpoint can be put here. */
4394 wait_reading_process_output_1 ();
4398 /* Cause C-g and alarm signals to take immediate action,
4399 and cause input available signals to zero out timeout.
4401 It is important that we do this before checking for process
4402 activity. If we get a SIGCHLD after the explicit checks for
4403 process activity, timeout is the only way we will know. */
4405 set_waiting_for_input (&timeout
);
4407 /* If status of something has changed, and no input is
4408 available, notify the user of the change right away. After
4409 this explicit check, we'll let the SIGCHLD handler zap
4410 timeout to get our attention. */
4411 if (update_tick
!= process_tick
&& do_display
)
4414 #ifdef NON_BLOCKING_CONNECT
4418 Atemp
= input_wait_mask
;
4420 /* On Mac OS X 10.0, the SELECT system call always says input is
4421 present (for reading) at stdin, even when none is. This
4422 causes the call to SELECT below to return 1 and
4423 status_notify not to be called. As a result output of
4424 subprocesses are incorrectly discarded.
4428 IF_NON_BLOCKING_CONNECT (Ctemp
= connect_wait_mask
);
4430 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4431 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
4433 #ifdef NON_BLOCKING_CONNECT
4434 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4438 (SELECT_TYPE
*)0, &timeout
)
4441 /* It's okay for us to do this and then continue with
4442 the loop, since timeout has already been zeroed out. */
4443 clear_waiting_for_input ();
4444 status_notify (NULL
);
4448 /* Don't wait for output from a non-running process. Just
4449 read whatever data has already been received. */
4450 if (wait_proc
&& wait_proc
->raw_status_new
)
4451 update_status (wait_proc
);
4453 && ! EQ (wait_proc
->status
, Qrun
)
4454 && ! EQ (wait_proc
->status
, Qconnect
))
4456 int nread
, total_nread
= 0;
4458 clear_waiting_for_input ();
4459 XSETPROCESS (proc
, wait_proc
);
4461 /* Read data from the process, until we exhaust it. */
4462 while (XINT (wait_proc
->infd
) >= 0)
4464 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
4470 total_nread
+= nread
;
4472 else if (nread
== -1 && EIO
== errno
)
4476 else if (nread
== -1 && EAGAIN
== errno
)
4480 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4484 if (total_nread
> 0 && do_display
)
4485 redisplay_preserve_echo_area (10);
4490 /* Wait till there is something to do */
4492 if (wait_proc
&& just_wait_proc
)
4494 if (XINT (wait_proc
->infd
) < 0) /* Terminated */
4496 FD_SET (XINT (wait_proc
->infd
), &Available
);
4498 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4500 else if (!NILP (wait_for_cell
))
4502 Available
= non_process_wait_mask
;
4504 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4509 Available
= non_keyboard_wait_mask
;
4511 Available
= input_wait_mask
;
4512 IF_NON_BLOCKING_CONNECT (check_connect
= (num_pending_connects
> 0));
4513 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4516 /* If frame size has changed or the window is newly mapped,
4517 redisplay now, before we start to wait. There is a race
4518 condition here; if a SIGIO arrives between now and the select
4519 and indicates that a frame is trashed, the select may block
4520 displaying a trashed screen. */
4521 if (frame_garbaged
&& do_display
)
4523 clear_waiting_for_input ();
4524 redisplay_preserve_echo_area (11);
4526 set_waiting_for_input (&timeout
);
4530 if (read_kbd
&& detect_input_pending ())
4537 #ifdef NON_BLOCKING_CONNECT
4539 Connecting
= connect_wait_mask
;
4542 #ifdef ADAPTIVE_READ_BUFFERING
4543 /* Set the timeout for adaptive read buffering if any
4544 process has non-nil read_output_skip and non-zero
4545 read_output_delay, and we are not reading output for a
4546 specific wait_channel. It is not executed if
4547 Vprocess_adaptive_read_buffering is nil. */
4548 if (process_output_skip
&& check_delay
> 0)
4550 int usecs
= EMACS_USECS (timeout
);
4551 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4552 usecs
= READ_OUTPUT_DELAY_MAX
;
4553 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4555 proc
= chan_process
[channel
];
4558 /* Find minimum non-zero read_output_delay among the
4559 processes with non-nil read_output_skip. */
4560 if (XINT (XPROCESS (proc
)->read_output_delay
) > 0)
4563 if (NILP (XPROCESS (proc
)->read_output_skip
))
4565 FD_CLR (channel
, &Available
);
4566 XPROCESS (proc
)->read_output_skip
= Qnil
;
4567 if (XINT (XPROCESS (proc
)->read_output_delay
) < usecs
)
4568 usecs
= XINT (XPROCESS (proc
)->read_output_delay
);
4571 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4572 process_output_skip
= 0;
4576 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4578 #ifdef NON_BLOCKING_CONNECT
4579 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4583 (SELECT_TYPE
*)0, &timeout
);
4588 /* Make C-g and alarm signals set flags again */
4589 clear_waiting_for_input ();
4591 /* If we woke up due to SIGWINCH, actually change size now. */
4592 do_pending_window_change (0);
4594 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4595 /* We wanted the full specified time, so return now. */
4599 if (xerrno
== EINTR
)
4602 /* Ultrix select seems to return ENOMEM when it is
4603 interrupted. Treat it just like EINTR. Bleah. Note
4604 that we want to test for the "ultrix" CPP symbol, not
4605 "__ultrix__"; the latter is only defined under GCC, but
4606 not by DEC's bundled CC. -JimB */
4607 else if (xerrno
== ENOMEM
)
4611 /* This happens for no known reason on ALLIANT.
4612 I am guessing that this is the right response. -- RMS. */
4613 else if (xerrno
== EFAULT
)
4616 else if (xerrno
== EBADF
)
4619 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4620 the child's closure of the pts gives the parent a SIGHUP, and
4621 the ptc file descriptor is automatically closed,
4622 yielding EBADF here or at select() call above.
4623 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4624 in m/ibmrt-aix.h), and here we just ignore the select error.
4625 Cleanup occurs c/o status_notify after SIGCLD. */
4626 no_avail
= 1; /* Cannot depend on values returned */
4632 error ("select error: %s", emacs_strerror (xerrno
));
4637 FD_ZERO (&Available
);
4638 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4641 #if defined(sun) && !defined(USG5_4)
4642 if (nfds
> 0 && keyboard_bit_set (&Available
)
4644 /* System sometimes fails to deliver SIGIO.
4646 David J. Mackenzie says that Emacs doesn't compile under
4647 Solaris if this code is enabled, thus the USG5_4 in the CPP
4648 conditional. "I haven't noticed any ill effects so far.
4649 If you find a Solaris expert somewhere, they might know
4651 kill (getpid (), SIGIO
);
4654 #if 0 /* When polling is used, interrupt_input is 0,
4655 so get_input_pending should read the input.
4656 So this should not be needed. */
4657 /* If we are using polling for input,
4658 and we see input available, make it get read now.
4659 Otherwise it might not actually get read for a second.
4660 And on hpux, since we turn off polling in wait_reading_process_output,
4661 it might never get read at all if we don't spend much time
4662 outside of wait_reading_process_output. */
4663 if (read_kbd
&& interrupt_input
4664 && keyboard_bit_set (&Available
)
4665 && input_polling_used ())
4666 kill (getpid (), SIGALRM
);
4669 /* Check for keyboard input */
4670 /* If there is any, return immediately
4671 to give it higher priority than subprocesses */
4675 int old_timers_run
= timers_run
;
4676 struct buffer
*old_buffer
= current_buffer
;
4679 if (detect_input_pending_run_timers (do_display
))
4681 swallow_events (do_display
);
4682 if (detect_input_pending_run_timers (do_display
))
4686 /* If a timer has run, this might have changed buffers
4687 an alike. Make read_key_sequence aware of that. */
4688 if (timers_run
!= old_timers_run
4689 && waiting_for_user_input_p
== -1
4690 && old_buffer
!= current_buffer
)
4691 record_asynch_buffer_change ();
4697 /* If there is unread keyboard input, also return. */
4699 && requeued_events_pending_p ())
4702 /* If we are not checking for keyboard input now,
4703 do process events (but don't run any timers).
4704 This is so that X events will be processed.
4705 Otherwise they may have to wait until polling takes place.
4706 That would causes delays in pasting selections, for example.
4708 (We used to do this only if wait_for_cell.) */
4709 if (read_kbd
== 0 && detect_input_pending ())
4711 swallow_events (do_display
);
4712 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4713 if (detect_input_pending ())
4718 /* Exit now if the cell we're waiting for became non-nil. */
4719 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4723 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4724 go read it. This can happen with X on BSD after logging out.
4725 In that case, there really is no input and no SIGIO,
4726 but select says there is input. */
4728 if (read_kbd
&& interrupt_input
4729 && keyboard_bit_set (&Available
) && ! noninteractive
)
4730 kill (getpid (), SIGIO
);
4734 got_some_input
|= nfds
> 0;
4736 /* If checking input just got us a size-change event from X,
4737 obey it now if we should. */
4738 if (read_kbd
|| ! NILP (wait_for_cell
))
4739 do_pending_window_change (0);
4741 /* Check for data from a process. */
4742 if (no_avail
|| nfds
== 0)
4745 /* Really FIRST_PROC_DESC should be 0 on Unix,
4746 but this is safer in the short run. */
4747 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4749 if (FD_ISSET (channel
, &Available
)
4750 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4754 /* If waiting for this channel, arrange to return as
4755 soon as no more input to be processed. No more
4757 if (wait_channel
== channel
)
4763 proc
= chan_process
[channel
];
4767 /* If this is a server stream socket, accept connection. */
4768 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4770 server_accept_connection (proc
, channel
);
4774 /* Read data from the process, starting with our
4775 buffered-ahead character if we have one. */
4777 nread
= read_process_output (proc
, channel
);
4780 /* Since read_process_output can run a filter,
4781 which can call accept-process-output,
4782 don't try to read from any other processes
4783 before doing the select again. */
4784 FD_ZERO (&Available
);
4787 redisplay_preserve_echo_area (12);
4790 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4793 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4794 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4796 else if (nread
== -1 && errno
== EAGAIN
)
4800 else if (nread
== -1 && errno
== EAGAIN
)
4802 /* Note that we cannot distinguish between no input
4803 available now and a closed pipe.
4804 With luck, a closed pipe will be accompanied by
4805 subprocess termination and SIGCHLD. */
4806 else if (nread
== 0 && !NETCONN_P (proc
))
4808 #endif /* O_NDELAY */
4809 #endif /* O_NONBLOCK */
4811 /* On some OSs with ptys, when the process on one end of
4812 a pty exits, the other end gets an error reading with
4813 errno = EIO instead of getting an EOF (0 bytes read).
4814 Therefore, if we get an error reading and errno =
4815 EIO, just continue, because the child process has
4816 exited and should clean itself up soon (e.g. when we
4819 However, it has been known to happen that the SIGCHLD
4820 got lost. So raise the signl again just in case.
4822 else if (nread
== -1 && errno
== EIO
)
4823 kill (getpid (), SIGCHLD
);
4824 #endif /* HAVE_PTYS */
4825 /* If we can detect process termination, don't consider the process
4826 gone just because its pipe is closed. */
4828 else if (nread
== 0 && !NETCONN_P (proc
))
4833 /* Preserve status of processes already terminated. */
4834 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4835 deactivate_process (proc
);
4836 if (XPROCESS (proc
)->raw_status_new
)
4837 update_status (XPROCESS (proc
));
4838 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4839 XPROCESS (proc
)->status
4840 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4843 #ifdef NON_BLOCKING_CONNECT
4844 if (check_connect
&& FD_ISSET (channel
, &Connecting
)
4845 && FD_ISSET (channel
, &connect_wait_mask
))
4847 struct Lisp_Process
*p
;
4849 FD_CLR (channel
, &connect_wait_mask
);
4850 if (--num_pending_connects
< 0)
4853 proc
= chan_process
[channel
];
4857 p
= XPROCESS (proc
);
4860 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4861 So only use it on systems where it is known to work. */
4863 int xlen
= sizeof(xerrno
);
4864 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4869 struct sockaddr pname
;
4870 int pnamelen
= sizeof(pname
);
4872 /* If connection failed, getpeername will fail. */
4874 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4876 /* Obtain connect failure code through error slippage. */
4879 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4886 XSETINT (p
->tick
, ++process_tick
);
4887 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4888 deactivate_process (proc
);
4893 /* Execute the sentinel here. If we had relied on
4894 status_notify to do it later, it will read input
4895 from the process before calling the sentinel. */
4896 exec_sentinel (proc
, build_string ("open\n"));
4897 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4899 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4900 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4904 #endif /* NON_BLOCKING_CONNECT */
4905 } /* end for each file descriptor */
4906 } /* end while exit conditions not met */
4908 unbind_to (count
, Qnil
);
4910 /* If calling from keyboard input, do not quit
4911 since we want to return C-g as an input character.
4912 Otherwise, do pending quit if requested. */
4915 /* Prevent input_pending from remaining set if we quit. */
4916 clear_input_pending ();
4919 #ifdef POLL_INTERRUPTED_SYS_CALL
4920 /* AlainF 5-Jul-1996
4921 HP-UX 10.10 seems to have problems with signals coming in
4922 Causes "poll: interrupted system call" messages when Emacs is run
4924 Turn periodic alarms back on */
4926 #endif /* POLL_INTERRUPTED_SYS_CALL */
4928 return got_some_input
;
4931 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4934 read_process_output_call (fun_and_args
)
4935 Lisp_Object fun_and_args
;
4937 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4941 read_process_output_error_handler (error
)
4944 cmd_error_internal (error
, "error in process filter: ");
4946 update_echo_area ();
4947 Fsleep_for (make_number (2), Qnil
);
4951 /* Read pending output from the process channel,
4952 starting with our buffered-ahead character if we have one.
4953 Yield number of decoded characters read.
4955 This function reads at most 4096 characters.
4956 If you want to read all available subprocess output,
4957 you must call it repeatedly until it returns zero.
4959 The characters read are decoded according to PROC's coding-system
4963 read_process_output (proc
, channel
)
4965 register int channel
;
4967 register int nbytes
;
4969 register Lisp_Object outstream
;
4970 register struct buffer
*old
= current_buffer
;
4971 register struct Lisp_Process
*p
= XPROCESS (proc
);
4972 register int opoint
;
4973 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4974 int carryover
= XINT (p
->decoding_carryover
);
4978 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4980 vs
= get_vms_process_pointer (p
->pid
);
4984 return (0); /* Really weird if it does this */
4985 if (!(vs
->iosb
[0] & 1))
4986 return -1; /* I/O error */
4989 error ("Could not get VMS process pointer");
4990 chars
= vs
->inputBuffer
;
4991 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4994 start_vms_process_read (vs
); /* Crank up the next read on the process */
4995 return 1; /* Nothing worth printing, say we got 1 */
4999 /* The data carried over in the previous decoding (which are at
5000 the tail of decoding buffer) should be prepended to the new
5001 data read to decode all together. */
5002 chars
= (char *) alloca (nbytes
+ carryover
);
5003 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
5004 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
5008 chars
= (char *) alloca (carryover
+ readmax
);
5010 /* See the comment above. */
5011 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
5013 #ifdef DATAGRAM_SOCKETS
5014 /* We have a working select, so proc_buffered_char is always -1. */
5015 if (DATAGRAM_CHAN_P (channel
))
5017 int len
= datagram_address
[channel
].len
;
5018 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5019 0, datagram_address
[channel
].sa
, &len
);
5023 if (proc_buffered_char
[channel
] < 0)
5025 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
5026 #ifdef ADAPTIVE_READ_BUFFERING
5027 if (nbytes
> 0 && !NILP (p
->adaptive_read_buffering
))
5029 int delay
= XINT (p
->read_output_delay
);
5032 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5035 process_output_delay_count
++;
5036 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5039 else if (delay
> 0 && (nbytes
== readmax
))
5041 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5043 process_output_delay_count
--;
5045 XSETINT (p
->read_output_delay
, delay
);
5048 p
->read_output_skip
= Qt
;
5049 process_output_skip
= 1;
5056 chars
[carryover
] = proc_buffered_char
[channel
];
5057 proc_buffered_char
[channel
] = -1;
5058 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
5062 nbytes
= nbytes
+ 1;
5064 #endif /* not VMS */
5066 XSETINT (p
->decoding_carryover
, 0);
5068 /* At this point, NBYTES holds number of bytes just received
5069 (including the one in proc_buffered_char[channel]). */
5072 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5074 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5077 /* Now set NBYTES how many bytes we must decode. */
5078 nbytes
+= carryover
;
5080 /* Read and dispose of the process output. */
5081 outstream
= p
->filter
;
5082 if (!NILP (outstream
))
5084 /* We inhibit quit here instead of just catching it so that
5085 hitting ^G when a filter happens to be running won't screw
5087 int count
= SPECPDL_INDEX ();
5088 Lisp_Object odeactivate
;
5089 Lisp_Object obuffer
, okeymap
;
5091 int outer_running_asynch_code
= running_asynch_code
;
5092 int waiting
= waiting_for_user_input_p
;
5094 /* No need to gcpro these, because all we do with them later
5095 is test them for EQness, and none of them should be a string. */
5096 odeactivate
= Vdeactivate_mark
;
5097 XSETBUFFER (obuffer
, current_buffer
);
5098 okeymap
= current_buffer
->keymap
;
5100 specbind (Qinhibit_quit
, Qt
);
5101 specbind (Qlast_nonmenu_event
, Qt
);
5103 /* In case we get recursively called,
5104 and we already saved the match data nonrecursively,
5105 save the same match data in safely recursive fashion. */
5106 if (outer_running_asynch_code
)
5109 /* Don't clobber the CURRENT match data, either! */
5110 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5111 restore_search_regs ();
5112 record_unwind_save_match_data ();
5113 Fset_match_data (tem
, Qt
);
5116 /* For speed, if a search happens within this code,
5117 save the match data in a special nonrecursive fashion. */
5118 running_asynch_code
= 1;
5120 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5122 Vlast_coding_system_used
= coding
->symbol
;
5123 /* A new coding system might be found. */
5124 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5126 p
->decode_coding_system
= coding
->symbol
;
5128 /* Don't call setup_coding_system for
5129 proc_decode_coding_system[channel] here. It is done in
5130 detect_coding called via decode_coding above. */
5132 /* If a coding system for encoding is not yet decided, we set
5133 it as the same as coding-system for decoding.
5135 But, before doing that we must check if
5136 proc_encode_coding_system[p->outfd] surely points to a
5137 valid memory because p->outfd will be changed once EOF is
5138 sent to the process. */
5139 if (NILP (p
->encode_coding_system
)
5140 && proc_encode_coding_system
[XINT (p
->outfd
)])
5142 p
->encode_coding_system
= coding
->symbol
;
5143 setup_coding_system (coding
->symbol
,
5144 proc_encode_coding_system
[XINT (p
->outfd
)]);
5145 if (proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5146 == CODING_EOL_UNDECIDED
)
5147 proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5152 carryover
= nbytes
- coding
->consumed
;
5156 if (SCHARS (p
->decoding_buf
) < carryover
)
5157 p
->decoding_buf
= make_uninit_string (carryover
);
5158 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5160 XSETINT (p
->decoding_carryover
, carryover
);
5161 /* Adjust the multibyteness of TEXT to that of the filter. */
5162 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
5163 text
= (STRING_MULTIBYTE (text
)
5164 ? Fstring_as_unibyte (text
)
5165 : Fstring_to_multibyte (text
));
5166 if (SBYTES (text
) > 0)
5167 internal_condition_case_1 (read_process_output_call
,
5169 Fcons (proc
, Fcons (text
, Qnil
))),
5170 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5171 read_process_output_error_handler
);
5173 /* If we saved the match data nonrecursively, restore it now. */
5174 restore_search_regs ();
5175 running_asynch_code
= outer_running_asynch_code
;
5177 /* Handling the process output should not deactivate the mark. */
5178 Vdeactivate_mark
= odeactivate
;
5180 /* Restore waiting_for_user_input_p as it was
5181 when we were called, in case the filter clobbered it. */
5182 waiting_for_user_input_p
= waiting
;
5184 #if 0 /* Call record_asynch_buffer_change unconditionally,
5185 because we might have changed minor modes or other things
5186 that affect key bindings. */
5187 if (! EQ (Fcurrent_buffer (), obuffer
)
5188 || ! EQ (current_buffer
->keymap
, okeymap
))
5190 /* But do it only if the caller is actually going to read events.
5191 Otherwise there's no need to make him wake up, and it could
5192 cause trouble (for example it would make sit_for return). */
5193 if (waiting_for_user_input_p
== -1)
5194 record_asynch_buffer_change ();
5197 start_vms_process_read (vs
);
5199 unbind_to (count
, Qnil
);
5203 /* If no filter, write into buffer if it isn't dead. */
5204 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5206 Lisp_Object old_read_only
;
5207 int old_begv
, old_zv
;
5208 int old_begv_byte
, old_zv_byte
;
5209 Lisp_Object odeactivate
;
5210 int before
, before_byte
;
5215 odeactivate
= Vdeactivate_mark
;
5217 Fset_buffer (p
->buffer
);
5219 opoint_byte
= PT_BYTE
;
5220 old_read_only
= current_buffer
->read_only
;
5223 old_begv_byte
= BEGV_BYTE
;
5224 old_zv_byte
= ZV_BYTE
;
5226 current_buffer
->read_only
= Qnil
;
5228 /* Insert new output into buffer
5229 at the current end-of-output marker,
5230 thus preserving logical ordering of input and output. */
5231 if (XMARKER (p
->mark
)->buffer
)
5232 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5233 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5236 SET_PT_BOTH (ZV
, ZV_BYTE
);
5238 before_byte
= PT_BYTE
;
5240 /* If the output marker is outside of the visible region, save
5241 the restriction and widen. */
5242 if (! (BEGV
<= PT
&& PT
<= ZV
))
5245 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5247 Vlast_coding_system_used
= coding
->symbol
;
5248 /* A new coding system might be found. See the comment in the
5249 similar code in the previous `if' block. */
5250 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5252 p
->decode_coding_system
= coding
->symbol
;
5253 if (NILP (p
->encode_coding_system
)
5254 && proc_encode_coding_system
[XINT (p
->outfd
)])
5256 p
->encode_coding_system
= coding
->symbol
;
5257 setup_coding_system (coding
->symbol
,
5258 proc_encode_coding_system
[XINT (p
->outfd
)]);
5259 if (proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5260 == CODING_EOL_UNDECIDED
)
5261 proc_encode_coding_system
[XINT (p
->outfd
)]->eol_type
5265 carryover
= nbytes
- coding
->consumed
;
5269 if (SCHARS (p
->decoding_buf
) < carryover
)
5270 p
->decoding_buf
= make_uninit_string (carryover
);
5271 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5273 XSETINT (p
->decoding_carryover
, carryover
);
5275 /* Adjust the multibyteness of TEXT to that of the buffer. */
5276 if (NILP (current_buffer
->enable_multibyte_characters
)
5277 != ! STRING_MULTIBYTE (text
))
5278 text
= (STRING_MULTIBYTE (text
)
5279 ? Fstring_as_unibyte (text
)
5280 : Fstring_to_multibyte (text
));
5281 /* Insert before markers in case we are inserting where
5282 the buffer's mark is, and the user's next command is Meta-y. */
5283 insert_from_string_before_markers (text
, 0, 0,
5284 SCHARS (text
), SBYTES (text
), 0);
5286 /* Make sure the process marker's position is valid when the
5287 process buffer is changed in the signal_after_change above.
5288 W3 is known to do that. */
5289 if (BUFFERP (p
->buffer
)
5290 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5291 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5293 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5295 update_mode_lines
++;
5297 /* Make sure opoint and the old restrictions
5298 float ahead of any new text just as point would. */
5299 if (opoint
>= before
)
5301 opoint
+= PT
- before
;
5302 opoint_byte
+= PT_BYTE
- before_byte
;
5304 if (old_begv
> before
)
5306 old_begv
+= PT
- before
;
5307 old_begv_byte
+= PT_BYTE
- before_byte
;
5309 if (old_zv
>= before
)
5311 old_zv
+= PT
- before
;
5312 old_zv_byte
+= PT_BYTE
- before_byte
;
5315 /* If the restriction isn't what it should be, set it. */
5316 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5317 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5319 /* Handling the process output should not deactivate the mark. */
5320 Vdeactivate_mark
= odeactivate
;
5322 current_buffer
->read_only
= old_read_only
;
5323 SET_PT_BOTH (opoint
, opoint_byte
);
5324 set_buffer_internal (old
);
5327 start_vms_process_read (vs
);
5332 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5334 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5335 This is intended for use by asynchronous process output filters and sentinels. */)
5338 return (waiting_for_user_input_p
? Qt
: Qnil
);
5341 /* Sending data to subprocess */
5343 jmp_buf send_process_frame
;
5344 Lisp_Object process_sent_to
;
5347 send_process_trap ()
5349 SIGNAL_THREAD_CHECK (SIGPIPE
);
5354 sigunblock (sigmask (SIGPIPE
));
5355 longjmp (send_process_frame
, 1);
5358 /* Send some data to process PROC.
5359 BUF is the beginning of the data; LEN is the number of characters.
5360 OBJECT is the Lisp object that the data comes from. If OBJECT is
5361 nil or t, it means that the data comes from C string.
5363 If OBJECT is not nil, the data is encoded by PROC's coding-system
5364 for encoding before it is sent.
5366 This function can evaluate Lisp code and can garbage collect. */
5369 send_process (proc
, buf
, len
, object
)
5370 volatile Lisp_Object proc
;
5371 unsigned char *volatile buf
;
5373 volatile Lisp_Object object
;
5375 /* Use volatile to protect variables from being clobbered by longjmp. */
5376 struct Lisp_Process
*p
= XPROCESS (proc
);
5378 struct coding_system
*coding
;
5379 struct gcpro gcpro1
;
5380 SIGTYPE (*volatile old_sigpipe
) ();
5385 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5388 if (p
->raw_status_new
)
5390 if (! EQ (p
->status
, Qrun
))
5391 error ("Process %s not running", SDATA (p
->name
));
5392 if (XINT (p
->outfd
) < 0)
5393 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5395 coding
= proc_encode_coding_system
[XINT (p
->outfd
)];
5396 Vlast_coding_system_used
= coding
->symbol
;
5398 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5399 || (BUFFERP (object
)
5400 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5403 if (!EQ (coding
->symbol
, p
->encode_coding_system
))
5404 /* The coding system for encoding was changed to raw-text
5405 because we sent a unibyte text previously. Now we are
5406 sending a multibyte text, thus we must encode it by the
5407 original coding system specified for the current process. */
5408 setup_coding_system (p
->encode_coding_system
, coding
);
5409 if (coding
->eol_type
== CODING_EOL_UNDECIDED
)
5410 coding
->eol_type
= system_eol_type
;
5411 /* src_multibyte should be set to 1 _after_ a call to
5412 setup_coding_system, since it resets src_multibyte to
5414 coding
->src_multibyte
= 1;
5418 /* For sending a unibyte text, character code conversion should
5419 not take place but EOL conversion should. So, setup raw-text
5420 or one of the subsidiary if we have not yet done it. */
5421 if (coding
->type
!= coding_type_raw_text
)
5423 if (CODING_REQUIRE_FLUSHING (coding
))
5425 /* But, before changing the coding, we must flush out data. */
5426 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5427 send_process (proc
, "", 0, Qt
);
5429 coding
->src_multibyte
= 0;
5430 setup_raw_text_coding_system (coding
);
5433 coding
->dst_multibyte
= 0;
5435 if (CODING_REQUIRE_ENCODING (coding
))
5437 int require
= encoding_buffer_size (coding
, len
);
5438 int from_byte
= -1, from
= -1, to
= -1;
5440 if (BUFFERP (object
))
5442 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5443 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
5444 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
5446 else if (STRINGP (object
))
5448 from_byte
= buf
- SDATA (object
);
5449 from
= string_byte_to_char (object
, from_byte
);
5450 to
= string_byte_to_char (object
, from_byte
+ len
);
5453 if (coding
->composing
!= COMPOSITION_DISABLED
)
5456 coding_save_composition (coding
, from
, to
, object
);
5458 coding
->composing
= COMPOSITION_DISABLED
;
5461 if (SBYTES (p
->encoding_buf
) < require
)
5462 p
->encoding_buf
= make_uninit_string (require
);
5465 buf
= (BUFFERP (object
)
5466 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
5467 : SDATA (object
) + from_byte
);
5469 object
= p
->encoding_buf
;
5470 encode_coding (coding
, (char *) buf
, SDATA (object
),
5471 len
, SBYTES (object
));
5472 coding_free_composition_data (coding
);
5473 len
= coding
->produced
;
5474 buf
= SDATA (object
);
5478 vs
= get_vms_process_pointer (p
->pid
);
5480 error ("Could not find this process: %x", p
->pid
);
5481 else if (write_to_vms_process (vs
, buf
, len
))
5485 if (pty_max_bytes
== 0)
5487 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5488 pty_max_bytes
= fpathconf (XFASTINT (p
->outfd
), _PC_MAX_CANON
);
5489 if (pty_max_bytes
< 0)
5490 pty_max_bytes
= 250;
5492 pty_max_bytes
= 250;
5494 /* Deduct one, to leave space for the eof. */
5498 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5499 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5500 when returning with longjmp despite being declared volatile. */
5501 if (!setjmp (send_process_frame
))
5503 process_sent_to
= proc
;
5508 /* Decide how much data we can send in one batch.
5509 Long lines need to be split into multiple batches. */
5510 if (!NILP (p
->pty_flag
))
5512 /* Starting this at zero is always correct when not the first
5513 iteration because the previous iteration ended by sending C-d.
5514 It may not be correct for the first iteration
5515 if a partial line was sent in a separate send_process call.
5516 If that proves worth handling, we need to save linepos
5517 in the process object. */
5519 unsigned char *ptr
= (unsigned char *) buf
;
5520 unsigned char *end
= (unsigned char *) buf
+ len
;
5522 /* Scan through this text for a line that is too long. */
5523 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5531 /* If we found one, break the line there
5532 and put in a C-d to force the buffer through. */
5536 /* Send this batch, using one or more write calls. */
5539 int outfd
= XINT (p
->outfd
);
5540 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5541 #ifdef DATAGRAM_SOCKETS
5542 if (DATAGRAM_CHAN_P (outfd
))
5544 rv
= sendto (outfd
, (char *) buf
, this,
5545 0, datagram_address
[outfd
].sa
,
5546 datagram_address
[outfd
].len
);
5547 if (rv
< 0 && errno
== EMSGSIZE
)
5549 signal (SIGPIPE
, old_sigpipe
);
5550 report_file_error ("sending datagram",
5551 Fcons (proc
, Qnil
));
5557 rv
= emacs_write (outfd
, (char *) buf
, this);
5558 #ifdef ADAPTIVE_READ_BUFFERING
5559 if (XINT (p
->read_output_delay
) > 0
5560 && EQ (p
->adaptive_read_buffering
, Qt
))
5562 XSETFASTINT (p
->read_output_delay
, 0);
5563 process_output_delay_count
--;
5564 p
->read_output_skip
= Qnil
;
5568 signal (SIGPIPE
, old_sigpipe
);
5574 || errno
== EWOULDBLOCK
5580 /* Buffer is full. Wait, accepting input;
5581 that may allow the program
5582 to finish doing output and read more. */
5586 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5587 /* A gross hack to work around a bug in FreeBSD.
5588 In the following sequence, read(2) returns
5592 write(2) 954 bytes, get EAGAIN
5593 read(2) 1024 bytes in process_read_output
5594 read(2) 11 bytes in process_read_output
5596 That is, read(2) returns more bytes than have
5597 ever been written successfully. The 1033 bytes
5598 read are the 1022 bytes written successfully
5599 after processing (for example with CRs added if
5600 the terminal is set up that way which it is
5601 here). The same bytes will be seen again in a
5602 later read(2), without the CRs. */
5604 if (errno
== EAGAIN
)
5607 ioctl (XINT (p
->outfd
), TIOCFLUSH
, &flags
);
5609 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5611 /* Running filters might relocate buffers or strings.
5612 Arrange to relocate BUF. */
5613 if (BUFFERP (object
))
5614 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5615 else if (STRINGP (object
))
5616 offset
= buf
- SDATA (object
);
5618 #ifdef EMACS_HAS_USECS
5619 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5621 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5624 if (BUFFERP (object
))
5625 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5626 else if (STRINGP (object
))
5627 buf
= offset
+ SDATA (object
);
5632 /* This is a real error. */
5633 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5640 /* If we sent just part of the string, put in an EOF
5641 to force it through, before we send the rest. */
5643 Fprocess_send_eof (proc
);
5646 #endif /* not VMS */
5649 signal (SIGPIPE
, old_sigpipe
);
5651 proc
= process_sent_to
;
5652 p
= XPROCESS (proc
);
5654 p
->raw_status_new
= 0;
5655 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5656 XSETINT (p
->tick
, ++process_tick
);
5657 deactivate_process (proc
);
5659 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5661 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5669 send_process_object_unwind (buf
)
5674 if (XBUFFER (buf
) == current_buffer
)
5676 tembuf
= Fcurrent_buffer ();
5678 Fkill_buffer (tembuf
);
5682 /* Send current contents of region between START and END to PROC.
5683 If START is a string, send it instead.
5684 This function can evaluate Lisp code and can garbage collect. */
5687 send_process_object (proc
, start
, end
)
5688 Lisp_Object proc
, start
, end
;
5690 int count
= SPECPDL_INDEX ();
5691 Lisp_Object object
= STRINGP (start
) ? start
: Fcurrent_buffer ();
5692 struct buffer
*given_buffer
= current_buffer
;
5696 record_unwind_protect (send_process_object_unwind
, Fcurrent_buffer ());
5698 if (STRINGP (object
) ? STRING_MULTIBYTE (object
)
5699 : ! NILP (XBUFFER (object
)->enable_multibyte_characters
))
5701 struct Lisp_Process
*p
= XPROCESS (proc
);
5702 struct coding_system
*coding
;
5704 if (p
->raw_status_new
)
5706 if (! EQ (p
->status
, Qrun
))
5707 error ("Process %s not running", SDATA (p
->name
));
5708 if (XINT (p
->outfd
) < 0)
5709 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5711 coding
= proc_encode_coding_system
[XINT (p
->outfd
)];
5712 if (! EQ (coding
->symbol
, p
->encode_coding_system
))
5713 /* The coding system for encoding was changed to raw-text
5714 because we sent a unibyte text previously. Now we are
5715 sending a multibyte text, thus we must encode it by the
5716 original coding system specified for the current process. */
5717 setup_coding_system (p
->encode_coding_system
, coding
);
5718 if (! NILP (coding
->pre_write_conversion
))
5720 struct gcpro gcpro1
, gcpro2
;
5722 GCPRO2 (proc
, object
);
5723 call2 (coding
->pre_write_conversion
, start
, end
);
5725 if (given_buffer
!= current_buffer
)
5727 start
= make_number (BEGV
), end
= make_number (ZV
);
5728 object
= Fcurrent_buffer ();
5733 if (BUFFERP (object
))
5735 EMACS_INT start_byte
;
5737 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5738 move_gap (XINT (end
));
5739 start_byte
= CHAR_TO_BYTE (XINT (start
));
5740 buf
= BYTE_POS_ADDR (start_byte
);
5741 len
= CHAR_TO_BYTE (XINT (end
)) - start_byte
;
5745 buf
= SDATA (object
);
5746 len
= SBYTES (object
);
5748 send_process (proc
, buf
, len
, object
);
5750 unbind_to (count
, Qnil
);
5753 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5755 doc
: /* Send current contents of region as input to PROCESS.
5756 PROCESS may be a process, a buffer, the name of a process or buffer, or
5757 nil, indicating the current buffer's process.
5758 Called from program, takes three arguments, PROCESS, START and END.
5759 If the region is more than 500 characters long,
5760 it is sent in several bunches. This may happen even for shorter regions.
5761 Output from processes can arrive in between bunches. */)
5762 (process
, start
, end
)
5763 Lisp_Object process
, start
, end
;
5767 proc
= get_process (process
);
5768 validate_region (&start
, &end
);
5769 send_process_object (proc
, start
, end
);
5773 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5775 doc
: /* Send PROCESS the contents of STRING as input.
5776 PROCESS may be a process, a buffer, the name of a process or buffer, or
5777 nil, indicating the current buffer's process.
5778 If STRING is more than 500 characters long,
5779 it is sent in several bunches. This may happen even for shorter strings.
5780 Output from processes can arrive in between bunches. */)
5782 Lisp_Object process
, string
;
5785 CHECK_STRING (string
);
5786 proc
= get_process (process
);
5787 send_process_object (proc
, string
, Qnil
);
5791 /* Return the foreground process group for the tty/pty that
5792 the process P uses. */
5794 emacs_get_tty_pgrp (p
)
5795 struct Lisp_Process
*p
;
5800 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5803 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5804 master side. Try the slave side. */
5805 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5809 ioctl (fd
, TIOCGPGRP
, &gid
);
5813 #endif /* defined (TIOCGPGRP ) */
5818 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5819 Sprocess_running_child_p
, 0, 1, 0,
5820 doc
: /* Return t if PROCESS has given the terminal to a child.
5821 If the operating system does not make it possible to find out,
5822 return t unconditionally. */)
5824 Lisp_Object process
;
5826 /* Initialize in case ioctl doesn't exist or gives an error,
5827 in a way that will cause returning t. */
5830 struct Lisp_Process
*p
;
5832 proc
= get_process (process
);
5833 p
= XPROCESS (proc
);
5835 if (!EQ (p
->childp
, Qt
))
5836 error ("Process %s is not a subprocess",
5838 if (XINT (p
->infd
) < 0)
5839 error ("Process %s is not active",
5842 gid
= emacs_get_tty_pgrp (p
);
5849 /* send a signal number SIGNO to PROCESS.
5850 If CURRENT_GROUP is t, that means send to the process group
5851 that currently owns the terminal being used to communicate with PROCESS.
5852 This is used for various commands in shell mode.
5853 If CURRENT_GROUP is lambda, that means send to the process group
5854 that currently owns the terminal, but only if it is NOT the shell itself.
5856 If NOMSG is zero, insert signal-announcements into process's buffers
5859 If we can, we try to signal PROCESS by sending control characters
5860 down the pty. This allows us to signal inferiors who have changed
5861 their uid, for which killpg would return an EPERM error. */
5864 process_send_signal (process
, signo
, current_group
, nomsg
)
5865 Lisp_Object process
;
5867 Lisp_Object current_group
;
5871 register struct Lisp_Process
*p
;
5875 proc
= get_process (process
);
5876 p
= XPROCESS (proc
);
5878 if (!EQ (p
->childp
, Qt
))
5879 error ("Process %s is not a subprocess",
5881 if (XINT (p
->infd
) < 0)
5882 error ("Process %s is not active",
5885 if (NILP (p
->pty_flag
))
5886 current_group
= Qnil
;
5888 /* If we are using pgrps, get a pgrp number and make it negative. */
5889 if (NILP (current_group
))
5890 /* Send the signal to the shell's process group. */
5894 #ifdef SIGNALS_VIA_CHARACTERS
5895 /* If possible, send signals to the entire pgrp
5896 by sending an input character to it. */
5898 /* TERMIOS is the latest and bestest, and seems most likely to
5899 work. If the system has it, use it. */
5902 cc_t
*sig_char
= NULL
;
5904 tcgetattr (XINT (p
->infd
), &t
);
5909 sig_char
= &t
.c_cc
[VINTR
];
5913 sig_char
= &t
.c_cc
[VQUIT
];
5917 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5918 sig_char
= &t
.c_cc
[VSWTCH
];
5920 sig_char
= &t
.c_cc
[VSUSP
];
5925 if (sig_char
&& *sig_char
!= CDISABLE
)
5927 send_process (proc
, sig_char
, 1, Qnil
);
5930 /* If we can't send the signal with a character,
5931 fall through and send it another way. */
5932 #else /* ! HAVE_TERMIOS */
5934 /* On Berkeley descendants, the following IOCTL's retrieve the
5935 current control characters. */
5936 #if defined (TIOCGLTC) && defined (TIOCGETC)
5944 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5945 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5948 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5949 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5953 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5954 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5956 #endif /* ! defined (SIGTSTP) */
5959 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5961 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5968 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5969 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5972 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5973 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5977 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5978 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5980 #endif /* ! defined (SIGTSTP) */
5982 #else /* ! defined (TCGETA) */
5983 Your configuration files are messed up
.
5984 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5985 you'd better be using one of the alternatives above! */
5986 #endif /* ! defined (TCGETA) */
5987 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5988 /* In this case, the code above should alway returns. */
5990 #endif /* ! defined HAVE_TERMIOS */
5992 /* The code above may fall through if it can't
5993 handle the signal. */
5994 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5997 /* Get the current pgrp using the tty itself, if we have that.
5998 Otherwise, use the pty to get the pgrp.
5999 On pfa systems, saka@pfu.fujitsu.co.JP writes:
6000 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
6001 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
6002 His patch indicates that if TIOCGPGRP returns an error, then
6003 we should just assume that p->pid is also the process group id. */
6005 gid
= emacs_get_tty_pgrp (p
);
6008 /* If we can't get the information, assume
6009 the shell owns the tty. */
6012 /* It is not clear whether anything really can set GID to -1.
6013 Perhaps on some system one of those ioctls can or could do so.
6014 Or perhaps this is vestigial. */
6017 #else /* ! defined (TIOCGPGRP ) */
6018 /* Can't select pgrps on this system, so we know that
6019 the child itself heads the pgrp. */
6021 #endif /* ! defined (TIOCGPGRP ) */
6023 /* If current_group is lambda, and the shell owns the terminal,
6024 don't send any signal. */
6025 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
6033 p
->raw_status_new
= 0;
6035 XSETINT (p
->tick
, ++process_tick
);
6037 status_notify (NULL
);
6039 #endif /* ! defined (SIGCONT) */
6042 send_process (proc
, "\003", 1, Qnil
); /* ^C */
6047 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
6052 sys$
forcex (&(p
->pid
), 0, 1);
6055 flush_pending_output (XINT (p
->infd
));
6059 /* If we don't have process groups, send the signal to the immediate
6060 subprocess. That isn't really right, but it's better than any
6061 obvious alternative. */
6064 kill (p
->pid
, signo
);
6068 /* gid may be a pid, or minus a pgrp's number */
6070 if (!NILP (current_group
))
6072 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
6073 EMACS_KILLPG (gid
, signo
);
6080 #else /* ! defined (TIOCSIGSEND) */
6081 EMACS_KILLPG (gid
, signo
);
6082 #endif /* ! defined (TIOCSIGSEND) */
6085 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
6086 doc
: /* Interrupt process PROCESS.
6087 PROCESS may be a process, a buffer, or the name of a process or buffer.
6088 No arg or nil means current buffer's process.
6089 Second arg CURRENT-GROUP non-nil means send signal to
6090 the current process-group of the process's controlling terminal
6091 rather than to the process's own process group.
6092 If the process is a shell, this means interrupt current subjob
6093 rather than the shell.
6095 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6096 don't send the signal. */)
6097 (process
, current_group
)
6098 Lisp_Object process
, current_group
;
6100 process_send_signal (process
, SIGINT
, current_group
, 0);
6104 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
6105 doc
: /* Kill process PROCESS. May be process or name of one.
6106 See function `interrupt-process' for more details on usage. */)
6107 (process
, current_group
)
6108 Lisp_Object process
, current_group
;
6110 process_send_signal (process
, SIGKILL
, current_group
, 0);
6114 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
6115 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
6116 See function `interrupt-process' for more details on usage. */)
6117 (process
, current_group
)
6118 Lisp_Object process
, current_group
;
6120 process_send_signal (process
, SIGQUIT
, current_group
, 0);
6124 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
6125 doc
: /* Stop process PROCESS. May be process or name of one.
6126 See function `interrupt-process' for more details on usage.
6127 If PROCESS is a network process, inhibit handling of incoming traffic. */)
6128 (process
, current_group
)
6129 Lisp_Object process
, current_group
;
6132 if (PROCESSP (process
) && NETCONN_P (process
))
6134 struct Lisp_Process
*p
;
6136 p
= XPROCESS (process
);
6137 if (NILP (p
->command
)
6138 && XINT (p
->infd
) >= 0)
6140 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6141 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6148 error ("No SIGTSTP support");
6150 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6155 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6156 doc
: /* Continue process PROCESS. May be process or name of one.
6157 See function `interrupt-process' for more details on usage.
6158 If PROCESS is a network process, resume handling of incoming traffic. */)
6159 (process
, current_group
)
6160 Lisp_Object process
, current_group
;
6163 if (PROCESSP (process
) && NETCONN_P (process
))
6165 struct Lisp_Process
*p
;
6167 p
= XPROCESS (process
);
6168 if (EQ (p
->command
, Qt
)
6169 && XINT (p
->infd
) >= 0
6170 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6172 FD_SET (XINT (p
->infd
), &input_wait_mask
);
6173 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
6180 process_send_signal (process
, SIGCONT
, current_group
, 0);
6182 error ("No SIGCONT support");
6187 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6188 2, 2, "sProcess (name or number): \nnSignal code: ",
6189 doc
: /* Send PROCESS the signal with code SIGCODE.
6190 PROCESS may also be a number specifying the process id of the
6191 process to signal; in this case, the process need not be a child of
6193 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6195 Lisp_Object process
, sigcode
;
6199 if (INTEGERP (process
))
6201 pid
= XINT (process
);
6205 if (FLOATP (process
))
6207 pid
= (pid_t
) XFLOAT_DATA (process
);
6211 if (STRINGP (process
))
6214 if (tem
= Fget_process (process
), NILP (tem
))
6216 pid
= XINT (Fstring_to_number (process
, make_number (10)));
6223 process
= get_process (process
);
6228 CHECK_PROCESS (process
);
6229 pid
= XPROCESS (process
)->pid
;
6231 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6235 #define parse_signal(NAME, VALUE) \
6236 else if (!xstricmp (name, NAME)) \
6237 XSETINT (sigcode, VALUE)
6239 if (INTEGERP (sigcode
))
6243 unsigned char *name
;
6245 CHECK_SYMBOL (sigcode
);
6246 name
= SDATA (SYMBOL_NAME (sigcode
));
6248 if (!strncmp(name
, "SIG", 3) || !strncmp(name
, "sig", 3))
6254 parse_signal ("usr1", SIGUSR1
);
6257 parse_signal ("usr2", SIGUSR2
);
6260 parse_signal ("term", SIGTERM
);
6263 parse_signal ("hup", SIGHUP
);
6266 parse_signal ("int", SIGINT
);
6269 parse_signal ("quit", SIGQUIT
);
6272 parse_signal ("ill", SIGILL
);
6275 parse_signal ("abrt", SIGABRT
);
6278 parse_signal ("emt", SIGEMT
);
6281 parse_signal ("kill", SIGKILL
);
6284 parse_signal ("fpe", SIGFPE
);
6287 parse_signal ("bus", SIGBUS
);
6290 parse_signal ("segv", SIGSEGV
);
6293 parse_signal ("sys", SIGSYS
);
6296 parse_signal ("pipe", SIGPIPE
);
6299 parse_signal ("alrm", SIGALRM
);
6302 parse_signal ("urg", SIGURG
);
6305 parse_signal ("stop", SIGSTOP
);
6308 parse_signal ("tstp", SIGTSTP
);
6311 parse_signal ("cont", SIGCONT
);
6314 parse_signal ("chld", SIGCHLD
);
6317 parse_signal ("ttin", SIGTTIN
);
6320 parse_signal ("ttou", SIGTTOU
);
6323 parse_signal ("io", SIGIO
);
6326 parse_signal ("xcpu", SIGXCPU
);
6329 parse_signal ("xfsz", SIGXFSZ
);
6332 parse_signal ("vtalrm", SIGVTALRM
);
6335 parse_signal ("prof", SIGPROF
);
6338 parse_signal ("winch", SIGWINCH
);
6341 parse_signal ("info", SIGINFO
);
6344 error ("Undefined signal name %s", name
);
6349 return make_number (kill (pid
, XINT (sigcode
)));
6352 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6353 doc
: /* Make PROCESS see end-of-file in its input.
6354 EOF comes after any text already sent to it.
6355 PROCESS may be a process, a buffer, the name of a process or buffer, or
6356 nil, indicating the current buffer's process.
6357 If PROCESS is a network connection, or is a process communicating
6358 through a pipe (as opposed to a pty), then you cannot send any more
6359 text to PROCESS after you call this function. */)
6361 Lisp_Object process
;
6364 struct coding_system
*coding
;
6366 if (DATAGRAM_CONN_P (process
))
6369 proc
= get_process (process
);
6370 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
6372 /* Make sure the process is really alive. */
6373 if (XPROCESS (proc
)->raw_status_new
)
6374 update_status (XPROCESS (proc
));
6375 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6376 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6378 if (CODING_REQUIRE_FLUSHING (coding
))
6380 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6381 send_process (proc
, "", 0, Qnil
);
6385 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6387 if (!NILP (XPROCESS (proc
)->pty_flag
))
6388 send_process (proc
, "\004", 1, Qnil
);
6391 int old_outfd
, new_outfd
;
6393 #ifdef HAVE_SHUTDOWN
6394 /* If this is a network connection, or socketpair is used
6395 for communication with the subprocess, call shutdown to cause EOF.
6396 (In some old system, shutdown to socketpair doesn't work.
6397 Then we just can't win.) */
6398 if (XPROCESS (proc
)->pid
== 0
6399 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
6400 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
6401 /* In case of socketpair, outfd == infd, so don't close it. */
6402 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
6403 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6404 #else /* not HAVE_SHUTDOWN */
6405 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6406 #endif /* not HAVE_SHUTDOWN */
6407 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6410 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
6412 if (!proc_encode_coding_system
[new_outfd
])
6413 proc_encode_coding_system
[new_outfd
]
6414 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6415 bcopy (proc_encode_coding_system
[old_outfd
],
6416 proc_encode_coding_system
[new_outfd
],
6417 sizeof (struct coding_system
));
6418 bzero (proc_encode_coding_system
[old_outfd
],
6419 sizeof (struct coding_system
));
6421 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
6427 /* Kill all processes associated with `buffer'.
6428 If `buffer' is nil, kill all processes */
6431 kill_buffer_processes (buffer
)
6434 Lisp_Object tail
, proc
;
6436 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6438 proc
= XCDR (XCAR (tail
));
6439 if (GC_PROCESSP (proc
)
6440 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6442 if (NETCONN_P (proc
))
6443 Fdelete_process (proc
);
6444 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
6445 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6450 /* On receipt of a signal that a child status has changed, loop asking
6451 about children with changed statuses until the system says there
6454 All we do is change the status; we do not run sentinels or print
6455 notifications. That is saved for the next time keyboard input is
6456 done, in order to avoid timing errors.
6458 ** WARNING: this can be called during garbage collection.
6459 Therefore, it must not be fooled by the presence of mark bits in
6462 ** USG WARNING: Although it is not obvious from the documentation
6463 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6464 signal() before executing at least one wait(), otherwise the
6465 handler will be called again, resulting in an infinite loop. The
6466 relevant portion of the documentation reads "SIGCLD signals will be
6467 queued and the signal-catching function will be continually
6468 reentered until the queue is empty". Invoking signal() causes the
6469 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6472 ** Malloc WARNING: This should never call malloc either directly or
6473 indirectly; if it does, that is a bug */
6477 sigchld_handler (signo
)
6480 int old_errno
= errno
;
6482 register struct Lisp_Process
*p
;
6483 extern EMACS_TIME
*input_available_clear_time
;
6485 SIGNAL_THREAD_CHECK (signo
);
6489 sigheld
|= sigbit (SIGCHLD
);
6501 #endif /* no WUNTRACED */
6502 /* Keep trying to get a status until we get a definitive result. */
6505 /* For some reason, this sleep() prevents Emacs from sending
6506 loadavg to 5-8(!) for ~10 seconds.
6507 See http://thread.gmane.org/gmane.emacs.devel/67722 or
6508 http://www.google.com/search?q=busyloop+in+sigchld_handler */
6511 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6513 while (pid
< 0 && errno
== EINTR
);
6517 /* PID == 0 means no processes found, PID == -1 means a real
6518 failure. We have done all our job, so return. */
6520 /* USG systems forget handlers when they are used;
6521 must reestablish each time */
6522 #if defined (USG) && !defined (POSIX_SIGNALS)
6523 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6526 sigheld
&= ~sigbit (SIGCHLD
);
6534 #endif /* no WNOHANG */
6536 /* Find the process that signaled us, and record its status. */
6538 /* The process can have been deleted by Fdelete_process. */
6539 for (tail
= deleted_pid_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
6541 Lisp_Object xpid
= XCAR (tail
);
6542 if ((GC_INTEGERP (xpid
) && pid
== (pid_t
) XINT (xpid
))
6543 || (GC_FLOATP (xpid
) && pid
== (pid_t
) XFLOAT_DATA (xpid
)))
6545 XSETCAR (tail
, Qnil
);
6546 goto sigchld_end_of_loop
;
6550 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6552 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6554 proc
= XCDR (XCAR (tail
));
6555 p
= XPROCESS (proc
);
6556 if (GC_EQ (p
->childp
, Qt
) && p
->pid
== pid
)
6561 /* Look for an asynchronous process whose pid hasn't been filled
6564 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6566 proc
= XCDR (XCAR (tail
));
6567 p
= XPROCESS (proc
);
6573 /* Change the status of the process that was found. */
6576 union { int i
; WAITTYPE wt
; } u
;
6577 int clear_desc_flag
= 0;
6579 XSETINT (p
->tick
, ++process_tick
);
6581 p
->raw_status
= u
.i
;
6582 p
->raw_status_new
= 1;
6584 /* If process has terminated, stop waiting for its output. */
6585 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6586 && XINT (p
->infd
) >= 0)
6587 clear_desc_flag
= 1;
6589 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6590 if (clear_desc_flag
)
6592 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6593 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6596 /* Tell wait_reading_process_output that it needs to wake up and
6598 if (input_available_clear_time
)
6599 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6602 /* There was no asynchronous process found for that pid: we have
6603 a synchronous process. */
6606 synch_process_alive
= 0;
6608 /* Report the status of the synchronous process. */
6610 synch_process_retcode
= WRETCODE (w
);
6611 else if (WIFSIGNALED (w
))
6612 synch_process_termsig
= WTERMSIG (w
);
6614 /* Tell wait_reading_process_output that it needs to wake up and
6616 if (input_available_clear_time
)
6617 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6620 sigchld_end_of_loop
:
6623 /* On some systems, we must return right away.
6624 If any more processes want to signal us, we will
6626 Otherwise (on systems that have WNOHANG), loop around
6627 to use up all the processes that have something to tell us. */
6628 #if (defined WINDOWSNT \
6629 || (defined USG && !defined GNU_LINUX \
6630 && !(defined HPUX && defined WNOHANG)))
6631 #if defined (USG) && ! defined (POSIX_SIGNALS)
6632 signal (signo
, sigchld_handler
);
6636 #endif /* USG, but not HPUX with WNOHANG */
6639 #endif /* SIGCHLD */
6643 exec_sentinel_unwind (data
)
6646 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6651 exec_sentinel_error_handler (error
)
6654 cmd_error_internal (error
, "error in process sentinel: ");
6656 update_echo_area ();
6657 Fsleep_for (make_number (2), Qnil
);
6662 exec_sentinel (proc
, reason
)
6663 Lisp_Object proc
, reason
;
6665 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6666 register struct Lisp_Process
*p
= XPROCESS (proc
);
6667 int count
= SPECPDL_INDEX ();
6668 int outer_running_asynch_code
= running_asynch_code
;
6669 int waiting
= waiting_for_user_input_p
;
6671 if (inhibit_sentinels
)
6674 /* No need to gcpro these, because all we do with them later
6675 is test them for EQness, and none of them should be a string. */
6676 odeactivate
= Vdeactivate_mark
;
6677 XSETBUFFER (obuffer
, current_buffer
);
6678 okeymap
= current_buffer
->keymap
;
6680 sentinel
= p
->sentinel
;
6681 if (NILP (sentinel
))
6684 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6685 assure that it gets restored no matter how the sentinel exits. */
6687 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6688 /* Inhibit quit so that random quits don't screw up a running filter. */
6689 specbind (Qinhibit_quit
, Qt
);
6690 specbind (Qlast_nonmenu_event
, Qt
);
6692 /* In case we get recursively called,
6693 and we already saved the match data nonrecursively,
6694 save the same match data in safely recursive fashion. */
6695 if (outer_running_asynch_code
)
6698 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6699 restore_search_regs ();
6700 record_unwind_save_match_data ();
6701 Fset_match_data (tem
, Qt
);
6704 /* For speed, if a search happens within this code,
6705 save the match data in a special nonrecursive fashion. */
6706 running_asynch_code
= 1;
6708 internal_condition_case_1 (read_process_output_call
,
6710 Fcons (proc
, Fcons (reason
, Qnil
))),
6711 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6712 exec_sentinel_error_handler
);
6714 /* If we saved the match data nonrecursively, restore it now. */
6715 restore_search_regs ();
6716 running_asynch_code
= outer_running_asynch_code
;
6718 Vdeactivate_mark
= odeactivate
;
6720 /* Restore waiting_for_user_input_p as it was
6721 when we were called, in case the filter clobbered it. */
6722 waiting_for_user_input_p
= waiting
;
6725 if (! EQ (Fcurrent_buffer (), obuffer
)
6726 || ! EQ (current_buffer
->keymap
, okeymap
))
6728 /* But do it only if the caller is actually going to read events.
6729 Otherwise there's no need to make him wake up, and it could
6730 cause trouble (for example it would make sit_for return). */
6731 if (waiting_for_user_input_p
== -1)
6732 record_asynch_buffer_change ();
6734 unbind_to (count
, Qnil
);
6737 /* Report all recent events of a change in process status
6738 (either run the sentinel or output a message).
6739 This is usually done while Emacs is waiting for keyboard input
6740 but can be done at other times. */
6743 status_notify (deleting_process
)
6744 struct Lisp_Process
*deleting_process
;
6746 register Lisp_Object proc
, buffer
;
6747 Lisp_Object tail
, msg
;
6748 struct gcpro gcpro1
, gcpro2
;
6752 /* We need to gcpro tail; if read_process_output calls a filter
6753 which deletes a process and removes the cons to which tail points
6754 from Vprocess_alist, and then causes a GC, tail is an unprotected
6758 /* Set this now, so that if new processes are created by sentinels
6759 that we run, we get called again to handle their status changes. */
6760 update_tick
= process_tick
;
6762 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6765 register struct Lisp_Process
*p
;
6767 proc
= Fcdr (Fcar (tail
));
6768 p
= XPROCESS (proc
);
6770 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6772 XSETINT (p
->update_tick
, XINT (p
->tick
));
6774 /* If process is still active, read any output that remains. */
6775 while (! EQ (p
->filter
, Qt
)
6776 && ! EQ (p
->status
, Qconnect
)
6777 && ! EQ (p
->status
, Qlisten
)
6778 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6779 && XINT (p
->infd
) >= 0
6780 && p
!= deleting_process
6781 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6785 /* Get the text to use for the message. */
6786 if (p
->raw_status_new
)
6788 msg
= status_message (p
);
6790 /* If process is terminated, deactivate it or delete it. */
6792 if (CONSP (p
->status
))
6793 symbol
= XCAR (p
->status
);
6795 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6796 || EQ (symbol
, Qclosed
))
6798 if (delete_exited_processes
)
6799 remove_process (proc
);
6801 deactivate_process (proc
);
6804 /* The actions above may have further incremented p->tick.
6805 So set p->update_tick again
6806 so that an error in the sentinel will not cause
6807 this code to be run again. */
6808 XSETINT (p
->update_tick
, XINT (p
->tick
));
6809 /* Now output the message suitably. */
6810 if (!NILP (p
->sentinel
))
6811 exec_sentinel (proc
, msg
);
6812 /* Don't bother with a message in the buffer
6813 when a process becomes runnable. */
6814 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6816 Lisp_Object ro
, tem
;
6817 struct buffer
*old
= current_buffer
;
6818 int opoint
, opoint_byte
;
6819 int before
, before_byte
;
6821 ro
= XBUFFER (buffer
)->read_only
;
6823 /* Avoid error if buffer is deleted
6824 (probably that's why the process is dead, too) */
6825 if (NILP (XBUFFER (buffer
)->name
))
6827 Fset_buffer (buffer
);
6830 opoint_byte
= PT_BYTE
;
6831 /* Insert new output into buffer
6832 at the current end-of-output marker,
6833 thus preserving logical ordering of input and output. */
6834 if (XMARKER (p
->mark
)->buffer
)
6835 Fgoto_char (p
->mark
);
6837 SET_PT_BOTH (ZV
, ZV_BYTE
);
6840 before_byte
= PT_BYTE
;
6842 tem
= current_buffer
->read_only
;
6843 current_buffer
->read_only
= Qnil
;
6844 insert_string ("\nProcess ");
6845 Finsert (1, &p
->name
);
6846 insert_string (" ");
6848 current_buffer
->read_only
= tem
;
6849 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6851 if (opoint
>= before
)
6852 SET_PT_BOTH (opoint
+ (PT
- before
),
6853 opoint_byte
+ (PT_BYTE
- before_byte
));
6855 SET_PT_BOTH (opoint
, opoint_byte
);
6857 set_buffer_internal (old
);
6862 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6863 redisplay_preserve_echo_area (13);
6869 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6870 Sset_process_coding_system
, 1, 3, 0,
6871 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6872 DECODING will be used to decode subprocess output and ENCODING to
6873 encode subprocess input. */)
6874 (process
, decoding
, encoding
)
6875 register Lisp_Object process
, decoding
, encoding
;
6877 register struct Lisp_Process
*p
;
6879 CHECK_PROCESS (process
);
6880 p
= XPROCESS (process
);
6881 if (XINT (p
->infd
) < 0)
6882 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6883 if (XINT (p
->outfd
) < 0)
6884 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6885 Fcheck_coding_system (decoding
);
6886 Fcheck_coding_system (encoding
);
6888 p
->decode_coding_system
= decoding
;
6889 p
->encode_coding_system
= encoding
;
6890 setup_process_coding_systems (process
);
6895 DEFUN ("process-coding-system",
6896 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6897 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6899 register Lisp_Object process
;
6901 CHECK_PROCESS (process
);
6902 return Fcons (XPROCESS (process
)->decode_coding_system
,
6903 XPROCESS (process
)->encode_coding_system
);
6906 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6907 Sset_process_filter_multibyte
, 2, 2, 0,
6908 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6909 If FLAG is non-nil, the filter is given multibyte strings.
6910 If FLAG is nil, the filter is given unibyte strings. In this case,
6911 all character code conversion except for end-of-line conversion is
6914 Lisp_Object process
, flag
;
6916 register struct Lisp_Process
*p
;
6918 CHECK_PROCESS (process
);
6919 p
= XPROCESS (process
);
6920 p
->filter_multibyte
= flag
;
6921 setup_process_coding_systems (process
);
6926 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6927 Sprocess_filter_multibyte_p
, 1, 1, 0,
6928 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6930 Lisp_Object process
;
6932 register struct Lisp_Process
*p
;
6934 CHECK_PROCESS (process
);
6935 p
= XPROCESS (process
);
6937 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6942 /* The first time this is called, assume keyboard input comes from DESC
6943 instead of from where we used to expect it.
6944 Subsequent calls mean assume input keyboard can come from DESC
6945 in addition to other places. */
6947 static int add_keyboard_wait_descriptor_called_flag
;
6950 add_keyboard_wait_descriptor (desc
)
6953 if (! add_keyboard_wait_descriptor_called_flag
)
6954 FD_CLR (0, &input_wait_mask
);
6955 add_keyboard_wait_descriptor_called_flag
= 1;
6956 FD_SET (desc
, &input_wait_mask
);
6957 FD_SET (desc
, &non_process_wait_mask
);
6958 if (desc
> max_keyboard_desc
)
6959 max_keyboard_desc
= desc
;
6962 /* From now on, do not expect DESC to give keyboard input. */
6965 delete_keyboard_wait_descriptor (desc
)
6969 int lim
= max_keyboard_desc
;
6971 FD_CLR (desc
, &input_wait_mask
);
6972 FD_CLR (desc
, &non_process_wait_mask
);
6974 if (desc
== max_keyboard_desc
)
6975 for (fd
= 0; fd
< lim
; fd
++)
6976 if (FD_ISSET (fd
, &input_wait_mask
)
6977 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6978 max_keyboard_desc
= fd
;
6981 /* Return nonzero if *MASK has a bit set
6982 that corresponds to one of the keyboard input descriptors. */
6985 keyboard_bit_set (mask
)
6990 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6991 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6992 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
7003 inhibit_sentinels
= 0;
7007 if (! noninteractive
|| initialized
)
7009 signal (SIGCHLD
, sigchld_handler
);
7012 FD_ZERO (&input_wait_mask
);
7013 FD_ZERO (&non_keyboard_wait_mask
);
7014 FD_ZERO (&non_process_wait_mask
);
7015 max_process_desc
= 0;
7017 #ifdef NON_BLOCKING_CONNECT
7018 FD_ZERO (&connect_wait_mask
);
7019 num_pending_connects
= 0;
7022 #ifdef ADAPTIVE_READ_BUFFERING
7023 process_output_delay_count
= 0;
7024 process_output_skip
= 0;
7027 FD_SET (0, &input_wait_mask
);
7029 Vprocess_alist
= Qnil
;
7031 deleted_pid_list
= Qnil
;
7033 for (i
= 0; i
< MAXDESC
; i
++)
7035 chan_process
[i
] = Qnil
;
7036 proc_buffered_char
[i
] = -1;
7038 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
7039 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
7040 #ifdef DATAGRAM_SOCKETS
7041 bzero (datagram_address
, sizeof datagram_address
);
7046 Lisp_Object subfeatures
= Qnil
;
7047 struct socket_options
*sopt
;
7049 #define ADD_SUBFEATURE(key, val) \
7050 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
7052 #ifdef NON_BLOCKING_CONNECT
7053 ADD_SUBFEATURE (QCnowait
, Qt
);
7055 #ifdef DATAGRAM_SOCKETS
7056 ADD_SUBFEATURE (QCtype
, Qdatagram
);
7058 #ifdef HAVE_LOCAL_SOCKETS
7059 ADD_SUBFEATURE (QCfamily
, Qlocal
);
7061 ADD_SUBFEATURE (QCfamily
, Qipv4
);
7063 ADD_SUBFEATURE (QCfamily
, Qipv6
);
7065 #ifdef HAVE_GETSOCKNAME
7066 ADD_SUBFEATURE (QCservice
, Qt
);
7068 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
7069 ADD_SUBFEATURE (QCserver
, Qt
);
7072 for (sopt
= socket_options
; sopt
->name
; sopt
++)
7073 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
7075 Fprovide (intern ("make-network-process"), subfeatures
);
7077 #endif /* HAVE_SOCKETS */
7079 #if defined (DARWIN) || defined (MAC_OSX)
7080 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7081 processes. As such, we only change the default value. */
7084 char *release
= get_operating_system_release();
7085 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
7086 && release
[1] == '.')) {
7087 Vprocess_connection_type
= Qnil
;
7096 Qprocessp
= intern ("processp");
7097 staticpro (&Qprocessp
);
7098 Qrun
= intern ("run");
7100 Qstop
= intern ("stop");
7102 Qsignal
= intern ("signal");
7103 staticpro (&Qsignal
);
7105 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7108 Qexit = intern ("exit");
7109 staticpro (&Qexit); */
7111 Qopen
= intern ("open");
7113 Qclosed
= intern ("closed");
7114 staticpro (&Qclosed
);
7115 Qconnect
= intern ("connect");
7116 staticpro (&Qconnect
);
7117 Qfailed
= intern ("failed");
7118 staticpro (&Qfailed
);
7119 Qlisten
= intern ("listen");
7120 staticpro (&Qlisten
);
7121 Qlocal
= intern ("local");
7122 staticpro (&Qlocal
);
7123 Qipv4
= intern ("ipv4");
7126 Qipv6
= intern ("ipv6");
7129 Qdatagram
= intern ("datagram");
7130 staticpro (&Qdatagram
);
7132 QCname
= intern (":name");
7133 staticpro (&QCname
);
7134 QCbuffer
= intern (":buffer");
7135 staticpro (&QCbuffer
);
7136 QChost
= intern (":host");
7137 staticpro (&QChost
);
7138 QCservice
= intern (":service");
7139 staticpro (&QCservice
);
7140 QCtype
= intern (":type");
7141 staticpro (&QCtype
);
7142 QClocal
= intern (":local");
7143 staticpro (&QClocal
);
7144 QCremote
= intern (":remote");
7145 staticpro (&QCremote
);
7146 QCcoding
= intern (":coding");
7147 staticpro (&QCcoding
);
7148 QCserver
= intern (":server");
7149 staticpro (&QCserver
);
7150 QCnowait
= intern (":nowait");
7151 staticpro (&QCnowait
);
7152 QCsentinel
= intern (":sentinel");
7153 staticpro (&QCsentinel
);
7154 QClog
= intern (":log");
7156 QCnoquery
= intern (":noquery");
7157 staticpro (&QCnoquery
);
7158 QCstop
= intern (":stop");
7159 staticpro (&QCstop
);
7160 QCoptions
= intern (":options");
7161 staticpro (&QCoptions
);
7162 QCplist
= intern (":plist");
7163 staticpro (&QCplist
);
7164 QCfilter_multibyte
= intern (":filter-multibyte");
7165 staticpro (&QCfilter_multibyte
);
7167 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
7168 staticpro (&Qlast_nonmenu_event
);
7170 staticpro (&Vprocess_alist
);
7172 staticpro (&deleted_pid_list
);
7175 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
7176 doc
: /* *Non-nil means delete processes immediately when they exit.
7177 A value of nil means don't delete them until `list-processes' is run. */);
7179 delete_exited_processes
= 1;
7181 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
7182 doc
: /* Control type of device used to communicate with subprocesses.
7183 Values are nil to use a pipe, or t or `pty' to use a pty.
7184 The value has no effect if the system has no ptys or if all ptys are busy:
7185 then a pipe is used in any case.
7186 The value takes effect when `start-process' is called. */);
7187 Vprocess_connection_type
= Qt
;
7189 #ifdef ADAPTIVE_READ_BUFFERING
7190 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
7191 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7192 On some systems, when Emacs reads the output from a subprocess, the output data
7193 is read in very small blocks, potentially resulting in very poor performance.
7194 This behavior can be remedied to some extent by setting this variable to a
7195 non-nil value, as it will automatically delay reading from such processes, to
7196 allow them to produce more output before Emacs tries to read it.
7197 If the value is t, the delay is reset after each write to the process; any other
7198 non-nil value means that the delay is not reset on write.
7199 The variable takes effect when `start-process' is called. */);
7200 Vprocess_adaptive_read_buffering
= Qt
;
7203 defsubr (&Sprocessp
);
7204 defsubr (&Sget_process
);
7205 defsubr (&Sget_buffer_process
);
7206 defsubr (&Sdelete_process
);
7207 defsubr (&Sprocess_status
);
7208 defsubr (&Sprocess_exit_status
);
7209 defsubr (&Sprocess_id
);
7210 defsubr (&Sprocess_name
);
7211 defsubr (&Sprocess_tty_name
);
7212 defsubr (&Sprocess_command
);
7213 defsubr (&Sset_process_buffer
);
7214 defsubr (&Sprocess_buffer
);
7215 defsubr (&Sprocess_mark
);
7216 defsubr (&Sset_process_filter
);
7217 defsubr (&Sprocess_filter
);
7218 defsubr (&Sset_process_sentinel
);
7219 defsubr (&Sprocess_sentinel
);
7220 defsubr (&Sset_process_window_size
);
7221 defsubr (&Sset_process_inherit_coding_system_flag
);
7222 defsubr (&Sprocess_inherit_coding_system_flag
);
7223 defsubr (&Sset_process_query_on_exit_flag
);
7224 defsubr (&Sprocess_query_on_exit_flag
);
7225 defsubr (&Sprocess_contact
);
7226 defsubr (&Sprocess_plist
);
7227 defsubr (&Sset_process_plist
);
7228 defsubr (&Slist_processes
);
7229 defsubr (&Sprocess_list
);
7230 defsubr (&Sstart_process
);
7232 defsubr (&Sset_network_process_option
);
7233 defsubr (&Smake_network_process
);
7234 defsubr (&Sformat_network_address
);
7235 #endif /* HAVE_SOCKETS */
7236 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7238 defsubr (&Snetwork_interface_list
);
7240 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7241 defsubr (&Snetwork_interface_info
);
7243 #endif /* HAVE_SOCKETS ... */
7244 #ifdef DATAGRAM_SOCKETS
7245 defsubr (&Sprocess_datagram_address
);
7246 defsubr (&Sset_process_datagram_address
);
7248 defsubr (&Saccept_process_output
);
7249 defsubr (&Sprocess_send_region
);
7250 defsubr (&Sprocess_send_string
);
7251 defsubr (&Sinterrupt_process
);
7252 defsubr (&Skill_process
);
7253 defsubr (&Squit_process
);
7254 defsubr (&Sstop_process
);
7255 defsubr (&Scontinue_process
);
7256 defsubr (&Sprocess_running_child_p
);
7257 defsubr (&Sprocess_send_eof
);
7258 defsubr (&Ssignal_process
);
7259 defsubr (&Swaiting_for_user_input_p
);
7260 /* defsubr (&Sprocess_connection); */
7261 defsubr (&Sset_process_coding_system
);
7262 defsubr (&Sprocess_coding_system
);
7263 defsubr (&Sset_process_filter_multibyte
);
7264 defsubr (&Sprocess_filter_multibyte_p
);
7268 #else /* not subprocesses */
7270 #include <sys/types.h>
7274 #include "systime.h"
7275 #include "charset.h"
7277 #include "termopts.h"
7278 #include "sysselect.h"
7280 extern int frame_garbaged
;
7282 extern EMACS_TIME
timer_check ();
7283 extern int timers_run
;
7287 /* As described above, except assuming that there are no subprocesses:
7289 Wait for timeout to elapse and/or keyboard input to be available.
7292 timeout in seconds, or
7293 zero for no limit, or
7294 -1 means gobble data immediately available but don't wait for any.
7296 read_kbd is a Lisp_Object:
7297 0 to ignore keyboard input, or
7298 1 to return when input is available, or
7299 -1 means caller will actually read the input, so don't throw to
7302 see full version for other parameters. We know that wait_proc will
7303 always be NULL, since `subprocesses' isn't defined.
7305 do_display != 0 means redisplay should be done to show subprocess
7306 output that arrives.
7308 Return true iff we received input from any process. */
7311 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
7312 wait_for_cell
, wait_proc
, just_wait_proc
)
7313 int time_limit
, microsecs
, read_kbd
, do_display
;
7314 Lisp_Object wait_for_cell
;
7315 struct Lisp_Process
*wait_proc
;
7319 EMACS_TIME end_time
, timeout
;
7320 SELECT_TYPE waitchannels
;
7323 /* What does time_limit really mean? */
7324 if (time_limit
|| microsecs
)
7326 EMACS_GET_TIME (end_time
);
7327 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
7328 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
7331 /* Turn off periodic alarms (in case they are in use)
7332 and then turn off any other atimers,
7333 because the select emulator uses alarms. */
7335 turn_on_atimers (0);
7339 int timeout_reduced_for_timers
= 0;
7341 /* If calling from keyboard input, do not quit
7342 since we want to return C-g as an input character.
7343 Otherwise, do pending quit if requested. */
7347 /* Exit now if the cell we're waiting for became non-nil. */
7348 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7351 /* Compute time from now till when time limit is up */
7352 /* Exit if already run out */
7353 if (time_limit
== -1)
7355 /* -1 specified for timeout means
7356 gobble output available now
7357 but don't wait at all. */
7359 EMACS_SET_SECS_USECS (timeout
, 0, 0);
7361 else if (time_limit
|| microsecs
)
7363 EMACS_GET_TIME (timeout
);
7364 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
7365 if (EMACS_TIME_NEG_P (timeout
))
7370 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
7373 /* If our caller will not immediately handle keyboard events,
7374 run timer events directly.
7375 (Callers that will immediately read keyboard events
7376 call timer_delay on their own.) */
7377 if (NILP (wait_for_cell
))
7379 EMACS_TIME timer_delay
;
7383 int old_timers_run
= timers_run
;
7384 timer_delay
= timer_check (1);
7385 if (timers_run
!= old_timers_run
&& do_display
)
7386 /* We must retry, since a timer may have requeued itself
7387 and that could alter the time delay. */
7388 redisplay_preserve_echo_area (14);
7392 while (!detect_input_pending ());
7394 /* If there is unread keyboard input, also return. */
7396 && requeued_events_pending_p ())
7399 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
7401 EMACS_TIME difference
;
7402 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
7403 if (EMACS_TIME_NEG_P (difference
))
7405 timeout
= timer_delay
;
7406 timeout_reduced_for_timers
= 1;
7411 /* Cause C-g and alarm signals to take immediate action,
7412 and cause input available signals to zero out timeout. */
7414 set_waiting_for_input (&timeout
);
7416 /* Wait till there is something to do. */
7418 if (! read_kbd
&& NILP (wait_for_cell
))
7419 FD_ZERO (&waitchannels
);
7421 FD_SET (0, &waitchannels
);
7423 /* If a frame has been newly mapped and needs updating,
7424 reprocess its display stuff. */
7425 if (frame_garbaged
&& do_display
)
7427 clear_waiting_for_input ();
7428 redisplay_preserve_echo_area (15);
7430 set_waiting_for_input (&timeout
);
7433 if (read_kbd
&& detect_input_pending ())
7436 FD_ZERO (&waitchannels
);
7439 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7444 /* Make C-g and alarm signals set flags again */
7445 clear_waiting_for_input ();
7447 /* If we woke up due to SIGWINCH, actually change size now. */
7448 do_pending_window_change (0);
7450 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7451 /* We waited the full specified time, so return now. */
7456 /* If the system call was interrupted, then go around the
7458 if (xerrno
== EINTR
)
7459 FD_ZERO (&waitchannels
);
7461 error ("select error: %s", emacs_strerror (xerrno
));
7464 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7465 /* System sometimes fails to deliver SIGIO. */
7466 kill (getpid (), SIGIO
);
7469 if (read_kbd
&& interrupt_input
&& (waitchannels
& 1))
7470 kill (getpid (), SIGIO
);
7473 /* Check for keyboard input */
7476 && detect_input_pending_run_timers (do_display
))
7478 swallow_events (do_display
);
7479 if (detect_input_pending_run_timers (do_display
))
7483 /* If there is unread keyboard input, also return. */
7485 && requeued_events_pending_p ())
7488 /* If wait_for_cell. check for keyboard input
7489 but don't run any timers.
7490 ??? (It seems wrong to me to check for keyboard
7491 input at all when wait_for_cell, but the code
7492 has been this way since July 1994.
7493 Try changing this after version 19.31.) */
7494 if (! NILP (wait_for_cell
)
7495 && detect_input_pending ())
7497 swallow_events (do_display
);
7498 if (detect_input_pending ())
7502 /* Exit now if the cell we're waiting for became non-nil. */
7503 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7513 /* Don't confuse make-docfile by having two doc strings for this function.
7514 make-docfile does not pay attention to #if, for good reason! */
7515 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7518 register Lisp_Object name
;
7523 /* Don't confuse make-docfile by having two doc strings for this function.
7524 make-docfile does not pay attention to #if, for good reason! */
7525 DEFUN ("process-inherit-coding-system-flag",
7526 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7530 register Lisp_Object process
;
7532 /* Ignore the argument and return the value of
7533 inherit-process-coding-system. */
7534 return inherit_process_coding_system
? Qt
: Qnil
;
7537 /* Kill all processes associated with `buffer'.
7538 If `buffer' is nil, kill all processes.
7539 Since we have no subprocesses, this does nothing. */
7542 kill_buffer_processes (buffer
)
7555 QCtype
= intern (":type");
7556 staticpro (&QCtype
);
7558 defsubr (&Sget_buffer_process
);
7559 defsubr (&Sprocess_inherit_coding_system_flag
);
7563 #endif /* not subprocesses */
7565 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7566 (do not change this comment) */