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 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 /* Mask of bits indicating the descriptors that we wait for input on. */
323 static SELECT_TYPE input_wait_mask
;
325 /* Mask that excludes keyboard input descriptor (s). */
327 static SELECT_TYPE non_keyboard_wait_mask
;
329 /* Mask that excludes process input descriptor (s). */
331 static SELECT_TYPE non_process_wait_mask
;
333 #ifdef NON_BLOCKING_CONNECT
334 /* Mask of bits indicating the descriptors that we wait for connect to
335 complete on. Once they complete, they are removed from this mask
336 and added to the input_wait_mask and non_keyboard_wait_mask. */
338 static SELECT_TYPE connect_wait_mask
;
340 /* Number of bits set in connect_wait_mask. */
341 static int num_pending_connects
;
343 #define IF_NON_BLOCKING_CONNECT(s) s
345 #define IF_NON_BLOCKING_CONNECT(s)
348 /* The largest descriptor currently in use for a process object. */
349 static int max_process_desc
;
351 /* The largest descriptor currently in use for keyboard input. */
352 static int max_keyboard_desc
;
354 /* Nonzero means delete a process right away if it exits. */
355 static int delete_exited_processes
;
357 /* Indexed by descriptor, gives the process (if any) for that descriptor */
358 Lisp_Object chan_process
[MAXDESC
];
360 /* Alist of elements (NAME . PROCESS) */
361 Lisp_Object Vprocess_alist
;
363 /* Buffered-ahead input char from process, indexed by channel.
364 -1 means empty (no char is buffered).
365 Used on sys V where the only way to tell if there is any
366 output from the process is to read at least one char.
367 Always -1 on systems that support FIONREAD. */
369 /* Don't make static; need to access externally. */
370 int proc_buffered_char
[MAXDESC
];
372 /* Table of `struct coding-system' for each process. */
373 static struct coding_system
*proc_decode_coding_system
[MAXDESC
];
374 static struct coding_system
*proc_encode_coding_system
[MAXDESC
];
376 #ifdef DATAGRAM_SOCKETS
377 /* Table of `partner address' for datagram sockets. */
378 struct sockaddr_and_len
{
381 } datagram_address
[MAXDESC
];
382 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
383 #define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0)
385 #define DATAGRAM_CHAN_P(chan) (0)
386 #define DATAGRAM_CONN_P(proc) (0)
389 static Lisp_Object
get_process ();
390 static void exec_sentinel ();
392 extern EMACS_TIME
timer_check ();
393 extern int timers_run
;
395 /* Maximum number of bytes to send to a pty without an eof. */
396 static int pty_max_bytes
;
402 /* The file name of the pty opened by allocate_pty. */
404 static char pty_name
[24];
407 /* Compute the Lisp form of the process status, p->status, from
408 the numeric status that was returned by `wait'. */
410 static Lisp_Object
status_convert ();
414 struct Lisp_Process
*p
;
416 union { int i
; WAITTYPE wt
; } u
;
417 eassert (p
->raw_status_new
);
419 p
->status
= status_convert (u
.wt
);
420 p
->raw_status_new
= 0;
423 /* Convert a process status word in Unix format to
424 the list that we use internally. */
431 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
432 else if (WIFEXITED (w
))
433 return Fcons (Qexit
, Fcons (make_number (WRETCODE (w
)),
434 WCOREDUMP (w
) ? Qt
: Qnil
));
435 else if (WIFSIGNALED (w
))
436 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
437 WCOREDUMP (w
) ? Qt
: Qnil
));
442 /* Given a status-list, extract the three pieces of information
443 and store them individually through the three pointers. */
446 decode_status (l
, symbol
, code
, coredump
)
464 *code
= XFASTINT (XCAR (tem
));
466 *coredump
= !NILP (tem
);
470 /* Return a string describing a process status list. */
474 struct Lisp_Process
*p
;
476 Lisp_Object status
= p
->status
;
479 Lisp_Object string
, string2
;
481 decode_status (status
, &symbol
, &code
, &coredump
);
483 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
486 synchronize_system_messages_locale ();
487 signame
= strsignal (code
);
490 string
= build_string (signame
);
491 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
492 SSET (string
, 0, DOWNCASE (SREF (string
, 0)));
493 return concat2 (string
, string2
);
495 else if (EQ (symbol
, Qexit
))
498 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
500 return build_string ("finished\n");
501 string
= Fnumber_to_string (make_number (code
));
502 string2
= build_string (coredump
? " (core dumped)\n" : "\n");
503 return concat3 (build_string ("exited abnormally with code "),
506 else if (EQ (symbol
, Qfailed
))
508 string
= Fnumber_to_string (make_number (code
));
509 string2
= build_string ("\n");
510 return concat3 (build_string ("failed with code "),
514 return Fcopy_sequence (Fsymbol_name (symbol
));
519 /* Open an available pty, returning a file descriptor.
520 Return -1 on failure.
521 The file name of the terminal corresponding to the pty
522 is left in the variable pty_name. */
533 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
534 for (i
= 0; i
< 16; i
++)
537 struct stat stb
; /* Used in some PTY_OPEN. */
538 #ifdef PTY_NAME_SPRINTF
541 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
542 #endif /* no PTY_NAME_SPRINTF */
546 #else /* no PTY_OPEN */
549 /* Unusual IRIS code */
550 *ptyv
= emacs_open ("/dev/ptc", O_RDWR
| O_NDELAY
, 0);
553 if (fstat (fd
, &stb
) < 0)
555 # else /* not IRIS */
556 { /* Some systems name their pseudoterminals so that there are gaps in
557 the usual sequence - for example, on HP9000/S700 systems, there
558 are no pseudoterminals with names ending in 'f'. So we wait for
559 three failures in a row before deciding that we've reached the
561 int failed_count
= 0;
563 if (stat (pty_name
, &stb
) < 0)
566 if (failed_count
>= 3)
573 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
575 fd
= emacs_open (pty_name
, O_RDWR
| O_NDELAY
, 0);
577 # endif /* not IRIS */
579 #endif /* no PTY_OPEN */
583 /* check to make certain that both sides are available
584 this avoids a nasty yet stupid bug in rlogins */
585 #ifdef PTY_TTY_NAME_SPRINTF
588 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
589 #endif /* no PTY_TTY_NAME_SPRINTF */
591 if (access (pty_name
, 6) != 0)
594 # if !defined(IRIS) && !defined(__sgi)
600 #endif /* not UNIPLUS */
607 #endif /* HAVE_PTYS */
613 register Lisp_Object val
, tem
, name1
;
614 register struct Lisp_Process
*p
;
618 p
= allocate_process ();
620 XSETINT (p
->infd
, -1);
621 XSETINT (p
->outfd
, -1);
622 XSETFASTINT (p
->tick
, 0);
623 XSETFASTINT (p
->update_tick
, 0);
625 p
->raw_status_new
= 0;
627 p
->mark
= Fmake_marker ();
629 #ifdef ADAPTIVE_READ_BUFFERING
630 p
->adaptive_read_buffering
= Qnil
;
631 XSETFASTINT (p
->read_output_delay
, 0);
632 p
->read_output_skip
= Qnil
;
635 /* If name is already in use, modify it until it is unused. */
640 tem
= Fget_process (name1
);
641 if (NILP (tem
)) break;
642 sprintf (suffix
, "<%d>", i
);
643 name1
= concat2 (name
, build_string (suffix
));
647 XSETPROCESS (val
, p
);
648 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
653 remove_process (proc
)
654 register Lisp_Object proc
;
656 register Lisp_Object pair
;
658 pair
= Frassq (proc
, Vprocess_alist
);
659 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
661 deactivate_process (proc
);
664 /* Setup coding systems of PROCESS. */
667 setup_process_coding_systems (process
)
670 struct Lisp_Process
*p
= XPROCESS (process
);
671 int inch
= XINT (p
->infd
);
672 int outch
= XINT (p
->outfd
);
674 if (inch
< 0 || outch
< 0)
677 if (!proc_decode_coding_system
[inch
])
678 proc_decode_coding_system
[inch
]
679 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
680 setup_coding_system (p
->decode_coding_system
,
681 proc_decode_coding_system
[inch
]);
682 if (! NILP (p
->filter
))
684 if (NILP (p
->filter_multibyte
))
685 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
687 else if (BUFFERP (p
->buffer
))
689 if (NILP (XBUFFER (p
->buffer
)->enable_multibyte_characters
))
690 setup_raw_text_coding_system (proc_decode_coding_system
[inch
]);
693 if (!proc_encode_coding_system
[outch
])
694 proc_encode_coding_system
[outch
]
695 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
696 setup_coding_system (p
->encode_coding_system
,
697 proc_encode_coding_system
[outch
]);
700 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
701 doc
: /* Return t if OBJECT is a process. */)
705 return PROCESSP (object
) ? Qt
: Qnil
;
708 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
709 doc
: /* Return the process named NAME, or nil if there is none. */)
711 register Lisp_Object name
;
716 return Fcdr (Fassoc (name
, Vprocess_alist
));
719 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
720 doc
: /* Return the (or a) process associated with BUFFER.
721 BUFFER may be a buffer or the name of one. */)
723 register Lisp_Object buffer
;
725 register Lisp_Object buf
, tail
, proc
;
727 if (NILP (buffer
)) return Qnil
;
728 buf
= Fget_buffer (buffer
);
729 if (NILP (buf
)) return Qnil
;
731 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
733 proc
= Fcdr (Fcar (tail
));
734 if (PROCESSP (proc
) && EQ (XPROCESS (proc
)->buffer
, buf
))
740 /* This is how commands for the user decode process arguments. It
741 accepts a process, a process name, a buffer, a buffer name, or nil.
742 Buffers denote the first process in the buffer, and nil denotes the
747 register Lisp_Object name
;
749 register Lisp_Object proc
, obj
;
752 obj
= Fget_process (name
);
754 obj
= Fget_buffer (name
);
756 error ("Process %s does not exist", SDATA (name
));
758 else if (NILP (name
))
759 obj
= Fcurrent_buffer ();
763 /* Now obj should be either a buffer object or a process object.
767 proc
= Fget_buffer_process (obj
);
769 error ("Buffer %s has no process", SDATA (XBUFFER (obj
)->name
));
779 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
780 doc
: /* Delete PROCESS: kill it and forget about it immediately.
781 PROCESS may be a process, a buffer, the name of a process or buffer, or
782 nil, indicating the current buffer's process. */)
784 register Lisp_Object process
;
786 register struct Lisp_Process
*p
;
788 process
= get_process (process
);
789 p
= XPROCESS (process
);
791 p
->raw_status_new
= 0;
794 p
->status
= Fcons (Qexit
, Fcons (make_number (0), Qnil
));
795 XSETINT (p
->tick
, ++process_tick
);
798 else if (XINT (p
->infd
) >= 0)
800 Fkill_process (process
, Qnil
);
801 /* Do this now, since remove_process will make sigchld_handler do nothing. */
803 = Fcons (Qsignal
, Fcons (make_number (SIGKILL
), Qnil
));
804 XSETINT (p
->tick
, ++process_tick
);
807 remove_process (process
);
811 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
812 doc
: /* Return the status of PROCESS.
813 The returned value is one of the following symbols:
814 run -- for a process that is running.
815 stop -- for a process stopped but continuable.
816 exit -- for a process that has exited.
817 signal -- for a process that has got a fatal signal.
818 open -- for a network stream connection that is open.
819 listen -- for a network stream server that is listening.
820 closed -- for a network stream connection that is closed.
821 connect -- when waiting for a non-blocking connection to complete.
822 failed -- when a non-blocking connection has failed.
823 nil -- if arg is a process name and no such process exists.
824 PROCESS may be a process, a buffer, the name of a process, or
825 nil, indicating the current buffer's process. */)
827 register Lisp_Object process
;
829 register struct Lisp_Process
*p
;
830 register Lisp_Object status
;
832 if (STRINGP (process
))
833 process
= Fget_process (process
);
835 process
= get_process (process
);
840 p
= XPROCESS (process
);
841 if (p
->raw_status_new
)
845 status
= XCAR (status
);
848 if (EQ (status
, Qexit
))
850 else if (EQ (p
->command
, Qt
))
852 else if (EQ (status
, Qrun
))
858 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
860 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
861 If PROCESS has not yet exited or died, return 0. */)
863 register Lisp_Object process
;
865 CHECK_PROCESS (process
);
866 if (XPROCESS (process
)->raw_status_new
)
867 update_status (XPROCESS (process
));
868 if (CONSP (XPROCESS (process
)->status
))
869 return XCAR (XCDR (XPROCESS (process
)->status
));
870 return make_number (0);
873 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
874 doc
: /* Return the process id of PROCESS.
875 This is the pid of the external process which PROCESS uses or talks to.
876 For a network connection, this value is nil. */)
878 register Lisp_Object process
;
880 CHECK_PROCESS (process
);
881 return (XPROCESS (process
)->pid
882 ? make_fixnum_or_float (XPROCESS (process
)->pid
)
886 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
887 doc
: /* Return the name of PROCESS, as a string.
888 This is the name of the program invoked in PROCESS,
889 possibly modified to make it unique among process names. */)
891 register Lisp_Object process
;
893 CHECK_PROCESS (process
);
894 return XPROCESS (process
)->name
;
897 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
898 doc
: /* Return the command that was executed to start PROCESS.
899 This is a list of strings, the first string being the program executed
900 and the rest of the strings being the arguments given to it.
901 For a non-child channel, this is nil. */)
903 register Lisp_Object process
;
905 CHECK_PROCESS (process
);
906 return XPROCESS (process
)->command
;
909 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
910 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
911 This is the terminal that the process itself reads and writes on,
912 not the name of the pty that Emacs uses to talk with that terminal. */)
914 register Lisp_Object process
;
916 CHECK_PROCESS (process
);
917 return XPROCESS (process
)->tty_name
;
920 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
922 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
924 register Lisp_Object process
, buffer
;
926 struct Lisp_Process
*p
;
928 CHECK_PROCESS (process
);
930 CHECK_BUFFER (buffer
);
931 p
= XPROCESS (process
);
934 p
->childp
= Fplist_put (p
->childp
, QCbuffer
, buffer
);
935 setup_process_coding_systems (process
);
939 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
941 doc
: /* Return the buffer PROCESS is associated with.
942 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
944 register Lisp_Object process
;
946 CHECK_PROCESS (process
);
947 return XPROCESS (process
)->buffer
;
950 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
952 doc
: /* Return the marker for the end of the last output from PROCESS. */)
954 register Lisp_Object process
;
956 CHECK_PROCESS (process
);
957 return XPROCESS (process
)->mark
;
960 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
962 doc
: /* Give PROCESS the filter function FILTER; nil means no filter.
963 t means stop accepting output from the process.
965 When a process has a filter, its buffer is not used for output.
966 Instead, each time it does output, the entire string of output is
967 passed to the filter.
969 The filter gets two arguments: the process and the string of output.
970 The string argument is normally a multibyte string, except:
971 - if the process' input coding system is no-conversion or raw-text,
972 it is a unibyte string (the non-converted input), or else
973 - if `default-enable-multibyte-characters' is nil, it is a unibyte
974 string (the result of converting the decoded input multibyte
975 string to unibyte with `string-make-unibyte'). */)
977 register Lisp_Object process
, filter
;
979 struct Lisp_Process
*p
;
981 CHECK_PROCESS (process
);
982 p
= XPROCESS (process
);
984 /* Don't signal an error if the process' input file descriptor
985 is closed. This could make debugging Lisp more difficult,
986 for example when doing something like
988 (setq process (start-process ...))
990 (set-process-filter process ...) */
992 if (XINT (p
->infd
) >= 0)
994 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
996 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
997 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
999 else if (EQ (p
->filter
, Qt
)
1000 && !EQ (p
->command
, Qt
)) /* Network process not stopped. */
1002 FD_SET (XINT (p
->infd
), &input_wait_mask
);
1003 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
1009 p
->childp
= Fplist_put (p
->childp
, QCfilter
, filter
);
1010 setup_process_coding_systems (process
);
1014 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1016 doc
: /* Returns the filter function of PROCESS; nil if none.
1017 See `set-process-filter' for more info on filter functions. */)
1019 register Lisp_Object process
;
1021 CHECK_PROCESS (process
);
1022 return XPROCESS (process
)->filter
;
1025 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1027 doc
: /* Give PROCESS the sentinel SENTINEL; nil for none.
1028 The sentinel is called as a function when the process changes state.
1029 It gets two arguments: the process, and a string describing the change. */)
1031 register Lisp_Object process
, sentinel
;
1033 struct Lisp_Process
*p
;
1035 CHECK_PROCESS (process
);
1036 p
= XPROCESS (process
);
1038 p
->sentinel
= sentinel
;
1040 p
->childp
= Fplist_put (p
->childp
, QCsentinel
, sentinel
);
1044 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1046 doc
: /* Return the sentinel of PROCESS; nil if none.
1047 See `set-process-sentinel' for more info on sentinels. */)
1049 register Lisp_Object process
;
1051 CHECK_PROCESS (process
);
1052 return XPROCESS (process
)->sentinel
;
1055 DEFUN ("set-process-window-size", Fset_process_window_size
,
1056 Sset_process_window_size
, 3, 3, 0,
1057 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1058 (process
, height
, width
)
1059 register Lisp_Object process
, height
, width
;
1061 CHECK_PROCESS (process
);
1062 CHECK_NATNUM (height
);
1063 CHECK_NATNUM (width
);
1065 if (XINT (XPROCESS (process
)->infd
) < 0
1066 || set_window_size (XINT (XPROCESS (process
)->infd
),
1067 XINT (height
), XINT (width
)) <= 0)
1073 DEFUN ("set-process-inherit-coding-system-flag",
1074 Fset_process_inherit_coding_system_flag
,
1075 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1076 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1077 If the second argument FLAG is non-nil, then the variable
1078 `buffer-file-coding-system' of the buffer associated with PROCESS
1079 will be bound to the value of the coding system used to decode
1082 This is useful when the coding system specified for the process buffer
1083 leaves either the character code conversion or the end-of-line conversion
1084 unspecified, or if the coding system used to decode the process output
1085 is more appropriate for saving the process buffer.
1087 Binding the variable `inherit-process-coding-system' to non-nil before
1088 starting the process is an alternative way of setting the inherit flag
1089 for the process which will run. */)
1091 register Lisp_Object process
, flag
;
1093 CHECK_PROCESS (process
);
1094 XPROCESS (process
)->inherit_coding_system_flag
= flag
;
1098 DEFUN ("process-inherit-coding-system-flag",
1099 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
1101 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
1102 If this flag is t, `buffer-file-coding-system' of the buffer
1103 associated with PROCESS will inherit the coding system used to decode
1104 the process output. */)
1106 register Lisp_Object process
;
1108 CHECK_PROCESS (process
);
1109 return XPROCESS (process
)->inherit_coding_system_flag
;
1112 DEFUN ("set-process-query-on-exit-flag",
1113 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1115 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1116 If the second argument FLAG is non-nil, Emacs will query the user before
1117 exiting if PROCESS is running. */)
1119 register Lisp_Object process
, flag
;
1121 CHECK_PROCESS (process
);
1122 XPROCESS (process
)->kill_without_query
= Fnull (flag
);
1126 DEFUN ("process-query-on-exit-flag",
1127 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1129 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1131 register Lisp_Object process
;
1133 CHECK_PROCESS (process
);
1134 return Fnull (XPROCESS (process
)->kill_without_query
);
1137 #ifdef DATAGRAM_SOCKETS
1138 Lisp_Object
Fprocess_datagram_address ();
1141 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1143 doc
: /* Return the contact info of PROCESS; t for a real child.
1144 For a net connection, the value depends on the optional KEY arg.
1145 If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1146 if KEY is t, the complete contact information for the connection is
1147 returned, else the specific value for the keyword KEY is returned.
1148 See `make-network-process' for a list of keywords. */)
1150 register Lisp_Object process
, key
;
1152 Lisp_Object contact
;
1154 CHECK_PROCESS (process
);
1155 contact
= XPROCESS (process
)->childp
;
1157 #ifdef DATAGRAM_SOCKETS
1158 if (DATAGRAM_CONN_P (process
)
1159 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1160 contact
= Fplist_put (contact
, QCremote
,
1161 Fprocess_datagram_address (process
));
1164 if (!NETCONN_P (process
) || EQ (key
, Qt
))
1167 return Fcons (Fplist_get (contact
, QChost
),
1168 Fcons (Fplist_get (contact
, QCservice
), Qnil
));
1169 return Fplist_get (contact
, key
);
1172 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1174 doc
: /* Return the plist of PROCESS. */)
1176 register Lisp_Object process
;
1178 CHECK_PROCESS (process
);
1179 return XPROCESS (process
)->plist
;
1182 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1184 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1186 register Lisp_Object process
, plist
;
1188 CHECK_PROCESS (process
);
1191 XPROCESS (process
)->plist
= plist
;
1195 #if 0 /* Turned off because we don't currently record this info
1196 in the process. Perhaps add it. */
1197 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1198 doc
: /* Return the connection type of PROCESS.
1199 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1200 a socket connection. */)
1202 Lisp_Object process
;
1204 return XPROCESS (process
)->type
;
1209 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1211 doc
: /* Convert network ADDRESS from internal format to a string.
1212 A 4 or 5 element vector represents an IPv4 address (with port number).
1213 An 8 or 9 element vector represents an IPv6 address (with port number).
1214 If optional second argument OMIT-PORT is non-nil, don't include a port
1215 number in the string, even when present in ADDRESS.
1216 Returns nil if format of ADDRESS is invalid. */)
1217 (address
, omit_port
)
1218 Lisp_Object address
, omit_port
;
1223 if (STRINGP (address
)) /* AF_LOCAL */
1226 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1228 register struct Lisp_Vector
*p
= XVECTOR (address
);
1229 Lisp_Object args
[6];
1232 if (p
->size
== 4 || (p
->size
== 5 && !NILP (omit_port
)))
1234 args
[0] = build_string ("%d.%d.%d.%d");
1237 else if (p
->size
== 5)
1239 args
[0] = build_string ("%d.%d.%d.%d:%d");
1242 else if (p
->size
== 8 || (p
->size
== 9 && !NILP (omit_port
)))
1244 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1247 else if (p
->size
== 9)
1249 args
[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1255 for (i
= 0; i
< nargs
; i
++)
1256 args
[i
+1] = p
->contents
[i
];
1257 return Fformat (nargs
+1, args
);
1260 if (CONSP (address
))
1262 Lisp_Object args
[2];
1263 args
[0] = build_string ("<Family %d>");
1264 args
[1] = Fcar (address
);
1265 return Fformat (2, args
);
1274 list_processes_1 (query_only
)
1275 Lisp_Object query_only
;
1277 register Lisp_Object tail
, tem
;
1278 Lisp_Object proc
, minspace
, tem1
;
1279 register struct Lisp_Process
*p
;
1281 int w_proc
, w_buffer
, w_tty
;
1282 Lisp_Object i_status
, i_buffer
, i_tty
, i_command
;
1284 w_proc
= 4; /* Proc */
1285 w_buffer
= 6; /* Buffer */
1286 w_tty
= 0; /* Omit if no ttys */
1288 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1292 proc
= Fcdr (Fcar (tail
));
1293 p
= XPROCESS (proc
);
1294 if (NILP (p
->childp
))
1296 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1298 if (STRINGP (p
->name
)
1299 && ( i
= SCHARS (p
->name
), (i
> w_proc
)))
1301 if (!NILP (p
->buffer
))
1303 if (NILP (XBUFFER (p
->buffer
)->name
) && w_buffer
< 8)
1304 w_buffer
= 8; /* (Killed) */
1305 else if ((i
= SCHARS (XBUFFER (p
->buffer
)->name
), (i
> w_buffer
)))
1308 if (STRINGP (p
->tty_name
)
1309 && (i
= SCHARS (p
->tty_name
), (i
> w_tty
)))
1313 XSETFASTINT (i_status
, w_proc
+ 1);
1314 XSETFASTINT (i_buffer
, XFASTINT (i_status
) + 9);
1317 XSETFASTINT (i_tty
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1318 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_tty
+ 1);
1321 XSETFASTINT (i_command
, XFASTINT (i_buffer
) + w_buffer
+ 1);
1324 XSETFASTINT (minspace
, 1);
1326 set_buffer_internal (XBUFFER (Vstandard_output
));
1327 current_buffer
->undo_list
= Qt
;
1329 current_buffer
->truncate_lines
= Qt
;
1331 write_string ("Proc", -1);
1332 Findent_to (i_status
, minspace
); write_string ("Status", -1);
1333 Findent_to (i_buffer
, minspace
); write_string ("Buffer", -1);
1336 Findent_to (i_tty
, minspace
); write_string ("Tty", -1);
1338 Findent_to (i_command
, minspace
); write_string ("Command", -1);
1339 write_string ("\n", -1);
1341 write_string ("----", -1);
1342 Findent_to (i_status
, minspace
); write_string ("------", -1);
1343 Findent_to (i_buffer
, minspace
); write_string ("------", -1);
1346 Findent_to (i_tty
, minspace
); write_string ("---", -1);
1348 Findent_to (i_command
, minspace
); write_string ("-------", -1);
1349 write_string ("\n", -1);
1351 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1355 proc
= Fcdr (Fcar (tail
));
1356 p
= XPROCESS (proc
);
1357 if (NILP (p
->childp
))
1359 if (!NILP (query_only
) && !NILP (p
->kill_without_query
))
1362 Finsert (1, &p
->name
);
1363 Findent_to (i_status
, minspace
);
1365 if (p
->raw_status_new
)
1368 if (CONSP (p
->status
))
1369 symbol
= XCAR (p
->status
);
1372 if (EQ (symbol
, Qsignal
))
1375 tem
= Fcar (Fcdr (p
->status
));
1377 if (XINT (tem
) < NSIG
)
1378 write_string (sys_errlist
[XINT (tem
)], -1);
1381 Fprinc (symbol
, Qnil
);
1383 else if (NETCONN1_P (p
))
1385 if (EQ (symbol
, Qexit
))
1386 write_string ("closed", -1);
1387 else if (EQ (p
->command
, Qt
))
1388 write_string ("stopped", -1);
1389 else if (EQ (symbol
, Qrun
))
1390 write_string ("open", -1);
1392 Fprinc (symbol
, Qnil
);
1395 Fprinc (symbol
, Qnil
);
1397 if (EQ (symbol
, Qexit
))
1400 tem
= Fcar (Fcdr (p
->status
));
1403 sprintf (tembuf
, " %d", (int) XFASTINT (tem
));
1404 write_string (tembuf
, -1);
1408 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
))
1409 remove_process (proc
);
1411 Findent_to (i_buffer
, minspace
);
1412 if (NILP (p
->buffer
))
1413 insert_string ("(none)");
1414 else if (NILP (XBUFFER (p
->buffer
)->name
))
1415 insert_string ("(Killed)");
1417 Finsert (1, &XBUFFER (p
->buffer
)->name
);
1421 Findent_to (i_tty
, minspace
);
1422 if (STRINGP (p
->tty_name
))
1423 Finsert (1, &p
->tty_name
);
1426 Findent_to (i_command
, minspace
);
1428 if (EQ (p
->status
, Qlisten
))
1430 Lisp_Object port
= Fplist_get (p
->childp
, QCservice
);
1431 if (INTEGERP (port
))
1432 port
= Fnumber_to_string (port
);
1434 port
= Fformat_network_address (Fplist_get (p
->childp
, QClocal
), Qnil
);
1435 sprintf (tembuf
, "(network %s server on %s)\n",
1436 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1437 (STRINGP (port
) ? (char *)SDATA (port
) : "?"));
1438 insert_string (tembuf
);
1440 else if (NETCONN1_P (p
))
1442 /* For a local socket, there is no host name,
1443 so display service instead. */
1444 Lisp_Object host
= Fplist_get (p
->childp
, QChost
);
1445 if (!STRINGP (host
))
1447 host
= Fplist_get (p
->childp
, QCservice
);
1448 if (INTEGERP (host
))
1449 host
= Fnumber_to_string (host
);
1452 host
= Fformat_network_address (Fplist_get (p
->childp
, QCremote
), Qnil
);
1453 sprintf (tembuf
, "(network %s connection to %s)\n",
1454 (DATAGRAM_CHAN_P (XINT (p
->infd
)) ? "datagram" : "stream"),
1455 (STRINGP (host
) ? (char *)SDATA (host
) : "?"));
1456 insert_string (tembuf
);
1468 insert_string (" ");
1470 insert_string ("\n");
1476 DEFUN ("list-processes", Flist_processes
, Slist_processes
, 0, 1, "P",
1477 doc
: /* Display a list of all processes.
1478 If optional argument QUERY-ONLY is non-nil, only processes with
1479 the query-on-exit flag set will be listed.
1480 Any process listed as exited or signaled is actually eliminated
1481 after the listing is made. */)
1483 Lisp_Object query_only
;
1485 internal_with_output_to_temp_buffer ("*Process List*",
1486 list_processes_1
, query_only
);
1490 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1491 doc
: /* Return a list of all processes. */)
1494 return Fmapcar (Qcdr
, Vprocess_alist
);
1497 /* Starting asynchronous inferior processes. */
1499 static Lisp_Object
start_process_unwind ();
1501 DEFUN ("start-process", Fstart_process
, Sstart_process
, 3, MANY
, 0,
1502 doc
: /* Start a program in a subprocess. Return the process object for it.
1503 NAME is name for process. It is modified if necessary to make it unique.
1504 BUFFER is the buffer (or buffer name) to associate with the process.
1505 Process output goes at end of that buffer, unless you specify
1506 an output stream or filter function to handle the output.
1507 BUFFER may be also nil, meaning that this process is not associated
1509 PROGRAM is the program file name. It is searched for in PATH.
1510 Remaining arguments are strings to give program as arguments.
1512 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1515 register Lisp_Object
*args
;
1517 Lisp_Object buffer
, name
, program
, proc
, current_dir
, tem
;
1519 register unsigned char *new_argv
;
1522 register unsigned char **new_argv
;
1525 int count
= SPECPDL_INDEX ();
1529 buffer
= Fget_buffer_create (buffer
);
1531 /* Make sure that the child will be able to chdir to the current
1532 buffer's current directory, or its unhandled equivalent. We
1533 can't just have the child check for an error when it does the
1534 chdir, since it's in a vfork.
1536 We have to GCPRO around this because Fexpand_file_name and
1537 Funhandled_file_name_directory might call a file name handling
1538 function. The argument list is protected by the caller, so all
1539 we really have to worry about is buffer. */
1541 struct gcpro gcpro1
, gcpro2
;
1543 current_dir
= current_buffer
->directory
;
1545 GCPRO2 (buffer
, current_dir
);
1548 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
1550 if (NILP (Ffile_accessible_directory_p (current_dir
)))
1551 report_file_error ("Setting current directory",
1552 Fcons (current_buffer
->directory
, Qnil
));
1558 CHECK_STRING (name
);
1562 CHECK_STRING (program
);
1564 proc
= make_process (name
);
1565 /* If an error occurs and we can't start the process, we want to
1566 remove it from the process list. This means that each error
1567 check in create_process doesn't need to call remove_process
1568 itself; it's all taken care of here. */
1569 record_unwind_protect (start_process_unwind
, proc
);
1571 XPROCESS (proc
)->childp
= Qt
;
1572 XPROCESS (proc
)->plist
= Qnil
;
1573 XPROCESS (proc
)->buffer
= buffer
;
1574 XPROCESS (proc
)->sentinel
= Qnil
;
1575 XPROCESS (proc
)->filter
= Qnil
;
1576 XPROCESS (proc
)->filter_multibyte
1577 = buffer_defaults
.enable_multibyte_characters
;
1578 XPROCESS (proc
)->command
= Flist (nargs
- 2, args
+ 2);
1580 #ifdef ADAPTIVE_READ_BUFFERING
1581 XPROCESS (proc
)->adaptive_read_buffering
= Vprocess_adaptive_read_buffering
;
1584 /* Make the process marker point into the process buffer (if any). */
1585 if (BUFFERP (buffer
))
1586 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1587 BUF_ZV (XBUFFER (buffer
)),
1588 BUF_ZV_BYTE (XBUFFER (buffer
)));
1591 /* Decide coding systems for communicating with the process. Here
1592 we don't setup the structure coding_system nor pay attention to
1593 unibyte mode. They are done in create_process. */
1595 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1596 Lisp_Object coding_systems
= Qt
;
1597 Lisp_Object val
, *args2
;
1598 struct gcpro gcpro1
, gcpro2
;
1600 val
= Vcoding_system_for_read
;
1603 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1604 args2
[0] = Qstart_process
;
1605 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1606 GCPRO2 (proc
, current_dir
);
1607 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1609 if (CONSP (coding_systems
))
1610 val
= XCAR (coding_systems
);
1611 else if (CONSP (Vdefault_process_coding_system
))
1612 val
= XCAR (Vdefault_process_coding_system
);
1614 XPROCESS (proc
)->decode_coding_system
= val
;
1616 val
= Vcoding_system_for_write
;
1619 if (EQ (coding_systems
, Qt
))
1621 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof args2
);
1622 args2
[0] = Qstart_process
;
1623 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1624 GCPRO2 (proc
, current_dir
);
1625 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1628 if (CONSP (coding_systems
))
1629 val
= XCDR (coding_systems
);
1630 else if (CONSP (Vdefault_process_coding_system
))
1631 val
= XCDR (Vdefault_process_coding_system
);
1633 XPROCESS (proc
)->encode_coding_system
= val
;
1637 /* Make a one member argv with all args concatenated
1638 together separated by a blank. */
1639 len
= SBYTES (program
) + 2;
1640 for (i
= 3; i
< nargs
; i
++)
1644 len
+= SBYTES (tem
) + 1; /* count the blank */
1646 new_argv
= (unsigned char *) alloca (len
);
1647 strcpy (new_argv
, SDATA (program
));
1648 for (i
= 3; i
< nargs
; i
++)
1652 strcat (new_argv
, " ");
1653 strcat (new_argv
, SDATA (tem
));
1655 /* Need to add code here to check for program existence on VMS */
1658 new_argv
= (unsigned char **) alloca ((nargs
- 1) * sizeof (char *));
1660 /* If program file name is not absolute, search our path for it.
1661 Put the name we will really use in TEM. */
1662 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1663 && !(SCHARS (program
) > 1
1664 && IS_DEVICE_SEP (SREF (program
, 1))))
1666 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1669 GCPRO4 (name
, program
, buffer
, current_dir
);
1670 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
, make_number (X_OK
));
1673 report_file_error ("Searching for program", Fcons (program
, Qnil
));
1674 tem
= Fexpand_file_name (tem
, Qnil
);
1678 if (!NILP (Ffile_directory_p (program
)))
1679 error ("Specified program for new process is a directory");
1683 /* If program file name starts with /: for quoting a magic name,
1685 if (SBYTES (tem
) > 2 && SREF (tem
, 0) == '/'
1686 && SREF (tem
, 1) == ':')
1687 tem
= Fsubstring (tem
, make_number (2), Qnil
);
1689 /* Encode the file name and put it in NEW_ARGV.
1690 That's where the child will use it to execute the program. */
1691 tem
= ENCODE_FILE (tem
);
1692 new_argv
[0] = SDATA (tem
);
1694 /* Here we encode arguments by the coding system used for sending
1695 data to the process. We don't support using different coding
1696 systems for encoding arguments and for encoding data sent to the
1699 for (i
= 3; i
< nargs
; i
++)
1703 if (STRING_MULTIBYTE (tem
))
1704 tem
= (code_convert_string_norecord
1705 (tem
, XPROCESS (proc
)->encode_coding_system
, 1));
1706 new_argv
[i
- 2] = SDATA (tem
);
1708 new_argv
[i
- 2] = 0;
1709 #endif /* not VMS */
1711 XPROCESS (proc
)->decoding_buf
= make_uninit_string (0);
1712 XPROCESS (proc
)->decoding_carryover
= make_number (0);
1713 XPROCESS (proc
)->encoding_buf
= make_uninit_string (0);
1714 XPROCESS (proc
)->encoding_carryover
= make_number (0);
1716 XPROCESS (proc
)->inherit_coding_system_flag
1717 = (NILP (buffer
) || !inherit_process_coding_system
1720 create_process (proc
, (char **) new_argv
, current_dir
);
1722 return unbind_to (count
, proc
);
1725 /* This function is the unwind_protect form for Fstart_process. If
1726 PROC doesn't have its pid set, then we know someone has signaled
1727 an error and the process wasn't started successfully, so we should
1728 remove it from the process list. */
1730 start_process_unwind (proc
)
1733 if (!PROCESSP (proc
))
1736 /* Was PROC started successfully? */
1737 if (XPROCESS (proc
)->pid
<= 0)
1738 remove_process (proc
);
1744 create_process_1 (timer
)
1745 struct atimer
*timer
;
1747 /* Nothing to do. */
1751 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1754 /* Mimic blocking of signals on system V, which doesn't really have it. */
1756 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1757 int sigchld_deferred
;
1760 create_process_sigchld ()
1762 signal (SIGCHLD
, create_process_sigchld
);
1764 sigchld_deferred
= 1;
1770 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1772 create_process (process
, new_argv
, current_dir
)
1773 Lisp_Object process
;
1775 Lisp_Object current_dir
;
1777 int pid
, inchannel
, outchannel
;
1779 #ifdef POSIX_SIGNALS
1782 struct sigaction sigint_action
;
1783 struct sigaction sigquit_action
;
1785 struct sigaction sighup_action
;
1787 #else /* !POSIX_SIGNALS */
1790 SIGTYPE (*sigchld
)();
1793 #endif /* !POSIX_SIGNALS */
1794 /* Use volatile to protect variables from being clobbered by longjmp. */
1795 volatile int forkin
, forkout
;
1796 volatile int pty_flag
= 0;
1798 extern char **environ
;
1801 inchannel
= outchannel
= -1;
1804 if (!NILP (Vprocess_connection_type
))
1805 outchannel
= inchannel
= allocate_pty ();
1809 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1810 /* On most USG systems it does not work to open the pty's tty here,
1811 then close it and reopen it in the child. */
1813 /* Don't let this terminal become our controlling terminal
1814 (in case we don't have one). */
1815 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1817 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
, 0);
1820 report_file_error ("Opening pty", Qnil
);
1821 #if defined (RTU) || defined (UNIPLUS) || defined (DONT_REOPEN_PTY)
1822 /* In the case that vfork is defined as fork, the parent process
1823 (Emacs) may send some data before the child process completes
1824 tty options setup. So we setup tty before forking. */
1825 child_setup_tty (forkout
);
1826 #endif /* RTU or UNIPLUS or DONT_REOPEN_PTY */
1828 forkin
= forkout
= -1;
1829 #endif /* not USG, or USG_SUBTTY_WORKS */
1833 #endif /* HAVE_PTYS */
1836 if (socketpair (AF_UNIX
, SOCK_STREAM
, 0, sv
) < 0)
1837 report_file_error ("Opening socketpair", Qnil
);
1838 outchannel
= inchannel
= sv
[0];
1839 forkout
= forkin
= sv
[1];
1841 #else /* not SKTPAIR */
1846 report_file_error ("Creating pipe", Qnil
);
1852 emacs_close (inchannel
);
1853 emacs_close (forkout
);
1854 report_file_error ("Creating pipe", Qnil
);
1859 #endif /* not SKTPAIR */
1862 /* Replaced by close_process_descs */
1863 set_exclusive_use (inchannel
);
1864 set_exclusive_use (outchannel
);
1867 /* Stride people say it's a mystery why this is needed
1868 as well as the O_NDELAY, but that it fails without this. */
1869 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1872 ioctl (inchannel
, FIONBIO
, &one
);
1877 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1878 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1881 fcntl (inchannel
, F_SETFL
, O_NDELAY
);
1882 fcntl (outchannel
, F_SETFL
, O_NDELAY
);
1886 /* Record this as an active process, with its channels.
1887 As a result, child_setup will close Emacs's side of the pipes. */
1888 chan_process
[inchannel
] = process
;
1889 XSETINT (XPROCESS (process
)->infd
, inchannel
);
1890 XSETINT (XPROCESS (process
)->outfd
, outchannel
);
1892 /* Previously we recorded the tty descriptor used in the subprocess.
1893 It was only used for getting the foreground tty process, so now
1894 we just reopen the device (see emacs_get_tty_pgrp) as this is
1895 more portable (see USG_SUBTTY_WORKS above). */
1897 XPROCESS (process
)->pty_flag
= (pty_flag
? Qt
: Qnil
);
1898 XPROCESS (process
)->status
= Qrun
;
1899 setup_process_coding_systems (process
);
1901 /* Delay interrupts until we have a chance to store
1902 the new fork's pid in its process structure */
1903 #ifdef POSIX_SIGNALS
1904 sigemptyset (&blocked
);
1906 sigaddset (&blocked
, SIGCHLD
);
1908 #ifdef HAVE_WORKING_VFORK
1909 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1910 this sets the parent's signal handlers as well as the child's.
1911 So delay all interrupts whose handlers the child might munge,
1912 and record the current handlers so they can be restored later. */
1913 sigaddset (&blocked
, SIGINT
); sigaction (SIGINT
, 0, &sigint_action
);
1914 sigaddset (&blocked
, SIGQUIT
); sigaction (SIGQUIT
, 0, &sigquit_action
);
1916 sigaddset (&blocked
, SIGHUP
); sigaction (SIGHUP
, 0, &sighup_action
);
1918 #endif /* HAVE_WORKING_VFORK */
1919 sigprocmask (SIG_BLOCK
, &blocked
, &procmask
);
1920 #else /* !POSIX_SIGNALS */
1924 #else /* not BSD4_1 */
1925 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1926 sigsetmask (sigmask (SIGCHLD
));
1927 #else /* ordinary USG */
1929 sigchld_deferred
= 0;
1930 sigchld
= signal (SIGCHLD
, create_process_sigchld
);
1932 #endif /* ordinary USG */
1933 #endif /* not BSD4_1 */
1934 #endif /* SIGCHLD */
1935 #endif /* !POSIX_SIGNALS */
1937 FD_SET (inchannel
, &input_wait_mask
);
1938 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1939 if (inchannel
> max_process_desc
)
1940 max_process_desc
= inchannel
;
1942 /* Until we store the proper pid, enable sigchld_handler
1943 to recognize an unknown pid as standing for this process.
1944 It is very important not to let this `marker' value stay
1945 in the table after this function has returned; if it does
1946 it might cause call-process to hang and subsequent asynchronous
1947 processes to get their return values scrambled. */
1948 XPROCESS (process
)->pid
= -1;
1953 /* child_setup must clobber environ on systems with true vfork.
1954 Protect it from permanent change. */
1955 char **save_environ
= environ
;
1957 current_dir
= ENCODE_FILE (current_dir
);
1962 #endif /* not WINDOWSNT */
1964 int xforkin
= forkin
;
1965 int xforkout
= forkout
;
1967 #if 0 /* This was probably a mistake--it duplicates code later on,
1968 but fails to handle all the cases. */
1969 /* Make sure SIGCHLD is not blocked in the child. */
1970 sigsetmask (SIGEMPTYMASK
);
1973 /* Make the pty be the controlling terminal of the process. */
1975 /* First, disconnect its current controlling terminal. */
1977 /* We tried doing setsid only if pty_flag, but it caused
1978 process_set_signal to fail on SGI when using a pipe. */
1980 /* Make the pty's terminal the controlling terminal. */
1984 /* We ignore the return value
1985 because faith@cs.unc.edu says that is necessary on Linux. */
1986 ioctl (xforkin
, TIOCSCTTY
, 0);
1989 #else /* not HAVE_SETSID */
1991 /* It's very important to call setpgrp here and no time
1992 afterwards. Otherwise, we lose our controlling tty which
1993 is set when we open the pty. */
1996 #endif /* not HAVE_SETSID */
1997 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1998 if (pty_flag
&& xforkin
>= 0)
2001 tcgetattr (xforkin
, &t
);
2003 if (tcsetattr (xforkin
, TCSANOW
, &t
) < 0)
2004 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
2007 #if defined (NTTYDISC) && defined (TIOCSETD)
2008 if (pty_flag
&& xforkin
>= 0)
2010 /* Use new line discipline. */
2011 int ldisc
= NTTYDISC
;
2012 ioctl (xforkin
, TIOCSETD
, &ldisc
);
2017 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2018 can do TIOCSPGRP only to the process's controlling tty. */
2021 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2022 I can't test it since I don't have 4.3. */
2023 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
2024 ioctl (j
, TIOCNOTTY
, 0);
2027 /* In order to get a controlling terminal on some versions
2028 of BSD, it is necessary to put the process in pgrp 0
2029 before it opens the terminal. */
2037 #endif /* TIOCNOTTY */
2039 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2040 /*** There is a suggestion that this ought to be a
2041 conditional on TIOCSPGRP,
2042 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
2043 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2044 that system does seem to need this code, even though
2045 both HAVE_SETSID and TIOCSCTTY are defined. */
2046 /* Now close the pty (if we had it open) and reopen it.
2047 This makes the pty the controlling terminal of the subprocess. */
2050 #ifdef SET_CHILD_PTY_PGRP
2051 int pgrp
= getpid ();
2054 /* I wonder if emacs_close (emacs_open (pty_name, ...))
2057 emacs_close (xforkin
);
2058 xforkout
= xforkin
= emacs_open (pty_name
, O_RDWR
, 0);
2062 emacs_write (1, "Couldn't open the pty terminal ", 31);
2063 emacs_write (1, pty_name
, strlen (pty_name
));
2064 emacs_write (1, "\n", 1);
2068 #ifdef SET_CHILD_PTY_PGRP
2069 ioctl (xforkin
, TIOCSPGRP
, &pgrp
);
2070 ioctl (xforkout
, TIOCSPGRP
, &pgrp
);
2073 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
2075 #ifdef SETUP_SLAVE_PTY
2080 #endif /* SETUP_SLAVE_PTY */
2082 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
2083 Now reenable it in the child, so it will die when we want it to. */
2085 signal (SIGHUP
, SIG_DFL
);
2087 #endif /* HAVE_PTYS */
2089 signal (SIGINT
, SIG_DFL
);
2090 signal (SIGQUIT
, SIG_DFL
);
2092 /* Stop blocking signals in the child. */
2093 #ifdef POSIX_SIGNALS
2094 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2095 #else /* !POSIX_SIGNALS */
2099 #else /* not BSD4_1 */
2100 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2101 sigsetmask (SIGEMPTYMASK
);
2102 #else /* ordinary USG */
2104 signal (SIGCHLD
, sigchld
);
2106 #endif /* ordinary USG */
2107 #endif /* not BSD4_1 */
2108 #endif /* SIGCHLD */
2109 #endif /* !POSIX_SIGNALS */
2111 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
2113 child_setup_tty (xforkout
);
2114 #endif /* not RTU and not UNIPLUS and not DONT_REOPEN_PTY */
2116 pid
= child_setup (xforkin
, xforkout
, xforkout
,
2117 new_argv
, 1, current_dir
);
2118 #else /* not WINDOWSNT */
2119 child_setup (xforkin
, xforkout
, xforkout
,
2120 new_argv
, 1, current_dir
);
2121 #endif /* not WINDOWSNT */
2123 environ
= save_environ
;
2128 /* This runs in the Emacs process. */
2132 emacs_close (forkin
);
2133 if (forkin
!= forkout
&& forkout
>= 0)
2134 emacs_close (forkout
);
2138 /* vfork succeeded. */
2139 XPROCESS (process
)->pid
= pid
;
2142 register_child (pid
, inchannel
);
2143 #endif /* WINDOWSNT */
2145 /* If the subfork execv fails, and it exits,
2146 this close hangs. I don't know why.
2147 So have an interrupt jar it loose. */
2149 struct atimer
*timer
;
2153 EMACS_SET_SECS_USECS (offset
, 1, 0);
2154 timer
= start_atimer (ATIMER_RELATIVE
, offset
, create_process_1
, 0);
2157 emacs_close (forkin
);
2159 cancel_atimer (timer
);
2163 if (forkin
!= forkout
&& forkout
>= 0)
2164 emacs_close (forkout
);
2168 XPROCESS (process
)->tty_name
= build_string (pty_name
);
2171 XPROCESS (process
)->tty_name
= Qnil
;
2174 /* Restore the signal state whether vfork succeeded or not.
2175 (We will signal an error, below, if it failed.) */
2176 #ifdef POSIX_SIGNALS
2177 #ifdef HAVE_WORKING_VFORK
2178 /* Restore the parent's signal handlers. */
2179 sigaction (SIGINT
, &sigint_action
, 0);
2180 sigaction (SIGQUIT
, &sigquit_action
, 0);
2182 sigaction (SIGHUP
, &sighup_action
, 0);
2184 #endif /* HAVE_WORKING_VFORK */
2185 /* Stop blocking signals in the parent. */
2186 sigprocmask (SIG_SETMASK
, &procmask
, 0);
2187 #else /* !POSIX_SIGNALS */
2191 #else /* not BSD4_1 */
2192 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
2193 sigsetmask (SIGEMPTYMASK
);
2194 #else /* ordinary USG */
2196 signal (SIGCHLD
, sigchld
);
2197 /* Now really handle any of these signals
2198 that came in during this function. */
2199 if (sigchld_deferred
)
2200 kill (getpid (), SIGCHLD
);
2202 #endif /* ordinary USG */
2203 #endif /* not BSD4_1 */
2204 #endif /* SIGCHLD */
2205 #endif /* !POSIX_SIGNALS */
2207 /* Now generate the error if vfork failed. */
2209 report_file_error ("Doing vfork", Qnil
);
2211 #endif /* not VMS */
2216 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2217 The address family of sa is not included in the result. */
2220 conv_sockaddr_to_lisp (sa
, len
)
2221 struct sockaddr
*sa
;
2224 Lisp_Object address
;
2227 register struct Lisp_Vector
*p
;
2229 switch (sa
->sa_family
)
2233 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2234 len
= sizeof (sin
->sin_addr
) + 1;
2235 address
= Fmake_vector (make_number (len
), Qnil
);
2236 p
= XVECTOR (address
);
2237 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2238 cp
= (unsigned char *)&sin
->sin_addr
;
2244 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2245 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2246 len
= sizeof (sin6
->sin6_addr
)/2 + 1;
2247 address
= Fmake_vector (make_number (len
), Qnil
);
2248 p
= XVECTOR (address
);
2249 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2250 for (i
= 0; i
< len
; i
++)
2251 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2255 #ifdef HAVE_LOCAL_SOCKETS
2258 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2259 for (i
= 0; i
< sizeof (sockun
->sun_path
); i
++)
2260 if (sockun
->sun_path
[i
] == 0)
2262 return make_unibyte_string (sockun
->sun_path
, i
);
2266 len
-= sizeof (sa
->sa_family
);
2267 address
= Fcons (make_number (sa
->sa_family
),
2268 Fmake_vector (make_number (len
), Qnil
));
2269 p
= XVECTOR (XCDR (address
));
2270 cp
= (unsigned char *) sa
+ sizeof (sa
->sa_family
);
2276 p
->contents
[i
++] = make_number (*cp
++);
2282 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2285 get_lisp_to_sockaddr_size (address
, familyp
)
2286 Lisp_Object address
;
2289 register struct Lisp_Vector
*p
;
2291 if (VECTORP (address
))
2293 p
= XVECTOR (address
);
2297 return sizeof (struct sockaddr_in
);
2300 else if (p
->size
== 9)
2302 *familyp
= AF_INET6
;
2303 return sizeof (struct sockaddr_in6
);
2307 #ifdef HAVE_LOCAL_SOCKETS
2308 else if (STRINGP (address
))
2310 *familyp
= AF_LOCAL
;
2311 return sizeof (struct sockaddr_un
);
2314 else if (CONSP (address
) && INTEGERP (XCAR (address
)) && VECTORP (XCDR (address
)))
2316 struct sockaddr
*sa
;
2317 *familyp
= XINT (XCAR (address
));
2318 p
= XVECTOR (XCDR (address
));
2319 return p
->size
+ sizeof (sa
->sa_family
);
2324 /* Convert an address object (vector or string) to an internal sockaddr.
2325 Format of address has already been validated by size_lisp_to_sockaddr. */
2328 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2330 Lisp_Object address
;
2331 struct sockaddr
*sa
;
2334 register struct Lisp_Vector
*p
;
2335 register unsigned char *cp
= NULL
;
2339 sa
->sa_family
= family
;
2341 if (VECTORP (address
))
2343 p
= XVECTOR (address
);
2344 if (family
== AF_INET
)
2346 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2347 len
= sizeof (sin
->sin_addr
) + 1;
2348 i
= XINT (p
->contents
[--len
]);
2349 sin
->sin_port
= htons (i
);
2350 cp
= (unsigned char *)&sin
->sin_addr
;
2353 else if (family
== AF_INET6
)
2355 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2356 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2357 len
= sizeof (sin6
->sin6_addr
) + 1;
2358 i
= XINT (p
->contents
[--len
]);
2359 sin6
->sin6_port
= htons (i
);
2360 for (i
= 0; i
< len
; i
++)
2361 if (INTEGERP (p
->contents
[i
]))
2363 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2370 else if (STRINGP (address
))
2372 #ifdef HAVE_LOCAL_SOCKETS
2373 if (family
== AF_LOCAL
)
2375 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2376 cp
= SDATA (address
);
2377 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2378 sockun
->sun_path
[i
] = *cp
++;
2385 p
= XVECTOR (XCDR (address
));
2386 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2389 for (i
= 0; i
< len
; i
++)
2390 if (INTEGERP (p
->contents
[i
]))
2391 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2394 #ifdef DATAGRAM_SOCKETS
2395 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2397 doc
: /* Get the current datagram address associated with PROCESS. */)
2399 Lisp_Object process
;
2403 CHECK_PROCESS (process
);
2405 if (!DATAGRAM_CONN_P (process
))
2408 channel
= XINT (XPROCESS (process
)->infd
);
2409 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2410 datagram_address
[channel
].len
);
2413 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2415 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2416 Returns nil upon error setting address, ADDRESS otherwise. */)
2418 Lisp_Object process
, address
;
2423 CHECK_PROCESS (process
);
2425 if (!DATAGRAM_CONN_P (process
))
2428 channel
= XINT (XPROCESS (process
)->infd
);
2430 len
= get_lisp_to_sockaddr_size (address
, &family
);
2431 if (datagram_address
[channel
].len
!= len
)
2433 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2439 static struct socket_options
{
2440 /* The name of this option. Should be lowercase version of option
2441 name without SO_ prefix. */
2443 /* Option level SOL_... */
2445 /* Option number SO_... */
2447 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2448 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2449 } socket_options
[] =
2451 #ifdef SO_BINDTODEVICE
2452 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2455 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2458 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2461 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2464 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2467 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2470 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2473 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2475 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2478 /* Set option OPT to value VAL on socket S.
2480 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2481 Signals an error if setting a known option fails.
2485 set_socket_option (s
, opt
, val
)
2487 Lisp_Object opt
, val
;
2490 struct socket_options
*sopt
;
2495 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2496 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2497 if (strcmp (name
, sopt
->name
) == 0)
2500 switch (sopt
->opttype
)
2505 optval
= NILP (val
) ? 0 : 1;
2506 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2507 &optval
, sizeof (optval
));
2515 optval
= XINT (val
);
2517 error ("Bad option value for %s", name
);
2518 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2519 &optval
, sizeof (optval
));
2523 #ifdef SO_BINDTODEVICE
2526 char devname
[IFNAMSIZ
+1];
2528 /* This is broken, at least in the Linux 2.4 kernel.
2529 To unbind, the arg must be a zero integer, not the empty string.
2530 This should work on all systems. KFS. 2003-09-23. */
2531 bzero (devname
, sizeof devname
);
2534 char *arg
= (char *) SDATA (val
);
2535 int len
= min (strlen (arg
), IFNAMSIZ
);
2536 bcopy (arg
, devname
, len
);
2538 else if (!NILP (val
))
2539 error ("Bad option value for %s", name
);
2540 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2549 struct linger linger
;
2552 linger
.l_linger
= 0;
2554 linger
.l_linger
= XINT (val
);
2556 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2557 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2558 &linger
, sizeof (linger
));
2568 report_file_error ("Cannot set network option",
2569 Fcons (opt
, Fcons (val
, Qnil
)));
2570 return (1 << sopt
->optbit
);
2574 DEFUN ("set-network-process-option",
2575 Fset_network_process_option
, Sset_network_process_option
,
2577 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2578 See `make-network-process' for a list of options and values.
2579 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2580 OPTION is not a supported option, return nil instead; otherwise return t. */)
2581 (process
, option
, value
, no_error
)
2582 Lisp_Object process
, option
, value
;
2583 Lisp_Object no_error
;
2586 struct Lisp_Process
*p
;
2588 CHECK_PROCESS (process
);
2589 p
= XPROCESS (process
);
2590 if (!NETCONN1_P (p
))
2591 error ("Process is not a network process");
2595 error ("Process is not running");
2597 if (set_socket_option (s
, option
, value
))
2599 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2603 if (NILP (no_error
))
2604 error ("Unknown or unsupported option");
2610 /* A version of request_sigio suitable for a record_unwind_protect. */
2613 unwind_request_sigio (dummy
)
2616 if (interrupt_input
)
2621 /* Create a network stream/datagram client/server process. Treated
2622 exactly like a normal process when reading and writing. Primary
2623 differences are in status display and process deletion. A network
2624 connection has no PID; you cannot signal it. All you can do is
2625 stop/continue it and deactivate/close it via delete-process */
2627 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2629 doc
: /* Create and return a network server or client process.
2631 In Emacs, network connections are represented by process objects, so
2632 input and output work as for subprocesses and `delete-process' closes
2633 a network connection. However, a network process has no process id,
2634 it cannot be signaled, and the status codes are different from normal
2637 Arguments are specified as keyword/argument pairs. The following
2638 arguments are defined:
2640 :name NAME -- NAME is name for process. It is modified if necessary
2643 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2644 with the process. Process output goes at end of that buffer, unless
2645 you specify an output stream or filter function to handle the output.
2646 BUFFER may be also nil, meaning that this process is not associated
2649 :host HOST -- HOST is name of the host to connect to, or its IP
2650 address. The symbol `local' specifies the local host. If specified
2651 for a server process, it must be a valid name or address for the local
2652 host, and only clients connecting to that address will be accepted.
2654 :service SERVICE -- SERVICE is name of the service desired, or an
2655 integer specifying a port number to connect to. If SERVICE is t,
2656 a random port number is selected for the server.
2658 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2659 stream type connection, `datagram' creates a datagram type connection.
2661 :family FAMILY -- FAMILY is the address (and protocol) family for the
2662 service specified by HOST and SERVICE. The default (nil) is to use
2663 whatever address family (IPv4 or IPv6) that is defined for the host
2664 and port number specified by HOST and SERVICE. Other address families
2666 local -- for a local (i.e. UNIX) address specified by SERVICE.
2667 ipv4 -- use IPv4 address family only.
2668 ipv6 -- use IPv6 address family only.
2670 :local ADDRESS -- ADDRESS is the local address used for the connection.
2671 This parameter is ignored when opening a client process. When specified
2672 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2674 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2675 connection. This parameter is ignored when opening a stream server
2676 process. For a datagram server process, it specifies the initial
2677 setting of the remote datagram address. When specified for a client
2678 process, the FAMILY, HOST, and SERVICE args are ignored.
2680 The format of ADDRESS depends on the address family:
2681 - An IPv4 address is represented as an vector of integers [A B C D P]
2682 corresponding to numeric IP address A.B.C.D and port number P.
2683 - A local address is represented as a string with the address in the
2684 local address space.
2685 - An "unsupported family" address is represented by a cons (F . AV)
2686 where F is the family number and AV is a vector containing the socket
2687 address data with one element per address data byte. Do not rely on
2688 this format in portable code, as it may depend on implementation
2689 defined constants, data sizes, and data structure alignment.
2691 :coding CODING -- If CODING is a symbol, it specifies the coding
2692 system used for both reading and writing for this process. If CODING
2693 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2694 ENCODING is used for writing.
2696 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2697 return without waiting for the connection to complete; instead, the
2698 sentinel function will be called with second arg matching "open" (if
2699 successful) or "failed" when the connect completes. Default is to use
2700 a blocking connect (i.e. wait) for stream type connections.
2702 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2703 running when Emacs is exited.
2705 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2706 In the stopped state, a server process does not accept new
2707 connections, and a client process does not handle incoming traffic.
2708 The stopped state is cleared by `continue-process' and set by
2711 :filter FILTER -- Install FILTER as the process filter.
2713 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2714 process filter are multibyte, otherwise they are unibyte.
2715 If this keyword is not specified, the strings are multibyte iff
2716 `default-enable-multibyte-characters' is non-nil.
2718 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2720 :log LOG -- Install LOG as the server process log function. This
2721 function is called when the server accepts a network connection from a
2722 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2723 is the server process, CLIENT is the new process for the connection,
2724 and MESSAGE is a string.
2726 :plist PLIST -- Install PLIST as the new process' initial plist.
2728 :server QLEN -- if QLEN is non-nil, create a server process for the
2729 specified FAMILY, SERVICE, and connection type (stream or datagram).
2730 If QLEN is an integer, it is used as the max. length of the server's
2731 pending connection queue (also known as the backlog); the default
2732 queue length is 5. Default is to create a client process.
2734 The following network options can be specified for this connection:
2736 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2737 :dontroute BOOL -- Only send to directly connected hosts.
2738 :keepalive BOOL -- Send keep-alive messages on network stream.
2739 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2740 :oobinline BOOL -- Place out-of-band data in receive data stream.
2741 :priority INT -- Set protocol defined priority for sent packets.
2742 :reuseaddr BOOL -- Allow reusing a recently used local address
2743 (this is allowed by default for a server process).
2744 :bindtodevice NAME -- bind to interface NAME. Using this may require
2745 special privileges on some systems.
2747 Consult the relevant system programmer's manual pages for more
2748 information on using these options.
2751 A server process will listen for and accept connections from clients.
2752 When a client connection is accepted, a new network process is created
2753 for the connection with the following parameters:
2755 - The client's process name is constructed by concatenating the server
2756 process' NAME and a client identification string.
2757 - If the FILTER argument is non-nil, the client process will not get a
2758 separate process buffer; otherwise, the client's process buffer is a newly
2759 created buffer named after the server process' BUFFER name or process
2760 NAME concatenated with the client identification string.
2761 - The connection type and the process filter and sentinel parameters are
2762 inherited from the server process' TYPE, FILTER and SENTINEL.
2763 - The client process' contact info is set according to the client's
2764 addressing information (typically an IP address and a port number).
2765 - The client process' plist is initialized from the server's plist.
2767 Notice that the FILTER and SENTINEL args are never used directly by
2768 the server process. Also, the BUFFER argument is not used directly by
2769 the server process, but via the optional :log function, accepted (and
2770 failed) connections may be logged in the server process' buffer.
2772 The original argument list, modified with the actual connection
2773 information, is available via the `process-contact' function.
2775 usage: (make-network-process &rest ARGS) */)
2781 Lisp_Object contact
;
2782 struct Lisp_Process
*p
;
2783 #ifdef HAVE_GETADDRINFO
2784 struct addrinfo ai
, *res
, *lres
;
2785 struct addrinfo hints
;
2786 char *portstring
, portbuf
[128];
2787 #else /* HAVE_GETADDRINFO */
2788 struct _emacs_addrinfo
2794 struct sockaddr
*ai_addr
;
2795 struct _emacs_addrinfo
*ai_next
;
2797 #endif /* HAVE_GETADDRINFO */
2798 struct sockaddr_in address_in
;
2799 #ifdef HAVE_LOCAL_SOCKETS
2800 struct sockaddr_un address_un
;
2805 int s
= -1, outch
, inch
;
2806 struct gcpro gcpro1
;
2807 int count
= SPECPDL_INDEX ();
2809 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2811 Lisp_Object name
, buffer
, host
, service
, address
;
2812 Lisp_Object filter
, sentinel
;
2813 int is_non_blocking_client
= 0;
2814 int is_server
= 0, backlog
= 5;
2821 /* Save arguments for process-contact and clone-process. */
2822 contact
= Flist (nargs
, args
);
2826 /* Ensure socket support is loaded if available. */
2827 init_winsock (TRUE
);
2830 /* :type TYPE (nil: stream, datagram */
2831 tem
= Fplist_get (contact
, QCtype
);
2833 socktype
= SOCK_STREAM
;
2834 #ifdef DATAGRAM_SOCKETS
2835 else if (EQ (tem
, Qdatagram
))
2836 socktype
= SOCK_DGRAM
;
2839 error ("Unsupported connection type");
2842 tem
= Fplist_get (contact
, QCserver
);
2845 /* Don't support network sockets when non-blocking mode is
2846 not available, since a blocked Emacs is not useful. */
2847 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2848 error ("Network servers not supported");
2852 backlog
= XINT (tem
);
2856 /* Make QCaddress an alias for :local (server) or :remote (client). */
2857 QCaddress
= is_server
? QClocal
: QCremote
;
2860 if (!is_server
&& socktype
== SOCK_STREAM
2861 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2863 #ifndef NON_BLOCKING_CONNECT
2864 error ("Non-blocking connect not supported");
2866 is_non_blocking_client
= 1;
2870 name
= Fplist_get (contact
, QCname
);
2871 buffer
= Fplist_get (contact
, QCbuffer
);
2872 filter
= Fplist_get (contact
, QCfilter
);
2873 sentinel
= Fplist_get (contact
, QCsentinel
);
2875 CHECK_STRING (name
);
2878 /* Let's handle TERM before things get complicated ... */
2879 host
= Fplist_get (contact
, QChost
);
2880 CHECK_STRING (host
);
2882 service
= Fplist_get (contact
, QCservice
);
2883 if (INTEGERP (service
))
2884 port
= htons ((unsigned short) XINT (service
));
2887 struct servent
*svc_info
;
2888 CHECK_STRING (service
);
2889 svc_info
= getservbyname (SDATA (service
), "tcp");
2891 error ("Unknown service: %s", SDATA (service
));
2892 port
= svc_info
->s_port
;
2895 s
= connect_server (0);
2897 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2898 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2899 send_command (s
, C_DUMB
, 1, 0);
2901 #else /* not TERM */
2903 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2904 ai
.ai_socktype
= socktype
;
2909 /* :local ADDRESS or :remote ADDRESS */
2910 address
= Fplist_get (contact
, QCaddress
);
2911 if (!NILP (address
))
2913 host
= service
= Qnil
;
2915 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2916 error ("Malformed :address");
2917 ai
.ai_family
= family
;
2918 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2919 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2923 /* :family FAMILY -- nil (for Inet), local, or integer. */
2924 tem
= Fplist_get (contact
, QCfamily
);
2927 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
2933 #ifdef HAVE_LOCAL_SOCKETS
2934 else if (EQ (tem
, Qlocal
))
2938 else if (EQ (tem
, Qipv6
))
2941 else if (EQ (tem
, Qipv4
))
2943 else if (INTEGERP (tem
))
2944 family
= XINT (tem
);
2946 error ("Unknown address family");
2948 ai
.ai_family
= family
;
2950 /* :service SERVICE -- string, integer (port number), or t (random port). */
2951 service
= Fplist_get (contact
, QCservice
);
2953 #ifdef HAVE_LOCAL_SOCKETS
2954 if (family
== AF_LOCAL
)
2956 /* Host is not used. */
2958 CHECK_STRING (service
);
2959 bzero (&address_un
, sizeof address_un
);
2960 address_un
.sun_family
= AF_LOCAL
;
2961 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
2962 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
2963 ai
.ai_addrlen
= sizeof address_un
;
2968 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2969 host
= Fplist_get (contact
, QChost
);
2972 if (EQ (host
, Qlocal
))
2973 host
= build_string ("localhost");
2974 CHECK_STRING (host
);
2977 /* Slow down polling to every ten seconds.
2978 Some kernels have a bug which causes retrying connect to fail
2979 after a connect. Polling can interfere with gethostbyname too. */
2980 #ifdef POLL_FOR_INPUT
2981 if (socktype
== SOCK_STREAM
)
2983 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
2984 bind_polling_period (10);
2988 #ifdef HAVE_GETADDRINFO
2989 /* If we have a host, use getaddrinfo to resolve both host and service.
2990 Otherwise, use getservbyname to lookup the service. */
2994 /* SERVICE can either be a string or int.
2995 Convert to a C string for later use by getaddrinfo. */
2996 if (EQ (service
, Qt
))
2998 else if (INTEGERP (service
))
3000 sprintf (portbuf
, "%ld", (long) XINT (service
));
3001 portstring
= portbuf
;
3005 CHECK_STRING (service
);
3006 portstring
= SDATA (service
);
3011 memset (&hints
, 0, sizeof (hints
));
3013 hints
.ai_family
= family
;
3014 hints
.ai_socktype
= socktype
;
3015 hints
.ai_protocol
= 0;
3016 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3018 #ifdef HAVE_GAI_STRERROR
3019 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
3021 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3027 #endif /* HAVE_GETADDRINFO */
3029 /* We end up here if getaddrinfo is not defined, or in case no hostname
3030 has been specified (e.g. for a local server process). */
3032 if (EQ (service
, Qt
))
3034 else if (INTEGERP (service
))
3035 port
= htons ((unsigned short) XINT (service
));
3038 struct servent
*svc_info
;
3039 CHECK_STRING (service
);
3040 svc_info
= getservbyname (SDATA (service
),
3041 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3043 error ("Unknown service: %s", SDATA (service
));
3044 port
= svc_info
->s_port
;
3047 bzero (&address_in
, sizeof address_in
);
3048 address_in
.sin_family
= family
;
3049 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3050 address_in
.sin_port
= port
;
3052 #ifndef HAVE_GETADDRINFO
3055 struct hostent
*host_info_ptr
;
3057 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3058 as it may `hang' Emacs for a very long time. */
3061 host_info_ptr
= gethostbyname (SDATA (host
));
3066 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
3067 host_info_ptr
->h_length
);
3068 family
= host_info_ptr
->h_addrtype
;
3069 address_in
.sin_family
= family
;
3072 /* Attempt to interpret host as numeric inet address */
3074 IN_ADDR numeric_addr
;
3075 numeric_addr
= inet_addr ((char *) SDATA (host
));
3076 if (NUMERIC_ADDR_ERROR
)
3077 error ("Unknown host \"%s\"", SDATA (host
));
3079 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
3080 sizeof (address_in
.sin_addr
));
3084 #endif /* not HAVE_GETADDRINFO */
3086 ai
.ai_family
= family
;
3087 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3088 ai
.ai_addrlen
= sizeof address_in
;
3092 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
3093 when connect is interrupted. So let's not let it get interrupted.
3094 Note we do not turn off polling, because polling is only used
3095 when not interrupt_input, and thus not normally used on the systems
3096 which have this bug. On systems which use polling, there's no way
3097 to quit if polling is turned off. */
3099 && !is_server
&& socktype
== SOCK_STREAM
)
3101 /* Comment from KFS: The original open-network-stream code
3102 didn't unwind protect this, but it seems like the proper
3103 thing to do. In any case, I don't see how it could harm to
3104 do this -- and it makes cleanup (using unbind_to) easier. */
3105 record_unwind_protect (unwind_request_sigio
, Qnil
);
3109 /* Do this in case we never enter the for-loop below. */
3110 count1
= SPECPDL_INDEX ();
3113 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3119 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3126 #ifdef DATAGRAM_SOCKETS
3127 if (!is_server
&& socktype
== SOCK_DGRAM
)
3129 #endif /* DATAGRAM_SOCKETS */
3131 #ifdef NON_BLOCKING_CONNECT
3132 if (is_non_blocking_client
)
3135 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3137 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3149 /* Make us close S if quit. */
3150 record_unwind_protect (close_file_unwind
, make_number (s
));
3152 /* Parse network options in the arg list.
3153 We simply ignore anything which isn't a known option (including other keywords).
3154 An error is signalled if setting a known option fails. */
3155 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3156 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3160 /* Configure as a server socket. */
3162 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3163 explicit :reuseaddr key to override this. */
3164 #ifdef HAVE_LOCAL_SOCKETS
3165 if (family
!= AF_LOCAL
)
3167 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3170 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3171 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3174 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3175 report_file_error ("Cannot bind server socket", Qnil
);
3177 #ifdef HAVE_GETSOCKNAME
3178 if (EQ (service
, Qt
))
3180 struct sockaddr_in sa1
;
3181 int len1
= sizeof (sa1
);
3182 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3184 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3185 service
= make_number (ntohs (sa1
.sin_port
));
3186 contact
= Fplist_put (contact
, QCservice
, service
);
3191 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3192 report_file_error ("Cannot listen on server socket", Qnil
);
3200 /* This turns off all alarm-based interrupts; the
3201 bind_polling_period call above doesn't always turn all the
3202 short-interval ones off, especially if interrupt_input is
3205 It'd be nice to be able to control the connect timeout
3206 though. Would non-blocking connect calls be portable?
3208 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3210 turn_on_atimers (0);
3212 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3215 turn_on_atimers (1);
3217 if (ret
== 0 || xerrno
== EISCONN
)
3219 /* The unwind-protect will be discarded afterwards.
3220 Likewise for immediate_quit. */
3224 #ifdef NON_BLOCKING_CONNECT
3226 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3230 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3238 /* Discard the unwind protect closing S. */
3239 specpdl_ptr
= specpdl
+ count1
;
3243 if (xerrno
== EINTR
)
3249 #ifdef DATAGRAM_SOCKETS
3250 if (socktype
== SOCK_DGRAM
)
3252 if (datagram_address
[s
].sa
)
3254 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3255 datagram_address
[s
].len
= lres
->ai_addrlen
;
3259 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3260 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3263 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3264 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3265 conv_lisp_to_sockaddr (rfamily
, remote
,
3266 datagram_address
[s
].sa
, rlen
);
3270 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3273 contact
= Fplist_put (contact
, QCaddress
,
3274 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3275 #ifdef HAVE_GETSOCKNAME
3278 struct sockaddr_in sa1
;
3279 int len1
= sizeof (sa1
);
3280 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3281 contact
= Fplist_put (contact
, QClocal
,
3282 conv_sockaddr_to_lisp (&sa1
, len1
));
3287 #ifdef HAVE_GETADDRINFO
3294 /* Discard the unwind protect for closing S, if any. */
3295 specpdl_ptr
= specpdl
+ count1
;
3297 /* Unwind bind_polling_period and request_sigio. */
3298 unbind_to (count
, Qnil
);
3302 /* If non-blocking got this far - and failed - assume non-blocking is
3303 not supported after all. This is probably a wrong assumption, but
3304 the normal blocking calls to open-network-stream handles this error
3306 if (is_non_blocking_client
)
3311 report_file_error ("make server process failed", contact
);
3313 report_file_error ("make client process failed", contact
);
3316 #endif /* not TERM */
3322 buffer
= Fget_buffer_create (buffer
);
3323 proc
= make_process (name
);
3325 chan_process
[inch
] = proc
;
3328 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3331 fcntl (inch
, F_SETFL
, O_NDELAY
);
3335 p
= XPROCESS (proc
);
3337 p
->childp
= contact
;
3338 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3341 p
->sentinel
= sentinel
;
3343 p
->filter_multibyte
= buffer_defaults
.enable_multibyte_characters
;
3344 /* Override the above only if :filter-multibyte is specified. */
3345 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3346 p
->filter_multibyte
= Fplist_get (contact
, QCfilter_multibyte
);
3347 p
->log
= Fplist_get (contact
, QClog
);
3348 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3349 p
->kill_without_query
= Qt
;
3350 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3353 XSETINT (p
->infd
, inch
);
3354 XSETINT (p
->outfd
, outch
);
3355 if (is_server
&& socktype
== SOCK_STREAM
)
3356 p
->status
= Qlisten
;
3358 /* Make the process marker point into the process buffer (if any). */
3359 if (BUFFERP (buffer
))
3360 set_marker_both (p
->mark
, buffer
,
3361 BUF_ZV (XBUFFER (buffer
)),
3362 BUF_ZV_BYTE (XBUFFER (buffer
)));
3364 #ifdef NON_BLOCKING_CONNECT
3365 if (is_non_blocking_client
)
3367 /* We may get here if connect did succeed immediately. However,
3368 in that case, we still need to signal this like a non-blocking
3370 p
->status
= Qconnect
;
3371 if (!FD_ISSET (inch
, &connect_wait_mask
))
3373 FD_SET (inch
, &connect_wait_mask
);
3374 num_pending_connects
++;
3379 /* A server may have a client filter setting of Qt, but it must
3380 still listen for incoming connects unless it is stopped. */
3381 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3382 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3384 FD_SET (inch
, &input_wait_mask
);
3385 FD_SET (inch
, &non_keyboard_wait_mask
);
3388 if (inch
> max_process_desc
)
3389 max_process_desc
= inch
;
3391 tem
= Fplist_member (contact
, QCcoding
);
3392 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3393 tem
= Qnil
; /* No error message (too late!). */
3396 /* Setup coding systems for communicating with the network stream. */
3397 struct gcpro gcpro1
;
3398 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3399 Lisp_Object coding_systems
= Qt
;
3400 Lisp_Object args
[5], val
;
3404 val
= XCAR (XCDR (tem
));
3408 else if (!NILP (Vcoding_system_for_read
))
3409 val
= Vcoding_system_for_read
;
3410 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3411 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3412 /* We dare not decode end-of-line format by setting VAL to
3413 Qraw_text, because the existing Emacs Lisp libraries
3414 assume that they receive bare code including a sequene of
3419 if (NILP (host
) || NILP (service
))
3420 coding_systems
= Qnil
;
3423 args
[0] = Qopen_network_stream
, args
[1] = name
,
3424 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3426 coding_systems
= Ffind_operation_coding_system (5, args
);
3429 if (CONSP (coding_systems
))
3430 val
= XCAR (coding_systems
);
3431 else if (CONSP (Vdefault_process_coding_system
))
3432 val
= XCAR (Vdefault_process_coding_system
);
3436 p
->decode_coding_system
= val
;
3440 val
= XCAR (XCDR (tem
));
3444 else if (!NILP (Vcoding_system_for_write
))
3445 val
= Vcoding_system_for_write
;
3446 else if (NILP (current_buffer
->enable_multibyte_characters
))
3450 if (EQ (coding_systems
, Qt
))
3452 if (NILP (host
) || NILP (service
))
3453 coding_systems
= Qnil
;
3456 args
[0] = Qopen_network_stream
, args
[1] = name
,
3457 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3459 coding_systems
= Ffind_operation_coding_system (5, args
);
3463 if (CONSP (coding_systems
))
3464 val
= XCDR (coding_systems
);
3465 else if (CONSP (Vdefault_process_coding_system
))
3466 val
= XCDR (Vdefault_process_coding_system
);
3470 p
->encode_coding_system
= val
;
3472 setup_process_coding_systems (proc
);
3474 p
->decoding_buf
= make_uninit_string (0);
3475 p
->decoding_carryover
= make_number (0);
3476 p
->encoding_buf
= make_uninit_string (0);
3477 p
->encoding_carryover
= make_number (0);
3479 p
->inherit_coding_system_flag
3480 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3486 #endif /* HAVE_SOCKETS */
3489 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3492 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3493 doc
: /* Return an alist of all network interfaces and their network address.
3494 Each element is a cons, the car of which is a string containing the
3495 interface name, and the cdr is the network address in internal
3496 format; see the description of ADDRESS in `make-network-process'. */)
3499 struct ifconf ifconf
;
3500 struct ifreq
*ifreqs
= NULL
;
3505 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3511 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3512 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3519 ifconf
.ifc_len
= buf_size
;
3520 ifconf
.ifc_req
= ifreqs
;
3521 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3527 if (ifconf
.ifc_len
== buf_size
)
3531 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3534 while (--ifaces
>= 0)
3536 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3537 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3538 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3540 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3541 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3542 res
= Fcons (Fcons (build_string (namebuf
),
3543 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3544 sizeof (struct sockaddr
))),
3550 #endif /* SIOCGIFCONF */
3552 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3559 static struct ifflag_def ifflag_table
[] = {
3563 #ifdef IFF_BROADCAST
3564 { IFF_BROADCAST
, "broadcast" },
3567 { IFF_DEBUG
, "debug" },
3570 { IFF_LOOPBACK
, "loopback" },
3572 #ifdef IFF_POINTOPOINT
3573 { IFF_POINTOPOINT
, "pointopoint" },
3576 { IFF_RUNNING
, "running" },
3579 { IFF_NOARP
, "noarp" },
3582 { IFF_PROMISC
, "promisc" },
3584 #ifdef IFF_NOTRAILERS
3585 { IFF_NOTRAILERS
, "notrailers" },
3588 { IFF_ALLMULTI
, "allmulti" },
3591 { IFF_MASTER
, "master" },
3594 { IFF_SLAVE
, "slave" },
3596 #ifdef IFF_MULTICAST
3597 { IFF_MULTICAST
, "multicast" },
3600 { IFF_PORTSEL
, "portsel" },
3602 #ifdef IFF_AUTOMEDIA
3603 { IFF_AUTOMEDIA
, "automedia" },
3606 { IFF_DYNAMIC
, "dynamic" },
3609 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3612 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3615 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3618 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3621 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3626 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3627 doc
: /* Return information about network interface named IFNAME.
3628 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3629 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3630 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3631 FLAGS is the current flags of the interface. */)
3636 Lisp_Object res
= Qnil
;
3641 CHECK_STRING (ifname
);
3643 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3644 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3646 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3651 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3652 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3654 int flags
= rq
.ifr_flags
;
3655 struct ifflag_def
*fp
;
3659 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3661 if (flags
& fp
->flag_bit
)
3663 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3664 flags
-= fp
->flag_bit
;
3667 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3669 if (flags
& (1 << fnum
))
3671 elt
= Fcons (make_number (fnum
), elt
);
3676 res
= Fcons (elt
, res
);
3679 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3680 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3682 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3683 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3687 for (n
= 0; n
< 6; n
++)
3688 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3689 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3692 res
= Fcons (elt
, res
);
3695 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
3696 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3699 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3700 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3702 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3706 res
= Fcons (elt
, res
);
3709 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3710 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3713 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3716 res
= Fcons (elt
, res
);
3719 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3720 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3723 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3726 res
= Fcons (elt
, res
);
3730 return any
? res
: Qnil
;
3733 #endif /* HAVE_SOCKETS */
3735 /* Turn off input and output for process PROC. */
3738 deactivate_process (proc
)
3741 register int inchannel
, outchannel
;
3742 register struct Lisp_Process
*p
= XPROCESS (proc
);
3744 inchannel
= XINT (p
->infd
);
3745 outchannel
= XINT (p
->outfd
);
3747 #ifdef ADAPTIVE_READ_BUFFERING
3748 if (XINT (p
->read_output_delay
) > 0)
3750 if (--process_output_delay_count
< 0)
3751 process_output_delay_count
= 0;
3752 XSETINT (p
->read_output_delay
, 0);
3753 p
->read_output_skip
= Qnil
;
3759 /* Beware SIGCHLD hereabouts. */
3760 flush_pending_output (inchannel
);
3763 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3764 sys$
dassgn (outchannel
);
3765 vs
= get_vms_process_pointer (p
->pid
);
3767 give_back_vms_process_stuff (vs
);
3770 emacs_close (inchannel
);
3771 if (outchannel
>= 0 && outchannel
!= inchannel
)
3772 emacs_close (outchannel
);
3775 XSETINT (p
->infd
, -1);
3776 XSETINT (p
->outfd
, -1);
3777 #ifdef DATAGRAM_SOCKETS
3778 if (DATAGRAM_CHAN_P (inchannel
))
3780 xfree (datagram_address
[inchannel
].sa
);
3781 datagram_address
[inchannel
].sa
= 0;
3782 datagram_address
[inchannel
].len
= 0;
3785 chan_process
[inchannel
] = Qnil
;
3786 FD_CLR (inchannel
, &input_wait_mask
);
3787 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3788 #ifdef NON_BLOCKING_CONNECT
3789 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3791 FD_CLR (inchannel
, &connect_wait_mask
);
3792 if (--num_pending_connects
< 0)
3796 if (inchannel
== max_process_desc
)
3799 /* We just closed the highest-numbered process input descriptor,
3800 so recompute the highest-numbered one now. */
3801 max_process_desc
= 0;
3802 for (i
= 0; i
< MAXDESC
; i
++)
3803 if (!NILP (chan_process
[i
]))
3804 max_process_desc
= i
;
3809 /* Close all descriptors currently in use for communication
3810 with subprocess. This is used in a newly-forked subprocess
3811 to get rid of irrelevant descriptors. */
3814 close_process_descs ()
3818 for (i
= 0; i
< MAXDESC
; i
++)
3820 Lisp_Object process
;
3821 process
= chan_process
[i
];
3822 if (!NILP (process
))
3824 int in
= XINT (XPROCESS (process
)->infd
);
3825 int out
= XINT (XPROCESS (process
)->outfd
);
3828 if (out
>= 0 && in
!= out
)
3835 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3837 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3838 It is read into the process' buffers or given to their filter functions.
3839 Non-nil arg PROCESS means do not return until some output has been received
3842 Non-nil second arg SECONDS and third arg MILLISEC are number of
3843 seconds and milliseconds to wait; return after that much time whether
3844 or not there is input. If SECONDS is a floating point number,
3845 it specifies a fractional number of seconds to wait.
3847 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3848 from PROCESS, suspending reading output from other processes.
3849 If JUST-THIS-ONE is an integer, don't run any timers either.
3850 Return non-nil iff we received any output before the timeout expired. */)
3851 (process
, seconds
, millisec
, just_this_one
)
3852 register Lisp_Object process
, seconds
, millisec
, just_this_one
;
3854 int secs
, usecs
= 0;
3856 if (! NILP (process
))
3857 CHECK_PROCESS (process
);
3859 just_this_one
= Qnil
;
3861 if (!NILP (seconds
))
3863 if (INTEGERP (seconds
))
3864 secs
= XINT (seconds
);
3865 else if (FLOATP (seconds
))
3867 double timeout
= XFLOAT_DATA (seconds
);
3868 secs
= (int) timeout
;
3869 usecs
= (int) ((timeout
- (double) secs
) * 1000000);
3872 wrong_type_argument (Qnumberp
, seconds
);
3874 if (INTEGERP (millisec
))
3877 usecs
+= XINT (millisec
) * 1000;
3878 carry
= usecs
/ 1000000;
3880 if ((usecs
-= carry
* 1000000) < 0)
3887 if (secs
< 0 || (secs
== 0 && usecs
== 0))
3888 secs
= -1, usecs
= 0;
3891 secs
= NILP (process
) ? -1 : 0;
3894 (wait_reading_process_output (secs
, usecs
, 0, 0,
3896 !NILP (process
) ? XPROCESS (process
) : NULL
,
3897 NILP (just_this_one
) ? 0 :
3898 !INTEGERP (just_this_one
) ? 1 : -1)
3902 /* Accept a connection for server process SERVER on CHANNEL. */
3904 static int connect_counter
= 0;
3907 server_accept_connection (server
, channel
)
3911 Lisp_Object proc
, caller
, name
, buffer
;
3912 Lisp_Object contact
, host
, service
;
3913 struct Lisp_Process
*ps
= XPROCESS (server
);
3914 struct Lisp_Process
*p
;
3918 struct sockaddr_in in
;
3920 struct sockaddr_in6 in6
;
3922 #ifdef HAVE_LOCAL_SOCKETS
3923 struct sockaddr_un un
;
3926 int len
= sizeof saddr
;
3928 s
= accept (channel
, &saddr
.sa
, &len
);
3937 if (code
== EWOULDBLOCK
)
3941 if (!NILP (ps
->log
))
3942 call3 (ps
->log
, server
, Qnil
,
3943 concat3 (build_string ("accept failed with code"),
3944 Fnumber_to_string (make_number (code
)),
3945 build_string ("\n")));
3951 /* Setup a new process to handle the connection. */
3953 /* Generate a unique identification of the caller, and build contact
3954 information for this process. */
3957 switch (saddr
.sa
.sa_family
)
3961 Lisp_Object args
[5];
3962 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
3963 args
[0] = build_string ("%d.%d.%d.%d");
3964 args
[1] = make_number (*ip
++);
3965 args
[2] = make_number (*ip
++);
3966 args
[3] = make_number (*ip
++);
3967 args
[4] = make_number (*ip
++);
3968 host
= Fformat (5, args
);
3969 service
= make_number (ntohs (saddr
.in
.sin_port
));
3971 args
[0] = build_string (" <%s:%d>");
3974 caller
= Fformat (3, args
);
3981 Lisp_Object args
[9];
3982 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
3984 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
3985 for (i
= 0; i
< 8; i
++)
3986 args
[i
+1] = make_number (ntohs(ip6
[i
]));
3987 host
= Fformat (9, args
);
3988 service
= make_number (ntohs (saddr
.in
.sin_port
));
3990 args
[0] = build_string (" <[%s]:%d>");
3993 caller
= Fformat (3, args
);
3998 #ifdef HAVE_LOCAL_SOCKETS
4002 caller
= Fnumber_to_string (make_number (connect_counter
));
4003 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
4007 /* Create a new buffer name for this process if it doesn't have a
4008 filter. The new buffer name is based on the buffer name or
4009 process name of the server process concatenated with the caller
4012 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4016 buffer
= ps
->buffer
;
4018 buffer
= Fbuffer_name (buffer
);
4023 buffer
= concat2 (buffer
, caller
);
4024 buffer
= Fget_buffer_create (buffer
);
4028 /* Generate a unique name for the new server process. Combine the
4029 server process name with the caller identification. */
4031 name
= concat2 (ps
->name
, caller
);
4032 proc
= make_process (name
);
4034 chan_process
[s
] = proc
;
4037 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4040 fcntl (s
, F_SETFL
, O_NDELAY
);
4044 p
= XPROCESS (proc
);
4046 /* Build new contact information for this setup. */
4047 contact
= Fcopy_sequence (ps
->childp
);
4048 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4049 contact
= Fplist_put (contact
, QChost
, host
);
4050 if (!NILP (service
))
4051 contact
= Fplist_put (contact
, QCservice
, service
);
4052 contact
= Fplist_put (contact
, QCremote
,
4053 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4054 #ifdef HAVE_GETSOCKNAME
4056 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4057 contact
= Fplist_put (contact
, QClocal
,
4058 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4061 p
->childp
= contact
;
4062 p
->plist
= Fcopy_sequence (ps
->plist
);
4065 p
->sentinel
= ps
->sentinel
;
4066 p
->filter
= ps
->filter
;
4069 XSETINT (p
->infd
, s
);
4070 XSETINT (p
->outfd
, s
);
4073 /* Client processes for accepted connections are not stopped initially. */
4074 if (!EQ (p
->filter
, Qt
))
4076 FD_SET (s
, &input_wait_mask
);
4077 FD_SET (s
, &non_keyboard_wait_mask
);
4080 if (s
> max_process_desc
)
4081 max_process_desc
= s
;
4083 /* Setup coding system for new process based on server process.
4084 This seems to be the proper thing to do, as the coding system
4085 of the new process should reflect the settings at the time the
4086 server socket was opened; not the current settings. */
4088 p
->decode_coding_system
= ps
->decode_coding_system
;
4089 p
->encode_coding_system
= ps
->encode_coding_system
;
4090 setup_process_coding_systems (proc
);
4092 p
->decoding_buf
= make_uninit_string (0);
4093 p
->decoding_carryover
= make_number (0);
4094 p
->encoding_buf
= make_uninit_string (0);
4095 p
->encoding_carryover
= make_number (0);
4097 p
->inherit_coding_system_flag
4098 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
4100 if (!NILP (ps
->log
))
4101 call3 (ps
->log
, server
, proc
,
4102 concat3 (build_string ("accept from "),
4103 (STRINGP (host
) ? host
: build_string ("-")),
4104 build_string ("\n")));
4106 if (!NILP (p
->sentinel
))
4107 exec_sentinel (proc
,
4108 concat3 (build_string ("open from "),
4109 (STRINGP (host
) ? host
: build_string ("-")),
4110 build_string ("\n")));
4113 /* This variable is different from waiting_for_input in keyboard.c.
4114 It is used to communicate to a lisp process-filter/sentinel (via the
4115 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4116 for user-input when that process-filter was called.
4117 waiting_for_input cannot be used as that is by definition 0 when
4118 lisp code is being evalled.
4119 This is also used in record_asynch_buffer_change.
4120 For that purpose, this must be 0
4121 when not inside wait_reading_process_output. */
4122 static int waiting_for_user_input_p
;
4124 /* This is here so breakpoints can be put on it. */
4126 wait_reading_process_output_1 ()
4130 /* Read and dispose of subprocess output while waiting for timeout to
4131 elapse and/or keyboard input to be available.
4134 timeout in seconds, or
4135 zero for no limit, or
4136 -1 means gobble data immediately available but don't wait for any.
4139 an additional duration to wait, measured in microseconds.
4140 If this is nonzero and time_limit is 0, then the timeout
4141 consists of MICROSECS only.
4143 READ_KBD is a lisp value:
4144 0 to ignore keyboard input, or
4145 1 to return when input is available, or
4146 -1 meaning caller will actually read the input, so don't throw to
4147 the quit handler, or
4149 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4150 output that arrives.
4152 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4153 (and gobble terminal input into the buffer if any arrives).
4155 If WAIT_PROC is specified, wait until something arrives from that
4156 process. The return value is true iff we read some input from
4159 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4160 (suspending output from other processes). A negative value
4161 means don't run any timers either.
4163 If WAIT_PROC is specified, then the function returns true iff we
4164 received input from that process before the timeout elapsed.
4165 Otherwise, return true iff we received input from any process. */
4168 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
4169 wait_for_cell
, wait_proc
, just_wait_proc
)
4170 int time_limit
, microsecs
, read_kbd
, do_display
;
4171 Lisp_Object wait_for_cell
;
4172 struct Lisp_Process
*wait_proc
;
4175 register int channel
, nfds
;
4176 SELECT_TYPE Available
;
4177 #ifdef NON_BLOCKING_CONNECT
4178 SELECT_TYPE Connecting
;
4181 int check_delay
, no_avail
;
4184 EMACS_TIME timeout
, end_time
;
4185 int wait_channel
= -1;
4186 int got_some_input
= 0;
4187 /* Either nil or a cons cell, the car of which is of interest and
4188 may be changed outside of this routine. */
4189 int saved_waiting_for_user_input_p
= waiting_for_user_input_p
;
4191 FD_ZERO (&Available
);
4192 #ifdef NON_BLOCKING_CONNECT
4193 FD_ZERO (&Connecting
);
4196 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4197 if (wait_proc
!= NULL
)
4198 wait_channel
= XINT (wait_proc
->infd
);
4200 waiting_for_user_input_p
= read_kbd
;
4202 /* Since we may need to wait several times,
4203 compute the absolute time to return at. */
4204 if (time_limit
|| microsecs
)
4206 EMACS_GET_TIME (end_time
);
4207 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4208 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4210 #ifdef POLL_INTERRUPTED_SYS_CALL
4211 /* AlainF 5-Jul-1996
4212 HP-UX 10.10 seem to have problems with signals coming in
4213 Causes "poll: interrupted system call" messages when Emacs is run
4215 Turn off periodic alarms (in case they are in use),
4216 and then turn off any other atimers. */
4218 turn_on_atimers (0);
4219 #endif /* POLL_INTERRUPTED_SYS_CALL */
4223 int timeout_reduced_for_timers
= 0;
4225 /* If calling from keyboard input, do not quit
4226 since we want to return C-g as an input character.
4227 Otherwise, do pending quit if requested. */
4231 else if (interrupt_input_pending
)
4232 handle_async_input ();
4235 /* Exit now if the cell we're waiting for became non-nil. */
4236 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4239 /* Compute time from now till when time limit is up */
4240 /* Exit if already run out */
4241 if (time_limit
== -1)
4243 /* -1 specified for timeout means
4244 gobble output available now
4245 but don't wait at all. */
4247 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4249 else if (time_limit
|| microsecs
)
4251 EMACS_GET_TIME (timeout
);
4252 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4253 if (EMACS_TIME_NEG_P (timeout
))
4258 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4261 /* Normally we run timers here.
4262 But not if wait_for_cell; in those cases,
4263 the wait is supposed to be short,
4264 and those callers cannot handle running arbitrary Lisp code here. */
4265 if (NILP (wait_for_cell
)
4266 && just_wait_proc
>= 0)
4268 EMACS_TIME timer_delay
;
4272 int old_timers_run
= timers_run
;
4273 struct buffer
*old_buffer
= current_buffer
;
4275 timer_delay
= timer_check (1);
4277 /* If a timer has run, this might have changed buffers
4278 an alike. Make read_key_sequence aware of that. */
4279 if (timers_run
!= old_timers_run
4280 && old_buffer
!= current_buffer
4281 && waiting_for_user_input_p
== -1)
4282 record_asynch_buffer_change ();
4284 if (timers_run
!= old_timers_run
&& do_display
)
4285 /* We must retry, since a timer may have requeued itself
4286 and that could alter the time_delay. */
4287 redisplay_preserve_echo_area (9);
4291 while (!detect_input_pending ());
4293 /* If there is unread keyboard input, also return. */
4295 && requeued_events_pending_p ())
4298 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4300 EMACS_TIME difference
;
4301 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4302 if (EMACS_TIME_NEG_P (difference
))
4304 timeout
= timer_delay
;
4305 timeout_reduced_for_timers
= 1;
4308 /* If time_limit is -1, we are not going to wait at all. */
4309 else if (time_limit
!= -1)
4311 /* This is so a breakpoint can be put here. */
4312 wait_reading_process_output_1 ();
4316 /* Cause C-g and alarm signals to take immediate action,
4317 and cause input available signals to zero out timeout.
4319 It is important that we do this before checking for process
4320 activity. If we get a SIGCHLD after the explicit checks for
4321 process activity, timeout is the only way we will know. */
4323 set_waiting_for_input (&timeout
);
4325 /* If status of something has changed, and no input is
4326 available, notify the user of the change right away. After
4327 this explicit check, we'll let the SIGCHLD handler zap
4328 timeout to get our attention. */
4329 if (update_tick
!= process_tick
&& do_display
)
4332 #ifdef NON_BLOCKING_CONNECT
4336 Atemp
= input_wait_mask
;
4338 /* On Mac OS X 10.0, the SELECT system call always says input is
4339 present (for reading) at stdin, even when none is. This
4340 causes the call to SELECT below to return 1 and
4341 status_notify not to be called. As a result output of
4342 subprocesses are incorrectly discarded.
4346 IF_NON_BLOCKING_CONNECT (Ctemp
= connect_wait_mask
);
4348 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4349 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
4351 #ifdef NON_BLOCKING_CONNECT
4352 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4356 (SELECT_TYPE
*)0, &timeout
)
4359 /* It's okay for us to do this and then continue with
4360 the loop, since timeout has already been zeroed out. */
4361 clear_waiting_for_input ();
4362 status_notify (NULL
);
4366 /* Don't wait for output from a non-running process. Just
4367 read whatever data has already been received. */
4368 if (wait_proc
&& wait_proc
->raw_status_new
)
4369 update_status (wait_proc
);
4371 && ! EQ (wait_proc
->status
, Qrun
)
4372 && ! EQ (wait_proc
->status
, Qconnect
))
4374 int nread
, total_nread
= 0;
4376 clear_waiting_for_input ();
4377 XSETPROCESS (proc
, wait_proc
);
4379 /* Read data from the process, until we exhaust it. */
4380 while (XINT (wait_proc
->infd
) >= 0)
4382 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
4388 total_nread
+= nread
;
4390 else if (nread
== -1 && EIO
== errno
)
4394 else if (nread
== -1 && EAGAIN
== errno
)
4398 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4402 if (total_nread
> 0 && do_display
)
4403 redisplay_preserve_echo_area (10);
4408 /* Wait till there is something to do */
4410 if (wait_proc
&& just_wait_proc
)
4412 if (XINT (wait_proc
->infd
) < 0) /* Terminated */
4414 FD_SET (XINT (wait_proc
->infd
), &Available
);
4416 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4418 else if (!NILP (wait_for_cell
))
4420 Available
= non_process_wait_mask
;
4422 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4427 Available
= non_keyboard_wait_mask
;
4429 Available
= input_wait_mask
;
4430 IF_NON_BLOCKING_CONNECT (check_connect
= (num_pending_connects
> 0));
4431 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4434 /* If frame size has changed or the window is newly mapped,
4435 redisplay now, before we start to wait. There is a race
4436 condition here; if a SIGIO arrives between now and the select
4437 and indicates that a frame is trashed, the select may block
4438 displaying a trashed screen. */
4439 if (frame_garbaged
&& do_display
)
4441 clear_waiting_for_input ();
4442 redisplay_preserve_echo_area (11);
4444 set_waiting_for_input (&timeout
);
4448 if (read_kbd
&& detect_input_pending ())
4455 #ifdef NON_BLOCKING_CONNECT
4457 Connecting
= connect_wait_mask
;
4460 #ifdef ADAPTIVE_READ_BUFFERING
4461 /* Set the timeout for adaptive read buffering if any
4462 process has non-nil read_output_skip and non-zero
4463 read_output_delay, and we are not reading output for a
4464 specific wait_channel. It is not executed if
4465 Vprocess_adaptive_read_buffering is nil. */
4466 if (process_output_skip
&& check_delay
> 0)
4468 int usecs
= EMACS_USECS (timeout
);
4469 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4470 usecs
= READ_OUTPUT_DELAY_MAX
;
4471 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4473 proc
= chan_process
[channel
];
4476 /* Find minimum non-zero read_output_delay among the
4477 processes with non-nil read_output_skip. */
4478 if (XINT (XPROCESS (proc
)->read_output_delay
) > 0)
4481 if (NILP (XPROCESS (proc
)->read_output_skip
))
4483 FD_CLR (channel
, &Available
);
4484 XPROCESS (proc
)->read_output_skip
= Qnil
;
4485 if (XINT (XPROCESS (proc
)->read_output_delay
) < usecs
)
4486 usecs
= XINT (XPROCESS (proc
)->read_output_delay
);
4489 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4490 process_output_skip
= 0;
4494 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4496 #ifdef NON_BLOCKING_CONNECT
4497 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4501 (SELECT_TYPE
*)0, &timeout
);
4506 /* Make C-g and alarm signals set flags again */
4507 clear_waiting_for_input ();
4509 /* If we woke up due to SIGWINCH, actually change size now. */
4510 do_pending_window_change (0);
4512 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4513 /* We wanted the full specified time, so return now. */
4517 if (xerrno
== EINTR
)
4520 /* Ultrix select seems to return ENOMEM when it is
4521 interrupted. Treat it just like EINTR. Bleah. Note
4522 that we want to test for the "ultrix" CPP symbol, not
4523 "__ultrix__"; the latter is only defined under GCC, but
4524 not by DEC's bundled CC. -JimB */
4525 else if (xerrno
== ENOMEM
)
4529 /* This happens for no known reason on ALLIANT.
4530 I am guessing that this is the right response. -- RMS. */
4531 else if (xerrno
== EFAULT
)
4534 else if (xerrno
== EBADF
)
4537 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4538 the child's closure of the pts gives the parent a SIGHUP, and
4539 the ptc file descriptor is automatically closed,
4540 yielding EBADF here or at select() call above.
4541 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4542 in m/ibmrt-aix.h), and here we just ignore the select error.
4543 Cleanup occurs c/o status_notify after SIGCLD. */
4544 no_avail
= 1; /* Cannot depend on values returned */
4550 error ("select error: %s", emacs_strerror (xerrno
));
4555 FD_ZERO (&Available
);
4556 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4559 #if defined(sun) && !defined(USG5_4)
4560 if (nfds
> 0 && keyboard_bit_set (&Available
)
4562 /* System sometimes fails to deliver SIGIO.
4564 David J. Mackenzie says that Emacs doesn't compile under
4565 Solaris if this code is enabled, thus the USG5_4 in the CPP
4566 conditional. "I haven't noticed any ill effects so far.
4567 If you find a Solaris expert somewhere, they might know
4569 kill (getpid (), SIGIO
);
4572 #if 0 /* When polling is used, interrupt_input is 0,
4573 so get_input_pending should read the input.
4574 So this should not be needed. */
4575 /* If we are using polling for input,
4576 and we see input available, make it get read now.
4577 Otherwise it might not actually get read for a second.
4578 And on hpux, since we turn off polling in wait_reading_process_output,
4579 it might never get read at all if we don't spend much time
4580 outside of wait_reading_process_output. */
4581 if (read_kbd
&& interrupt_input
4582 && keyboard_bit_set (&Available
)
4583 && input_polling_used ())
4584 kill (getpid (), SIGALRM
);
4587 /* Check for keyboard input */
4588 /* If there is any, return immediately
4589 to give it higher priority than subprocesses */
4593 int old_timers_run
= timers_run
;
4594 struct buffer
*old_buffer
= current_buffer
;
4597 if (detect_input_pending_run_timers (do_display
))
4599 swallow_events (do_display
);
4600 if (detect_input_pending_run_timers (do_display
))
4604 /* If a timer has run, this might have changed buffers
4605 an alike. Make read_key_sequence aware of that. */
4606 if (timers_run
!= old_timers_run
4607 && waiting_for_user_input_p
== -1
4608 && old_buffer
!= current_buffer
)
4609 record_asynch_buffer_change ();
4615 /* If there is unread keyboard input, also return. */
4617 && requeued_events_pending_p ())
4620 /* If we are not checking for keyboard input now,
4621 do process events (but don't run any timers).
4622 This is so that X events will be processed.
4623 Otherwise they may have to wait until polling takes place.
4624 That would causes delays in pasting selections, for example.
4626 (We used to do this only if wait_for_cell.) */
4627 if (read_kbd
== 0 && detect_input_pending ())
4629 swallow_events (do_display
);
4630 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4631 if (detect_input_pending ())
4636 /* Exit now if the cell we're waiting for became non-nil. */
4637 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4641 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4642 go read it. This can happen with X on BSD after logging out.
4643 In that case, there really is no input and no SIGIO,
4644 but select says there is input. */
4646 if (read_kbd
&& interrupt_input
4647 && keyboard_bit_set (&Available
) && ! noninteractive
)
4648 kill (getpid (), SIGIO
);
4652 got_some_input
|= nfds
> 0;
4654 /* If checking input just got us a size-change event from X,
4655 obey it now if we should. */
4656 if (read_kbd
|| ! NILP (wait_for_cell
))
4657 do_pending_window_change (0);
4659 /* Check for data from a process. */
4660 if (no_avail
|| nfds
== 0)
4663 /* Really FIRST_PROC_DESC should be 0 on Unix,
4664 but this is safer in the short run. */
4665 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4667 if (FD_ISSET (channel
, &Available
)
4668 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4672 /* If waiting for this channel, arrange to return as
4673 soon as no more input to be processed. No more
4675 if (wait_channel
== channel
)
4681 proc
= chan_process
[channel
];
4685 /* If this is a server stream socket, accept connection. */
4686 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4688 server_accept_connection (proc
, channel
);
4692 /* Read data from the process, starting with our
4693 buffered-ahead character if we have one. */
4695 nread
= read_process_output (proc
, channel
);
4698 /* Since read_process_output can run a filter,
4699 which can call accept-process-output,
4700 don't try to read from any other processes
4701 before doing the select again. */
4702 FD_ZERO (&Available
);
4705 redisplay_preserve_echo_area (12);
4708 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4711 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4712 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4714 else if (nread
== -1 && errno
== EAGAIN
)
4718 else if (nread
== -1 && errno
== EAGAIN
)
4720 /* Note that we cannot distinguish between no input
4721 available now and a closed pipe.
4722 With luck, a closed pipe will be accompanied by
4723 subprocess termination and SIGCHLD. */
4724 else if (nread
== 0 && !NETCONN_P (proc
))
4726 #endif /* O_NDELAY */
4727 #endif /* O_NONBLOCK */
4729 /* On some OSs with ptys, when the process on one end of
4730 a pty exits, the other end gets an error reading with
4731 errno = EIO instead of getting an EOF (0 bytes read).
4732 Therefore, if we get an error reading and errno =
4733 EIO, just continue, because the child process has
4734 exited and should clean itself up soon (e.g. when we
4737 However, it has been known to happen that the SIGCHLD
4738 got lost. So raise the signl again just in case.
4740 else if (nread
== -1 && errno
== EIO
)
4741 kill (getpid (), SIGCHLD
);
4742 #endif /* HAVE_PTYS */
4743 /* If we can detect process termination, don't consider the process
4744 gone just because its pipe is closed. */
4746 else if (nread
== 0 && !NETCONN_P (proc
))
4751 /* Preserve status of processes already terminated. */
4752 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4753 deactivate_process (proc
);
4754 if (XPROCESS (proc
)->raw_status_new
)
4755 update_status (XPROCESS (proc
));
4756 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4757 XPROCESS (proc
)->status
4758 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4761 #ifdef NON_BLOCKING_CONNECT
4762 if (check_connect
&& FD_ISSET (channel
, &Connecting
)
4763 && FD_ISSET (channel
, &connect_wait_mask
))
4765 struct Lisp_Process
*p
;
4767 FD_CLR (channel
, &connect_wait_mask
);
4768 if (--num_pending_connects
< 0)
4771 proc
= chan_process
[channel
];
4775 p
= XPROCESS (proc
);
4778 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4779 So only use it on systems where it is known to work. */
4781 int xlen
= sizeof(xerrno
);
4782 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4787 struct sockaddr pname
;
4788 int pnamelen
= sizeof(pname
);
4790 /* If connection failed, getpeername will fail. */
4792 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4794 /* Obtain connect failure code through error slippage. */
4797 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4804 XSETINT (p
->tick
, ++process_tick
);
4805 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4806 deactivate_process (proc
);
4811 /* Execute the sentinel here. If we had relied on
4812 status_notify to do it later, it will read input
4813 from the process before calling the sentinel. */
4814 exec_sentinel (proc
, build_string ("open\n"));
4815 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4817 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4818 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4822 #endif /* NON_BLOCKING_CONNECT */
4823 } /* end for each file descriptor */
4824 } /* end while exit conditions not met */
4826 waiting_for_user_input_p
= saved_waiting_for_user_input_p
;
4828 /* If calling from keyboard input, do not quit
4829 since we want to return C-g as an input character.
4830 Otherwise, do pending quit if requested. */
4833 /* Prevent input_pending from remaining set if we quit. */
4834 clear_input_pending ();
4837 #ifdef POLL_INTERRUPTED_SYS_CALL
4838 /* AlainF 5-Jul-1996
4839 HP-UX 10.10 seems to have problems with signals coming in
4840 Causes "poll: interrupted system call" messages when Emacs is run
4842 Turn periodic alarms back on */
4844 #endif /* POLL_INTERRUPTED_SYS_CALL */
4846 return got_some_input
;
4849 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4852 read_process_output_call (fun_and_args
)
4853 Lisp_Object fun_and_args
;
4855 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4859 read_process_output_error_handler (error
)
4862 cmd_error_internal (error
, "error in process filter: ");
4864 update_echo_area ();
4865 Fsleep_for (make_number (2), Qnil
);
4869 /* Read pending output from the process channel,
4870 starting with our buffered-ahead character if we have one.
4871 Yield number of decoded characters read.
4873 This function reads at most 4096 characters.
4874 If you want to read all available subprocess output,
4875 you must call it repeatedly until it returns zero.
4877 The characters read are decoded according to PROC's coding-system
4881 read_process_output (proc
, channel
)
4883 register int channel
;
4885 register int nbytes
;
4887 register Lisp_Object outstream
;
4888 register struct buffer
*old
= current_buffer
;
4889 register struct Lisp_Process
*p
= XPROCESS (proc
);
4890 register int opoint
;
4891 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4892 int carryover
= XINT (p
->decoding_carryover
);
4896 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4898 vs
= get_vms_process_pointer (p
->pid
);
4902 return (0); /* Really weird if it does this */
4903 if (!(vs
->iosb
[0] & 1))
4904 return -1; /* I/O error */
4907 error ("Could not get VMS process pointer");
4908 chars
= vs
->inputBuffer
;
4909 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4912 start_vms_process_read (vs
); /* Crank up the next read on the process */
4913 return 1; /* Nothing worth printing, say we got 1 */
4917 /* The data carried over in the previous decoding (which are at
4918 the tail of decoding buffer) should be prepended to the new
4919 data read to decode all together. */
4920 chars
= (char *) alloca (nbytes
+ carryover
);
4921 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4922 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4926 chars
= (char *) alloca (carryover
+ readmax
);
4928 /* See the comment above. */
4929 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
4931 #ifdef DATAGRAM_SOCKETS
4932 /* We have a working select, so proc_buffered_char is always -1. */
4933 if (DATAGRAM_CHAN_P (channel
))
4935 int len
= datagram_address
[channel
].len
;
4936 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
4937 0, datagram_address
[channel
].sa
, &len
);
4941 if (proc_buffered_char
[channel
] < 0)
4943 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
4944 #ifdef ADAPTIVE_READ_BUFFERING
4945 if (nbytes
> 0 && !NILP (p
->adaptive_read_buffering
))
4947 int delay
= XINT (p
->read_output_delay
);
4950 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
4953 process_output_delay_count
++;
4954 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
4957 else if (delay
> 0 && (nbytes
== readmax
))
4959 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
4961 process_output_delay_count
--;
4963 XSETINT (p
->read_output_delay
, delay
);
4966 p
->read_output_skip
= Qt
;
4967 process_output_skip
= 1;
4974 chars
[carryover
] = proc_buffered_char
[channel
];
4975 proc_buffered_char
[channel
] = -1;
4976 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
4980 nbytes
= nbytes
+ 1;
4982 #endif /* not VMS */
4984 XSETINT (p
->decoding_carryover
, 0);
4986 /* At this point, NBYTES holds number of bytes just received
4987 (including the one in proc_buffered_char[channel]). */
4990 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
4992 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
4995 /* Now set NBYTES how many bytes we must decode. */
4996 nbytes
+= carryover
;
4998 /* Read and dispose of the process output. */
4999 outstream
= p
->filter
;
5000 if (!NILP (outstream
))
5002 /* We inhibit quit here instead of just catching it so that
5003 hitting ^G when a filter happens to be running won't screw
5005 int count
= SPECPDL_INDEX ();
5006 Lisp_Object odeactivate
;
5007 Lisp_Object obuffer
, okeymap
;
5009 int outer_running_asynch_code
= running_asynch_code
;
5010 int waiting
= waiting_for_user_input_p
;
5012 /* No need to gcpro these, because all we do with them later
5013 is test them for EQness, and none of them should be a string. */
5014 odeactivate
= Vdeactivate_mark
;
5015 XSETBUFFER (obuffer
, current_buffer
);
5016 okeymap
= current_buffer
->keymap
;
5018 specbind (Qinhibit_quit
, Qt
);
5019 specbind (Qlast_nonmenu_event
, Qt
);
5021 /* In case we get recursively called,
5022 and we already saved the match data nonrecursively,
5023 save the same match data in safely recursive fashion. */
5024 if (outer_running_asynch_code
)
5027 /* Don't clobber the CURRENT match data, either! */
5028 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5029 restore_search_regs ();
5030 record_unwind_save_match_data ();
5031 Fset_match_data (tem
, Qt
);
5034 /* For speed, if a search happens within this code,
5035 save the match data in a special nonrecursive fashion. */
5036 running_asynch_code
= 1;
5038 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5040 Vlast_coding_system_used
= coding
->symbol
;
5041 /* A new coding system might be found. */
5042 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5044 p
->decode_coding_system
= coding
->symbol
;
5046 /* Don't call setup_coding_system for
5047 proc_decode_coding_system[channel] here. It is done in
5048 detect_coding called via decode_coding above. */
5050 /* If a coding system for encoding is not yet decided, we set
5051 it as the same as coding-system for decoding.
5053 But, before doing that we must check if
5054 proc_encode_coding_system[p->outfd] surely points to a
5055 valid memory because p->outfd will be changed once EOF is
5056 sent to the process. */
5057 if (NILP (p
->encode_coding_system
)
5058 && proc_encode_coding_system
[XINT (p
->outfd
)])
5060 p
->encode_coding_system
= coding
->symbol
;
5061 setup_coding_system (coding
->symbol
,
5062 proc_encode_coding_system
[XINT (p
->outfd
)]);
5066 carryover
= nbytes
- coding
->consumed
;
5067 if (SCHARS (p
->decoding_buf
) < carryover
)
5068 p
->decoding_buf
= make_uninit_string (carryover
);
5069 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5071 XSETINT (p
->decoding_carryover
, carryover
);
5072 /* Adjust the multibyteness of TEXT to that of the filter. */
5073 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
5074 text
= (STRING_MULTIBYTE (text
)
5075 ? Fstring_as_unibyte (text
)
5076 : Fstring_to_multibyte (text
));
5077 if (SBYTES (text
) > 0)
5078 internal_condition_case_1 (read_process_output_call
,
5080 Fcons (proc
, Fcons (text
, Qnil
))),
5081 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5082 read_process_output_error_handler
);
5084 /* If we saved the match data nonrecursively, restore it now. */
5085 restore_search_regs ();
5086 running_asynch_code
= outer_running_asynch_code
;
5088 /* Handling the process output should not deactivate the mark. */
5089 Vdeactivate_mark
= odeactivate
;
5091 /* Restore waiting_for_user_input_p as it was
5092 when we were called, in case the filter clobbered it. */
5093 waiting_for_user_input_p
= waiting
;
5095 #if 0 /* Call record_asynch_buffer_change unconditionally,
5096 because we might have changed minor modes or other things
5097 that affect key bindings. */
5098 if (! EQ (Fcurrent_buffer (), obuffer
)
5099 || ! EQ (current_buffer
->keymap
, okeymap
))
5101 /* But do it only if the caller is actually going to read events.
5102 Otherwise there's no need to make him wake up, and it could
5103 cause trouble (for example it would make Fsit_for return). */
5104 if (waiting_for_user_input_p
== -1)
5105 record_asynch_buffer_change ();
5108 start_vms_process_read (vs
);
5110 unbind_to (count
, Qnil
);
5114 /* If no filter, write into buffer if it isn't dead. */
5115 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5117 Lisp_Object old_read_only
;
5118 int old_begv
, old_zv
;
5119 int old_begv_byte
, old_zv_byte
;
5120 Lisp_Object odeactivate
;
5121 int before
, before_byte
;
5126 odeactivate
= Vdeactivate_mark
;
5128 Fset_buffer (p
->buffer
);
5130 opoint_byte
= PT_BYTE
;
5131 old_read_only
= current_buffer
->read_only
;
5134 old_begv_byte
= BEGV_BYTE
;
5135 old_zv_byte
= ZV_BYTE
;
5137 current_buffer
->read_only
= Qnil
;
5139 /* Insert new output into buffer
5140 at the current end-of-output marker,
5141 thus preserving logical ordering of input and output. */
5142 if (XMARKER (p
->mark
)->buffer
)
5143 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5144 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5147 SET_PT_BOTH (ZV
, ZV_BYTE
);
5149 before_byte
= PT_BYTE
;
5151 /* If the output marker is outside of the visible region, save
5152 the restriction and widen. */
5153 if (! (BEGV
<= PT
&& PT
<= ZV
))
5156 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5158 Vlast_coding_system_used
= coding
->symbol
;
5159 /* A new coding system might be found. See the comment in the
5160 similar code in the previous `if' block. */
5161 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5163 p
->decode_coding_system
= coding
->symbol
;
5164 if (NILP (p
->encode_coding_system
)
5165 && proc_encode_coding_system
[XINT (p
->outfd
)])
5167 p
->encode_coding_system
= coding
->symbol
;
5168 setup_coding_system (coding
->symbol
,
5169 proc_encode_coding_system
[XINT (p
->outfd
)]);
5172 carryover
= nbytes
- coding
->consumed
;
5173 if (SCHARS (p
->decoding_buf
) < carryover
)
5174 p
->decoding_buf
= make_uninit_string (carryover
);
5175 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5177 XSETINT (p
->decoding_carryover
, carryover
);
5178 /* Adjust the multibyteness of TEXT to that of the buffer. */
5179 if (NILP (current_buffer
->enable_multibyte_characters
)
5180 != ! STRING_MULTIBYTE (text
))
5181 text
= (STRING_MULTIBYTE (text
)
5182 ? Fstring_as_unibyte (text
)
5183 : Fstring_to_multibyte (text
));
5184 /* Insert before markers in case we are inserting where
5185 the buffer's mark is, and the user's next command is Meta-y. */
5186 insert_from_string_before_markers (text
, 0, 0,
5187 SCHARS (text
), SBYTES (text
), 0);
5189 /* Make sure the process marker's position is valid when the
5190 process buffer is changed in the signal_after_change above.
5191 W3 is known to do that. */
5192 if (BUFFERP (p
->buffer
)
5193 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5194 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5196 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5198 update_mode_lines
++;
5200 /* Make sure opoint and the old restrictions
5201 float ahead of any new text just as point would. */
5202 if (opoint
>= before
)
5204 opoint
+= PT
- before
;
5205 opoint_byte
+= PT_BYTE
- before_byte
;
5207 if (old_begv
> before
)
5209 old_begv
+= PT
- before
;
5210 old_begv_byte
+= PT_BYTE
- before_byte
;
5212 if (old_zv
>= before
)
5214 old_zv
+= PT
- before
;
5215 old_zv_byte
+= PT_BYTE
- before_byte
;
5218 /* If the restriction isn't what it should be, set it. */
5219 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5220 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5222 /* Handling the process output should not deactivate the mark. */
5223 Vdeactivate_mark
= odeactivate
;
5225 current_buffer
->read_only
= old_read_only
;
5226 SET_PT_BOTH (opoint
, opoint_byte
);
5227 set_buffer_internal (old
);
5230 start_vms_process_read (vs
);
5235 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5237 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5238 This is intended for use by asynchronous process output filters and sentinels. */)
5241 return (waiting_for_user_input_p
? Qt
: Qnil
);
5244 /* Sending data to subprocess */
5246 jmp_buf send_process_frame
;
5247 Lisp_Object process_sent_to
;
5250 send_process_trap ()
5252 SIGNAL_THREAD_CHECK (SIGPIPE
);
5257 sigunblock (sigmask (SIGPIPE
));
5258 longjmp (send_process_frame
, 1);
5261 /* Send some data to process PROC.
5262 BUF is the beginning of the data; LEN is the number of characters.
5263 OBJECT is the Lisp object that the data comes from. If OBJECT is
5264 nil or t, it means that the data comes from C string.
5266 If OBJECT is not nil, the data is encoded by PROC's coding-system
5267 for encoding before it is sent.
5269 This function can evaluate Lisp code and can garbage collect. */
5272 send_process (proc
, buf
, len
, object
)
5273 volatile Lisp_Object proc
;
5274 unsigned char *volatile buf
;
5276 volatile Lisp_Object object
;
5278 /* Use volatile to protect variables from being clobbered by longjmp. */
5279 struct Lisp_Process
*p
= XPROCESS (proc
);
5281 struct coding_system
*coding
;
5282 struct gcpro gcpro1
;
5283 SIGTYPE (*volatile old_sigpipe
) ();
5288 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5291 if (p
->raw_status_new
)
5293 if (! EQ (p
->status
, Qrun
))
5294 error ("Process %s not running", SDATA (p
->name
));
5295 if (XINT (p
->outfd
) < 0)
5296 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5298 coding
= proc_encode_coding_system
[XINT (p
->outfd
)];
5299 Vlast_coding_system_used
= coding
->symbol
;
5301 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5302 || (BUFFERP (object
)
5303 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5306 if (!EQ (coding
->symbol
, p
->encode_coding_system
))
5307 /* The coding system for encoding was changed to raw-text
5308 because we sent a unibyte text previously. Now we are
5309 sending a multibyte text, thus we must encode it by the
5310 original coding system specified for the current process. */
5311 setup_coding_system (p
->encode_coding_system
, coding
);
5312 /* src_multibyte should be set to 1 _after_ a call to
5313 setup_coding_system, since it resets src_multibyte to
5315 coding
->src_multibyte
= 1;
5319 /* For sending a unibyte text, character code conversion should
5320 not take place but EOL conversion should. So, setup raw-text
5321 or one of the subsidiary if we have not yet done it. */
5322 if (coding
->type
!= coding_type_raw_text
)
5324 if (CODING_REQUIRE_FLUSHING (coding
))
5326 /* But, before changing the coding, we must flush out data. */
5327 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5328 send_process (proc
, "", 0, Qt
);
5330 coding
->src_multibyte
= 0;
5331 setup_raw_text_coding_system (coding
);
5334 coding
->dst_multibyte
= 0;
5336 if (CODING_REQUIRE_ENCODING (coding
))
5338 int require
= encoding_buffer_size (coding
, len
);
5339 int from_byte
= -1, from
= -1, to
= -1;
5341 if (BUFFERP (object
))
5343 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5344 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
5345 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
5347 else if (STRINGP (object
))
5349 from_byte
= buf
- SDATA (object
);
5350 from
= string_byte_to_char (object
, from_byte
);
5351 to
= string_byte_to_char (object
, from_byte
+ len
);
5354 if (coding
->composing
!= COMPOSITION_DISABLED
)
5357 coding_save_composition (coding
, from
, to
, object
);
5359 coding
->composing
= COMPOSITION_DISABLED
;
5362 if (SBYTES (p
->encoding_buf
) < require
)
5363 p
->encoding_buf
= make_uninit_string (require
);
5366 buf
= (BUFFERP (object
)
5367 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
5368 : SDATA (object
) + from_byte
);
5370 object
= p
->encoding_buf
;
5371 encode_coding (coding
, (char *) buf
, SDATA (object
),
5372 len
, SBYTES (object
));
5373 coding_free_composition_data (coding
);
5374 len
= coding
->produced
;
5375 buf
= SDATA (object
);
5379 vs
= get_vms_process_pointer (p
->pid
);
5381 error ("Could not find this process: %x", p
->pid
);
5382 else if (write_to_vms_process (vs
, buf
, len
))
5386 if (pty_max_bytes
== 0)
5388 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5389 pty_max_bytes
= fpathconf (XFASTINT (p
->outfd
), _PC_MAX_CANON
);
5390 if (pty_max_bytes
< 0)
5391 pty_max_bytes
= 250;
5393 pty_max_bytes
= 250;
5395 /* Deduct one, to leave space for the eof. */
5399 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5400 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5401 when returning with longjmp despite being declared volatile. */
5402 if (!setjmp (send_process_frame
))
5404 process_sent_to
= proc
;
5409 /* Decide how much data we can send in one batch.
5410 Long lines need to be split into multiple batches. */
5411 if (!NILP (p
->pty_flag
))
5413 /* Starting this at zero is always correct when not the first
5414 iteration because the previous iteration ended by sending C-d.
5415 It may not be correct for the first iteration
5416 if a partial line was sent in a separate send_process call.
5417 If that proves worth handling, we need to save linepos
5418 in the process object. */
5420 unsigned char *ptr
= (unsigned char *) buf
;
5421 unsigned char *end
= (unsigned char *) buf
+ len
;
5423 /* Scan through this text for a line that is too long. */
5424 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5432 /* If we found one, break the line there
5433 and put in a C-d to force the buffer through. */
5437 /* Send this batch, using one or more write calls. */
5440 int outfd
= XINT (p
->outfd
);
5441 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5442 #ifdef DATAGRAM_SOCKETS
5443 if (DATAGRAM_CHAN_P (outfd
))
5445 rv
= sendto (outfd
, (char *) buf
, this,
5446 0, datagram_address
[outfd
].sa
,
5447 datagram_address
[outfd
].len
);
5448 if (rv
< 0 && errno
== EMSGSIZE
)
5450 signal (SIGPIPE
, old_sigpipe
);
5451 report_file_error ("sending datagram",
5452 Fcons (proc
, Qnil
));
5458 rv
= emacs_write (outfd
, (char *) buf
, this);
5459 #ifdef ADAPTIVE_READ_BUFFERING
5460 if (XINT (p
->read_output_delay
) > 0
5461 && EQ (p
->adaptive_read_buffering
, Qt
))
5463 XSETFASTINT (p
->read_output_delay
, 0);
5464 process_output_delay_count
--;
5465 p
->read_output_skip
= Qnil
;
5469 signal (SIGPIPE
, old_sigpipe
);
5475 || errno
== EWOULDBLOCK
5481 /* Buffer is full. Wait, accepting input;
5482 that may allow the program
5483 to finish doing output and read more. */
5487 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5488 /* A gross hack to work around a bug in FreeBSD.
5489 In the following sequence, read(2) returns
5493 write(2) 954 bytes, get EAGAIN
5494 read(2) 1024 bytes in process_read_output
5495 read(2) 11 bytes in process_read_output
5497 That is, read(2) returns more bytes than have
5498 ever been written successfully. The 1033 bytes
5499 read are the 1022 bytes written successfully
5500 after processing (for example with CRs added if
5501 the terminal is set up that way which it is
5502 here). The same bytes will be seen again in a
5503 later read(2), without the CRs. */
5505 if (errno
== EAGAIN
)
5508 ioctl (XINT (p
->outfd
), TIOCFLUSH
, &flags
);
5510 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5512 /* Running filters might relocate buffers or strings.
5513 Arrange to relocate BUF. */
5514 if (BUFFERP (object
))
5515 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5516 else if (STRINGP (object
))
5517 offset
= buf
- SDATA (object
);
5519 #ifdef EMACS_HAS_USECS
5520 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5522 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5525 if (BUFFERP (object
))
5526 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5527 else if (STRINGP (object
))
5528 buf
= offset
+ SDATA (object
);
5533 /* This is a real error. */
5534 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5541 /* If we sent just part of the string, put in an EOF
5542 to force it through, before we send the rest. */
5544 Fprocess_send_eof (proc
);
5547 #endif /* not VMS */
5550 signal (SIGPIPE
, old_sigpipe
);
5552 proc
= process_sent_to
;
5553 p
= XPROCESS (proc
);
5555 p
->raw_status_new
= 0;
5556 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5557 XSETINT (p
->tick
, ++process_tick
);
5558 deactivate_process (proc
);
5560 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5562 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5569 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5571 doc
: /* Send current contents of region as input to PROCESS.
5572 PROCESS may be a process, a buffer, the name of a process or buffer, or
5573 nil, indicating the current buffer's process.
5574 Called from program, takes three arguments, PROCESS, START and END.
5575 If the region is more than 500 characters long,
5576 it is sent in several bunches. This may happen even for shorter regions.
5577 Output from processes can arrive in between bunches. */)
5578 (process
, start
, end
)
5579 Lisp_Object process
, start
, end
;
5584 proc
= get_process (process
);
5585 validate_region (&start
, &end
);
5587 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5588 move_gap (XINT (start
));
5590 start1
= CHAR_TO_BYTE (XINT (start
));
5591 end1
= CHAR_TO_BYTE (XINT (end
));
5592 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5593 Fcurrent_buffer ());
5598 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5600 doc
: /* Send PROCESS the contents of STRING as input.
5601 PROCESS may be a process, a buffer, the name of a process or buffer, or
5602 nil, indicating the current buffer's process.
5603 If STRING is more than 500 characters long,
5604 it is sent in several bunches. This may happen even for shorter strings.
5605 Output from processes can arrive in between bunches. */)
5607 Lisp_Object process
, string
;
5610 CHECK_STRING (string
);
5611 proc
= get_process (process
);
5612 send_process (proc
, SDATA (string
),
5613 SBYTES (string
), string
);
5617 /* Return the foreground process group for the tty/pty that
5618 the process P uses. */
5620 emacs_get_tty_pgrp (p
)
5621 struct Lisp_Process
*p
;
5626 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5629 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5630 master side. Try the slave side. */
5631 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5635 ioctl (fd
, TIOCGPGRP
, &gid
);
5639 #endif /* defined (TIOCGPGRP ) */
5644 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5645 Sprocess_running_child_p
, 0, 1, 0,
5646 doc
: /* Return t if PROCESS has given the terminal to a child.
5647 If the operating system does not make it possible to find out,
5648 return t unconditionally. */)
5650 Lisp_Object process
;
5652 /* Initialize in case ioctl doesn't exist or gives an error,
5653 in a way that will cause returning t. */
5656 struct Lisp_Process
*p
;
5658 proc
= get_process (process
);
5659 p
= XPROCESS (proc
);
5661 if (!EQ (p
->childp
, Qt
))
5662 error ("Process %s is not a subprocess",
5664 if (XINT (p
->infd
) < 0)
5665 error ("Process %s is not active",
5668 gid
= emacs_get_tty_pgrp (p
);
5675 /* send a signal number SIGNO to PROCESS.
5676 If CURRENT_GROUP is t, that means send to the process group
5677 that currently owns the terminal being used to communicate with PROCESS.
5678 This is used for various commands in shell mode.
5679 If CURRENT_GROUP is lambda, that means send to the process group
5680 that currently owns the terminal, but only if it is NOT the shell itself.
5682 If NOMSG is zero, insert signal-announcements into process's buffers
5685 If we can, we try to signal PROCESS by sending control characters
5686 down the pty. This allows us to signal inferiors who have changed
5687 their uid, for which killpg would return an EPERM error. */
5690 process_send_signal (process
, signo
, current_group
, nomsg
)
5691 Lisp_Object process
;
5693 Lisp_Object current_group
;
5697 register struct Lisp_Process
*p
;
5701 proc
= get_process (process
);
5702 p
= XPROCESS (proc
);
5704 if (!EQ (p
->childp
, Qt
))
5705 error ("Process %s is not a subprocess",
5707 if (XINT (p
->infd
) < 0)
5708 error ("Process %s is not active",
5711 if (NILP (p
->pty_flag
))
5712 current_group
= Qnil
;
5714 /* If we are using pgrps, get a pgrp number and make it negative. */
5715 if (NILP (current_group
))
5716 /* Send the signal to the shell's process group. */
5720 #ifdef SIGNALS_VIA_CHARACTERS
5721 /* If possible, send signals to the entire pgrp
5722 by sending an input character to it. */
5724 /* TERMIOS is the latest and bestest, and seems most likely to
5725 work. If the system has it, use it. */
5728 cc_t
*sig_char
= NULL
;
5730 tcgetattr (XINT (p
->infd
), &t
);
5735 sig_char
= &t
.c_cc
[VINTR
];
5739 sig_char
= &t
.c_cc
[VQUIT
];
5743 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5744 sig_char
= &t
.c_cc
[VSWTCH
];
5746 sig_char
= &t
.c_cc
[VSUSP
];
5751 if (sig_char
&& *sig_char
!= CDISABLE
)
5753 send_process (proc
, sig_char
, 1, Qnil
);
5756 /* If we can't send the signal with a character,
5757 fall through and send it another way. */
5758 #else /* ! HAVE_TERMIOS */
5760 /* On Berkeley descendants, the following IOCTL's retrieve the
5761 current control characters. */
5762 #if defined (TIOCGLTC) && defined (TIOCGETC)
5770 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5771 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5774 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5775 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5779 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5780 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5782 #endif /* ! defined (SIGTSTP) */
5785 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5787 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5794 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5795 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5798 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5799 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5803 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5804 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5806 #endif /* ! defined (SIGTSTP) */
5808 #else /* ! defined (TCGETA) */
5809 Your configuration files are messed up
.
5810 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5811 you'd better be using one of the alternatives above! */
5812 #endif /* ! defined (TCGETA) */
5813 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5814 /* In this case, the code above should alway returns. */
5816 #endif /* ! defined HAVE_TERMIOS */
5818 /* The code above may fall through if it can't
5819 handle the signal. */
5820 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5823 /* Get the current pgrp using the tty itself, if we have that.
5824 Otherwise, use the pty to get the pgrp.
5825 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5826 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5827 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5828 His patch indicates that if TIOCGPGRP returns an error, then
5829 we should just assume that p->pid is also the process group id. */
5831 gid
= emacs_get_tty_pgrp (p
);
5834 /* If we can't get the information, assume
5835 the shell owns the tty. */
5838 /* It is not clear whether anything really can set GID to -1.
5839 Perhaps on some system one of those ioctls can or could do so.
5840 Or perhaps this is vestigial. */
5843 #else /* ! defined (TIOCGPGRP ) */
5844 /* Can't select pgrps on this system, so we know that
5845 the child itself heads the pgrp. */
5847 #endif /* ! defined (TIOCGPGRP ) */
5849 /* If current_group is lambda, and the shell owns the terminal,
5850 don't send any signal. */
5851 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
5859 p
->raw_status_new
= 0;
5861 XSETINT (p
->tick
, ++process_tick
);
5863 status_notify (NULL
);
5865 #endif /* ! defined (SIGCONT) */
5868 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5873 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5878 sys$
forcex (&(p
->pid
), 0, 1);
5881 flush_pending_output (XINT (p
->infd
));
5885 /* If we don't have process groups, send the signal to the immediate
5886 subprocess. That isn't really right, but it's better than any
5887 obvious alternative. */
5890 kill (p
->pid
, signo
);
5894 /* gid may be a pid, or minus a pgrp's number */
5896 if (!NILP (current_group
))
5898 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
5899 EMACS_KILLPG (gid
, signo
);
5906 #else /* ! defined (TIOCSIGSEND) */
5907 EMACS_KILLPG (gid
, signo
);
5908 #endif /* ! defined (TIOCSIGSEND) */
5911 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5912 doc
: /* Interrupt process PROCESS.
5913 PROCESS may be a process, a buffer, or the name of a process or buffer.
5914 No arg or nil means current buffer's process.
5915 Second arg CURRENT-GROUP non-nil means send signal to
5916 the current process-group of the process's controlling terminal
5917 rather than to the process's own process group.
5918 If the process is a shell, this means interrupt current subjob
5919 rather than the shell.
5921 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5922 don't send the signal. */)
5923 (process
, current_group
)
5924 Lisp_Object process
, current_group
;
5926 process_send_signal (process
, SIGINT
, current_group
, 0);
5930 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5931 doc
: /* Kill process PROCESS. May be process or name of one.
5932 See function `interrupt-process' for more details on usage. */)
5933 (process
, current_group
)
5934 Lisp_Object process
, current_group
;
5936 process_send_signal (process
, SIGKILL
, current_group
, 0);
5940 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5941 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5942 See function `interrupt-process' for more details on usage. */)
5943 (process
, current_group
)
5944 Lisp_Object process
, current_group
;
5946 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5950 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5951 doc
: /* Stop process PROCESS. May be process or name of one.
5952 See function `interrupt-process' for more details on usage.
5953 If PROCESS is a network process, inhibit handling of incoming traffic. */)
5954 (process
, current_group
)
5955 Lisp_Object process
, current_group
;
5958 if (PROCESSP (process
) && NETCONN_P (process
))
5960 struct Lisp_Process
*p
;
5962 p
= XPROCESS (process
);
5963 if (NILP (p
->command
)
5964 && XINT (p
->infd
) >= 0)
5966 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5967 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5974 error ("No SIGTSTP support");
5976 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5981 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5982 doc
: /* Continue process PROCESS. May be process or name of one.
5983 See function `interrupt-process' for more details on usage.
5984 If PROCESS is a network process, resume handling of incoming traffic. */)
5985 (process
, current_group
)
5986 Lisp_Object process
, current_group
;
5989 if (PROCESSP (process
) && NETCONN_P (process
))
5991 struct Lisp_Process
*p
;
5993 p
= XPROCESS (process
);
5994 if (EQ (p
->command
, Qt
)
5995 && XINT (p
->infd
) >= 0
5996 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
5998 FD_SET (XINT (p
->infd
), &input_wait_mask
);
5999 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
6006 process_send_signal (process
, SIGCONT
, current_group
, 0);
6008 error ("No SIGCONT support");
6013 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6014 2, 2, "sProcess (name or number): \nnSignal code: ",
6015 doc
: /* Send PROCESS the signal with code SIGCODE.
6016 PROCESS may also be an integer specifying the process id of the
6017 process to signal; in this case, the process need not be a child of
6019 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6021 Lisp_Object process
, sigcode
;
6025 if (INTEGERP (process
))
6027 pid
= XINT (process
);
6031 if (FLOATP (process
))
6033 pid
= (pid_t
) XFLOAT (process
);
6037 if (STRINGP (process
))
6040 if (tem
= Fget_process (process
), NILP (tem
))
6042 pid
= XINT (Fstring_to_number (process
, make_number (10)));
6049 process
= get_process (process
);
6054 CHECK_PROCESS (process
);
6055 pid
= XPROCESS (process
)->pid
;
6057 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6061 #define handle_signal(NAME, VALUE) \
6062 else if (!strcmp (name, NAME)) \
6063 XSETINT (sigcode, VALUE)
6065 if (INTEGERP (sigcode
))
6069 unsigned char *name
;
6071 CHECK_SYMBOL (sigcode
);
6072 name
= SDATA (SYMBOL_NAME (sigcode
));
6074 if (!strncmp(name
, "SIG", 3))
6080 handle_signal ("HUP", SIGHUP
);
6083 handle_signal ("INT", SIGINT
);
6086 handle_signal ("QUIT", SIGQUIT
);
6089 handle_signal ("ILL", SIGILL
);
6092 handle_signal ("ABRT", SIGABRT
);
6095 handle_signal ("EMT", SIGEMT
);
6098 handle_signal ("KILL", SIGKILL
);
6101 handle_signal ("FPE", SIGFPE
);
6104 handle_signal ("BUS", SIGBUS
);
6107 handle_signal ("SEGV", SIGSEGV
);
6110 handle_signal ("SYS", SIGSYS
);
6113 handle_signal ("PIPE", SIGPIPE
);
6116 handle_signal ("ALRM", SIGALRM
);
6119 handle_signal ("TERM", SIGTERM
);
6122 handle_signal ("URG", SIGURG
);
6125 handle_signal ("STOP", SIGSTOP
);
6128 handle_signal ("TSTP", SIGTSTP
);
6131 handle_signal ("CONT", SIGCONT
);
6134 handle_signal ("CHLD", SIGCHLD
);
6137 handle_signal ("TTIN", SIGTTIN
);
6140 handle_signal ("TTOU", SIGTTOU
);
6143 handle_signal ("IO", SIGIO
);
6146 handle_signal ("XCPU", SIGXCPU
);
6149 handle_signal ("XFSZ", SIGXFSZ
);
6152 handle_signal ("VTALRM", SIGVTALRM
);
6155 handle_signal ("PROF", SIGPROF
);
6158 handle_signal ("WINCH", SIGWINCH
);
6161 handle_signal ("INFO", SIGINFO
);
6164 handle_signal ("USR1", SIGUSR1
);
6167 handle_signal ("USR2", SIGUSR2
);
6170 error ("Undefined signal name %s", name
);
6173 #undef handle_signal
6175 return make_number (kill (pid
, XINT (sigcode
)));
6178 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6179 doc
: /* Make PROCESS see end-of-file in its input.
6180 EOF comes after any text already sent to it.
6181 PROCESS may be a process, a buffer, the name of a process or buffer, or
6182 nil, indicating the current buffer's process.
6183 If PROCESS is a network connection, or is a process communicating
6184 through a pipe (as opposed to a pty), then you cannot send any more
6185 text to PROCESS after you call this function. */)
6187 Lisp_Object process
;
6190 struct coding_system
*coding
;
6192 if (DATAGRAM_CONN_P (process
))
6195 proc
= get_process (process
);
6196 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
6198 /* Make sure the process is really alive. */
6199 if (XPROCESS (proc
)->raw_status_new
)
6200 update_status (XPROCESS (proc
));
6201 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6202 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6204 if (CODING_REQUIRE_FLUSHING (coding
))
6206 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6207 send_process (proc
, "", 0, Qnil
);
6211 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6213 if (!NILP (XPROCESS (proc
)->pty_flag
))
6214 send_process (proc
, "\004", 1, Qnil
);
6217 int old_outfd
, new_outfd
;
6219 #ifdef HAVE_SHUTDOWN
6220 /* If this is a network connection, or socketpair is used
6221 for communication with the subprocess, call shutdown to cause EOF.
6222 (In some old system, shutdown to socketpair doesn't work.
6223 Then we just can't win.) */
6224 if (XPROCESS (proc
)->pid
== 0
6225 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
6226 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
6227 /* In case of socketpair, outfd == infd, so don't close it. */
6228 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
6229 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6230 #else /* not HAVE_SHUTDOWN */
6231 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6232 #endif /* not HAVE_SHUTDOWN */
6233 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6234 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
6236 if (!proc_encode_coding_system
[new_outfd
])
6237 proc_encode_coding_system
[new_outfd
]
6238 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6239 bcopy (proc_encode_coding_system
[old_outfd
],
6240 proc_encode_coding_system
[new_outfd
],
6241 sizeof (struct coding_system
));
6242 bzero (proc_encode_coding_system
[old_outfd
],
6243 sizeof (struct coding_system
));
6245 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
6251 /* Kill all processes associated with `buffer'.
6252 If `buffer' is nil, kill all processes */
6255 kill_buffer_processes (buffer
)
6258 Lisp_Object tail
, proc
;
6260 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6262 proc
= XCDR (XCAR (tail
));
6263 if (GC_PROCESSP (proc
)
6264 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6266 if (NETCONN_P (proc
))
6267 Fdelete_process (proc
);
6268 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
6269 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6274 /* On receipt of a signal that a child status has changed, loop asking
6275 about children with changed statuses until the system says there
6278 All we do is change the status; we do not run sentinels or print
6279 notifications. That is saved for the next time keyboard input is
6280 done, in order to avoid timing errors.
6282 ** WARNING: this can be called during garbage collection.
6283 Therefore, it must not be fooled by the presence of mark bits in
6286 ** USG WARNING: Although it is not obvious from the documentation
6287 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6288 signal() before executing at least one wait(), otherwise the
6289 handler will be called again, resulting in an infinite loop. The
6290 relevant portion of the documentation reads "SIGCLD signals will be
6291 queued and the signal-catching function will be continually
6292 reentered until the queue is empty". Invoking signal() causes the
6293 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6296 ** Malloc WARNING: This should never call malloc either directly or
6297 indirectly; if it does, that is a bug */
6300 sigchld_handler (signo
)
6303 int old_errno
= errno
;
6305 register struct Lisp_Process
*p
;
6306 extern EMACS_TIME
*input_available_clear_time
;
6308 SIGNAL_THREAD_CHECK (signo
);
6312 sigheld
|= sigbit (SIGCHLD
);
6324 #endif /* no WUNTRACED */
6325 /* Keep trying to get a status until we get a definitive result. */
6329 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6331 while (pid
< 0 && errno
== EINTR
);
6335 /* PID == 0 means no processes found, PID == -1 means a real
6336 failure. We have done all our job, so return. */
6338 /* USG systems forget handlers when they are used;
6339 must reestablish each time */
6340 #if defined (USG) && !defined (POSIX_SIGNALS)
6341 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6344 sigheld
&= ~sigbit (SIGCHLD
);
6352 #endif /* no WNOHANG */
6354 /* Find the process that signaled us, and record its status. */
6357 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6359 proc
= XCDR (XCAR (tail
));
6360 p
= XPROCESS (proc
);
6361 if (GC_EQ (p
->childp
, Qt
) && p
->pid
== pid
)
6366 /* Look for an asynchronous process whose pid hasn't been filled
6369 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6371 proc
= XCDR (XCAR (tail
));
6372 p
= XPROCESS (proc
);
6378 /* Change the status of the process that was found. */
6381 union { int i
; WAITTYPE wt
; } u
;
6382 int clear_desc_flag
= 0;
6384 XSETINT (p
->tick
, ++process_tick
);
6386 p
->raw_status
= u
.i
;
6387 p
->raw_status_new
= 1;
6389 /* If process has terminated, stop waiting for its output. */
6390 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6391 && XINT (p
->infd
) >= 0)
6392 clear_desc_flag
= 1;
6394 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6395 if (clear_desc_flag
)
6397 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6398 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6401 /* Tell wait_reading_process_output that it needs to wake up and
6403 if (input_available_clear_time
)
6404 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6407 /* There was no asynchronous process found for that id. Check
6408 if we have a synchronous process. */
6411 synch_process_alive
= 0;
6413 /* Report the status of the synchronous process. */
6415 synch_process_retcode
= WRETCODE (w
);
6416 else if (WIFSIGNALED (w
))
6417 synch_process_termsig
= WTERMSIG (w
);
6419 /* Tell wait_reading_process_output that it needs to wake up and
6421 if (input_available_clear_time
)
6422 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6425 /* On some systems, we must return right away.
6426 If any more processes want to signal us, we will
6428 Otherwise (on systems that have WNOHANG), loop around
6429 to use up all the processes that have something to tell us. */
6430 #if (defined WINDOWSNT \
6431 || (defined USG && !defined GNU_LINUX \
6432 && !(defined HPUX && defined WNOHANG)))
6433 #if defined (USG) && ! defined (POSIX_SIGNALS)
6434 signal (signo
, sigchld_handler
);
6438 #endif /* USG, but not HPUX with WNOHANG */
6444 exec_sentinel_unwind (data
)
6447 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6452 exec_sentinel_error_handler (error
)
6455 cmd_error_internal (error
, "error in process sentinel: ");
6457 update_echo_area ();
6458 Fsleep_for (make_number (2), Qnil
);
6463 exec_sentinel (proc
, reason
)
6464 Lisp_Object proc
, reason
;
6466 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6467 register struct Lisp_Process
*p
= XPROCESS (proc
);
6468 int count
= SPECPDL_INDEX ();
6469 int outer_running_asynch_code
= running_asynch_code
;
6470 int waiting
= waiting_for_user_input_p
;
6472 /* No need to gcpro these, because all we do with them later
6473 is test them for EQness, and none of them should be a string. */
6474 odeactivate
= Vdeactivate_mark
;
6475 XSETBUFFER (obuffer
, current_buffer
);
6476 okeymap
= current_buffer
->keymap
;
6478 sentinel
= p
->sentinel
;
6479 if (NILP (sentinel
))
6482 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6483 assure that it gets restored no matter how the sentinel exits. */
6485 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6486 /* Inhibit quit so that random quits don't screw up a running filter. */
6487 specbind (Qinhibit_quit
, Qt
);
6488 specbind (Qlast_nonmenu_event
, Qt
);
6490 /* In case we get recursively called,
6491 and we already saved the match data nonrecursively,
6492 save the same match data in safely recursive fashion. */
6493 if (outer_running_asynch_code
)
6496 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6497 restore_search_regs ();
6498 record_unwind_save_match_data ();
6499 Fset_match_data (tem
, Qt
);
6502 /* For speed, if a search happens within this code,
6503 save the match data in a special nonrecursive fashion. */
6504 running_asynch_code
= 1;
6506 internal_condition_case_1 (read_process_output_call
,
6508 Fcons (proc
, Fcons (reason
, Qnil
))),
6509 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6510 exec_sentinel_error_handler
);
6512 /* If we saved the match data nonrecursively, restore it now. */
6513 restore_search_regs ();
6514 running_asynch_code
= outer_running_asynch_code
;
6516 Vdeactivate_mark
= odeactivate
;
6518 /* Restore waiting_for_user_input_p as it was
6519 when we were called, in case the filter clobbered it. */
6520 waiting_for_user_input_p
= waiting
;
6523 if (! EQ (Fcurrent_buffer (), obuffer
)
6524 || ! EQ (current_buffer
->keymap
, okeymap
))
6526 /* But do it only if the caller is actually going to read events.
6527 Otherwise there's no need to make him wake up, and it could
6528 cause trouble (for example it would make Fsit_for return). */
6529 if (waiting_for_user_input_p
== -1)
6530 record_asynch_buffer_change ();
6532 unbind_to (count
, Qnil
);
6535 /* Report all recent events of a change in process status
6536 (either run the sentinel or output a message).
6537 This is usually done while Emacs is waiting for keyboard input
6538 but can be done at other times. */
6541 status_notify (deleting_process
)
6542 struct Lisp_Process
*deleting_process
;
6544 register Lisp_Object proc
, buffer
;
6545 Lisp_Object tail
, msg
;
6546 struct gcpro gcpro1
, gcpro2
;
6550 /* We need to gcpro tail; if read_process_output calls a filter
6551 which deletes a process and removes the cons to which tail points
6552 from Vprocess_alist, and then causes a GC, tail is an unprotected
6556 /* Set this now, so that if new processes are created by sentinels
6557 that we run, we get called again to handle their status changes. */
6558 update_tick
= process_tick
;
6560 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6563 register struct Lisp_Process
*p
;
6565 proc
= Fcdr (Fcar (tail
));
6566 p
= XPROCESS (proc
);
6568 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6570 XSETINT (p
->update_tick
, XINT (p
->tick
));
6572 /* If process is still active, read any output that remains. */
6573 while (! EQ (p
->filter
, Qt
)
6574 && ! EQ (p
->status
, Qconnect
)
6575 && ! EQ (p
->status
, Qlisten
)
6576 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6577 && XINT (p
->infd
) >= 0
6578 && p
!= deleting_process
6579 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6583 /* Get the text to use for the message. */
6584 if (p
->raw_status_new
)
6586 msg
= status_message (p
);
6588 /* If process is terminated, deactivate it or delete it. */
6590 if (CONSP (p
->status
))
6591 symbol
= XCAR (p
->status
);
6593 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6594 || EQ (symbol
, Qclosed
))
6596 if (delete_exited_processes
)
6597 remove_process (proc
);
6599 deactivate_process (proc
);
6602 /* The actions above may have further incremented p->tick.
6603 So set p->update_tick again
6604 so that an error in the sentinel will not cause
6605 this code to be run again. */
6606 XSETINT (p
->update_tick
, XINT (p
->tick
));
6607 /* Now output the message suitably. */
6608 if (!NILP (p
->sentinel
))
6609 exec_sentinel (proc
, msg
);
6610 /* Don't bother with a message in the buffer
6611 when a process becomes runnable. */
6612 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6614 Lisp_Object ro
, tem
;
6615 struct buffer
*old
= current_buffer
;
6616 int opoint
, opoint_byte
;
6617 int before
, before_byte
;
6619 ro
= XBUFFER (buffer
)->read_only
;
6621 /* Avoid error if buffer is deleted
6622 (probably that's why the process is dead, too) */
6623 if (NILP (XBUFFER (buffer
)->name
))
6625 Fset_buffer (buffer
);
6628 opoint_byte
= PT_BYTE
;
6629 /* Insert new output into buffer
6630 at the current end-of-output marker,
6631 thus preserving logical ordering of input and output. */
6632 if (XMARKER (p
->mark
)->buffer
)
6633 Fgoto_char (p
->mark
);
6635 SET_PT_BOTH (ZV
, ZV_BYTE
);
6638 before_byte
= PT_BYTE
;
6640 tem
= current_buffer
->read_only
;
6641 current_buffer
->read_only
= Qnil
;
6642 insert_string ("\nProcess ");
6643 Finsert (1, &p
->name
);
6644 insert_string (" ");
6646 current_buffer
->read_only
= tem
;
6647 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6649 if (opoint
>= before
)
6650 SET_PT_BOTH (opoint
+ (PT
- before
),
6651 opoint_byte
+ (PT_BYTE
- before_byte
));
6653 SET_PT_BOTH (opoint
, opoint_byte
);
6655 set_buffer_internal (old
);
6660 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6661 redisplay_preserve_echo_area (13);
6667 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6668 Sset_process_coding_system
, 1, 3, 0,
6669 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6670 DECODING will be used to decode subprocess output and ENCODING to
6671 encode subprocess input. */)
6672 (process
, decoding
, encoding
)
6673 register Lisp_Object process
, decoding
, encoding
;
6675 register struct Lisp_Process
*p
;
6677 CHECK_PROCESS (process
);
6678 p
= XPROCESS (process
);
6679 if (XINT (p
->infd
) < 0)
6680 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6681 if (XINT (p
->outfd
) < 0)
6682 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6683 Fcheck_coding_system (decoding
);
6684 Fcheck_coding_system (encoding
);
6686 p
->decode_coding_system
= decoding
;
6687 p
->encode_coding_system
= encoding
;
6688 setup_process_coding_systems (process
);
6693 DEFUN ("process-coding-system",
6694 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6695 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6697 register Lisp_Object process
;
6699 CHECK_PROCESS (process
);
6700 return Fcons (XPROCESS (process
)->decode_coding_system
,
6701 XPROCESS (process
)->encode_coding_system
);
6704 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6705 Sset_process_filter_multibyte
, 2, 2, 0,
6706 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6707 If FLAG is non-nil, the filter is given multibyte strings.
6708 If FLAG is nil, the filter is given unibyte strings. In this case,
6709 all character code conversion except for end-of-line conversion is
6712 Lisp_Object process
, flag
;
6714 register struct Lisp_Process
*p
;
6716 CHECK_PROCESS (process
);
6717 p
= XPROCESS (process
);
6718 p
->filter_multibyte
= flag
;
6719 setup_process_coding_systems (process
);
6724 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6725 Sprocess_filter_multibyte_p
, 1, 1, 0,
6726 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6728 Lisp_Object process
;
6730 register struct Lisp_Process
*p
;
6732 CHECK_PROCESS (process
);
6733 p
= XPROCESS (process
);
6735 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6740 /* The first time this is called, assume keyboard input comes from DESC
6741 instead of from where we used to expect it.
6742 Subsequent calls mean assume input keyboard can come from DESC
6743 in addition to other places. */
6745 static int add_keyboard_wait_descriptor_called_flag
;
6748 add_keyboard_wait_descriptor (desc
)
6751 if (! add_keyboard_wait_descriptor_called_flag
)
6752 FD_CLR (0, &input_wait_mask
);
6753 add_keyboard_wait_descriptor_called_flag
= 1;
6754 FD_SET (desc
, &input_wait_mask
);
6755 FD_SET (desc
, &non_process_wait_mask
);
6756 if (desc
> max_keyboard_desc
)
6757 max_keyboard_desc
= desc
;
6760 /* From now on, do not expect DESC to give keyboard input. */
6763 delete_keyboard_wait_descriptor (desc
)
6767 int lim
= max_keyboard_desc
;
6769 FD_CLR (desc
, &input_wait_mask
);
6770 FD_CLR (desc
, &non_process_wait_mask
);
6772 if (desc
== max_keyboard_desc
)
6773 for (fd
= 0; fd
< lim
; fd
++)
6774 if (FD_ISSET (fd
, &input_wait_mask
)
6775 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6776 max_keyboard_desc
= fd
;
6779 /* Return nonzero if *MASK has a bit set
6780 that corresponds to one of the keyboard input descriptors. */
6783 keyboard_bit_set (mask
)
6788 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6789 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6790 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6803 if (! noninteractive
|| initialized
)
6805 signal (SIGCHLD
, sigchld_handler
);
6808 FD_ZERO (&input_wait_mask
);
6809 FD_ZERO (&non_keyboard_wait_mask
);
6810 FD_ZERO (&non_process_wait_mask
);
6811 max_process_desc
= 0;
6813 #ifdef NON_BLOCKING_CONNECT
6814 FD_ZERO (&connect_wait_mask
);
6815 num_pending_connects
= 0;
6818 #ifdef ADAPTIVE_READ_BUFFERING
6819 process_output_delay_count
= 0;
6820 process_output_skip
= 0;
6823 FD_SET (0, &input_wait_mask
);
6825 Vprocess_alist
= Qnil
;
6826 for (i
= 0; i
< MAXDESC
; i
++)
6828 chan_process
[i
] = Qnil
;
6829 proc_buffered_char
[i
] = -1;
6831 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6832 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6833 #ifdef DATAGRAM_SOCKETS
6834 bzero (datagram_address
, sizeof datagram_address
);
6839 Lisp_Object subfeatures
= Qnil
;
6840 struct socket_options
*sopt
;
6842 #define ADD_SUBFEATURE(key, val) \
6843 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6845 #ifdef NON_BLOCKING_CONNECT
6846 ADD_SUBFEATURE (QCnowait
, Qt
);
6848 #ifdef DATAGRAM_SOCKETS
6849 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6851 #ifdef HAVE_LOCAL_SOCKETS
6852 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6854 ADD_SUBFEATURE (QCfamily
, Qipv4
);
6856 ADD_SUBFEATURE (QCfamily
, Qipv6
);
6858 #ifdef HAVE_GETSOCKNAME
6859 ADD_SUBFEATURE (QCservice
, Qt
);
6861 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6862 ADD_SUBFEATURE (QCserver
, Qt
);
6865 for (sopt
= socket_options
; sopt
->name
; sopt
++)
6866 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
6868 Fprovide (intern ("make-network-process"), subfeatures
);
6870 #endif /* HAVE_SOCKETS */
6872 #if defined (DARWIN) || defined (MAC_OSX)
6873 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
6874 processes. As such, we only change the default value. */
6877 char *release
= get_operating_system_release();
6878 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
6879 && release
[1] == '.')) {
6880 Vprocess_connection_type
= Qnil
;
6889 Qprocessp
= intern ("processp");
6890 staticpro (&Qprocessp
);
6891 Qrun
= intern ("run");
6893 Qstop
= intern ("stop");
6895 Qsignal
= intern ("signal");
6896 staticpro (&Qsignal
);
6898 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6901 Qexit = intern ("exit");
6902 staticpro (&Qexit); */
6904 Qopen
= intern ("open");
6906 Qclosed
= intern ("closed");
6907 staticpro (&Qclosed
);
6908 Qconnect
= intern ("connect");
6909 staticpro (&Qconnect
);
6910 Qfailed
= intern ("failed");
6911 staticpro (&Qfailed
);
6912 Qlisten
= intern ("listen");
6913 staticpro (&Qlisten
);
6914 Qlocal
= intern ("local");
6915 staticpro (&Qlocal
);
6916 Qipv4
= intern ("ipv4");
6919 Qipv6
= intern ("ipv6");
6922 Qdatagram
= intern ("datagram");
6923 staticpro (&Qdatagram
);
6925 QCname
= intern (":name");
6926 staticpro (&QCname
);
6927 QCbuffer
= intern (":buffer");
6928 staticpro (&QCbuffer
);
6929 QChost
= intern (":host");
6930 staticpro (&QChost
);
6931 QCservice
= intern (":service");
6932 staticpro (&QCservice
);
6933 QCtype
= intern (":type");
6934 staticpro (&QCtype
);
6935 QClocal
= intern (":local");
6936 staticpro (&QClocal
);
6937 QCremote
= intern (":remote");
6938 staticpro (&QCremote
);
6939 QCcoding
= intern (":coding");
6940 staticpro (&QCcoding
);
6941 QCserver
= intern (":server");
6942 staticpro (&QCserver
);
6943 QCnowait
= intern (":nowait");
6944 staticpro (&QCnowait
);
6945 QCsentinel
= intern (":sentinel");
6946 staticpro (&QCsentinel
);
6947 QClog
= intern (":log");
6949 QCnoquery
= intern (":noquery");
6950 staticpro (&QCnoquery
);
6951 QCstop
= intern (":stop");
6952 staticpro (&QCstop
);
6953 QCoptions
= intern (":options");
6954 staticpro (&QCoptions
);
6955 QCplist
= intern (":plist");
6956 staticpro (&QCplist
);
6957 QCfilter_multibyte
= intern (":filter-multibyte");
6958 staticpro (&QCfilter_multibyte
);
6960 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
6961 staticpro (&Qlast_nonmenu_event
);
6963 staticpro (&Vprocess_alist
);
6965 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
6966 doc
: /* *Non-nil means delete processes immediately when they exit.
6967 nil means don't delete them until `list-processes' is run. */);
6969 delete_exited_processes
= 1;
6971 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
6972 doc
: /* Control type of device used to communicate with subprocesses.
6973 Values are nil to use a pipe, or t or `pty' to use a pty.
6974 The value has no effect if the system has no ptys or if all ptys are busy:
6975 then a pipe is used in any case.
6976 The value takes effect when `start-process' is called. */);
6977 Vprocess_connection_type
= Qt
;
6979 #ifdef ADAPTIVE_READ_BUFFERING
6980 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
6981 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
6982 On some systems, when Emacs reads the output from a subprocess, the output data
6983 is read in very small blocks, potentially resulting in very poor performance.
6984 This behavior can be remedied to some extent by setting this variable to a
6985 non-nil value, as it will automatically delay reading from such processes, to
6986 allow them to produce more output before Emacs tries to read it.
6987 If the value is t, the delay is reset after each write to the process; any other
6988 non-nil value means that the delay is not reset on write.
6989 The variable takes effect when `start-process' is called. */);
6990 Vprocess_adaptive_read_buffering
= Qt
;
6993 defsubr (&Sprocessp
);
6994 defsubr (&Sget_process
);
6995 defsubr (&Sget_buffer_process
);
6996 defsubr (&Sdelete_process
);
6997 defsubr (&Sprocess_status
);
6998 defsubr (&Sprocess_exit_status
);
6999 defsubr (&Sprocess_id
);
7000 defsubr (&Sprocess_name
);
7001 defsubr (&Sprocess_tty_name
);
7002 defsubr (&Sprocess_command
);
7003 defsubr (&Sset_process_buffer
);
7004 defsubr (&Sprocess_buffer
);
7005 defsubr (&Sprocess_mark
);
7006 defsubr (&Sset_process_filter
);
7007 defsubr (&Sprocess_filter
);
7008 defsubr (&Sset_process_sentinel
);
7009 defsubr (&Sprocess_sentinel
);
7010 defsubr (&Sset_process_window_size
);
7011 defsubr (&Sset_process_inherit_coding_system_flag
);
7012 defsubr (&Sprocess_inherit_coding_system_flag
);
7013 defsubr (&Sset_process_query_on_exit_flag
);
7014 defsubr (&Sprocess_query_on_exit_flag
);
7015 defsubr (&Sprocess_contact
);
7016 defsubr (&Sprocess_plist
);
7017 defsubr (&Sset_process_plist
);
7018 defsubr (&Slist_processes
);
7019 defsubr (&Sprocess_list
);
7020 defsubr (&Sstart_process
);
7022 defsubr (&Sset_network_process_option
);
7023 defsubr (&Smake_network_process
);
7024 defsubr (&Sformat_network_address
);
7025 #endif /* HAVE_SOCKETS */
7026 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7028 defsubr (&Snetwork_interface_list
);
7030 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7031 defsubr (&Snetwork_interface_info
);
7033 #endif /* HAVE_SOCKETS ... */
7034 #ifdef DATAGRAM_SOCKETS
7035 defsubr (&Sprocess_datagram_address
);
7036 defsubr (&Sset_process_datagram_address
);
7038 defsubr (&Saccept_process_output
);
7039 defsubr (&Sprocess_send_region
);
7040 defsubr (&Sprocess_send_string
);
7041 defsubr (&Sinterrupt_process
);
7042 defsubr (&Skill_process
);
7043 defsubr (&Squit_process
);
7044 defsubr (&Sstop_process
);
7045 defsubr (&Scontinue_process
);
7046 defsubr (&Sprocess_running_child_p
);
7047 defsubr (&Sprocess_send_eof
);
7048 defsubr (&Ssignal_process
);
7049 defsubr (&Swaiting_for_user_input_p
);
7050 /* defsubr (&Sprocess_connection); */
7051 defsubr (&Sset_process_coding_system
);
7052 defsubr (&Sprocess_coding_system
);
7053 defsubr (&Sset_process_filter_multibyte
);
7054 defsubr (&Sprocess_filter_multibyte_p
);
7058 #else /* not subprocesses */
7060 #include <sys/types.h>
7064 #include "systime.h"
7065 #include "charset.h"
7067 #include "termopts.h"
7068 #include "sysselect.h"
7070 extern int frame_garbaged
;
7072 extern EMACS_TIME
timer_check ();
7073 extern int timers_run
;
7077 /* As described above, except assuming that there are no subprocesses:
7079 Wait for timeout to elapse and/or keyboard input to be available.
7082 timeout in seconds, or
7083 zero for no limit, or
7084 -1 means gobble data immediately available but don't wait for any.
7086 read_kbd is a Lisp_Object:
7087 0 to ignore keyboard input, or
7088 1 to return when input is available, or
7089 -1 means caller will actually read the input, so don't throw to
7092 see full version for other parameters. We know that wait_proc will
7093 always be NULL, since `subprocesses' isn't defined.
7095 do_display != 0 means redisplay should be done to show subprocess
7096 output that arrives.
7098 Return true iff we received input from any process. */
7101 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
7102 wait_for_cell
, wait_proc
, just_wait_proc
)
7103 int time_limit
, microsecs
, read_kbd
, do_display
;
7104 Lisp_Object wait_for_cell
;
7105 struct Lisp_Process
*wait_proc
;
7109 EMACS_TIME end_time
, timeout
;
7110 SELECT_TYPE waitchannels
;
7113 /* What does time_limit really mean? */
7114 if (time_limit
|| microsecs
)
7116 EMACS_GET_TIME (end_time
);
7117 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
7118 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
7121 /* Turn off periodic alarms (in case they are in use)
7122 and then turn off any other atimers,
7123 because the select emulator uses alarms. */
7125 turn_on_atimers (0);
7129 int timeout_reduced_for_timers
= 0;
7131 /* If calling from keyboard input, do not quit
7132 since we want to return C-g as an input character.
7133 Otherwise, do pending quit if requested. */
7137 /* Exit now if the cell we're waiting for became non-nil. */
7138 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7141 /* Compute time from now till when time limit is up */
7142 /* Exit if already run out */
7143 if (time_limit
== -1)
7145 /* -1 specified for timeout means
7146 gobble output available now
7147 but don't wait at all. */
7149 EMACS_SET_SECS_USECS (timeout
, 0, 0);
7151 else if (time_limit
|| microsecs
)
7153 EMACS_GET_TIME (timeout
);
7154 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
7155 if (EMACS_TIME_NEG_P (timeout
))
7160 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
7163 /* If our caller will not immediately handle keyboard events,
7164 run timer events directly.
7165 (Callers that will immediately read keyboard events
7166 call timer_delay on their own.) */
7167 if (NILP (wait_for_cell
))
7169 EMACS_TIME timer_delay
;
7173 int old_timers_run
= timers_run
;
7174 timer_delay
= timer_check (1);
7175 if (timers_run
!= old_timers_run
&& do_display
)
7176 /* We must retry, since a timer may have requeued itself
7177 and that could alter the time delay. */
7178 redisplay_preserve_echo_area (14);
7182 while (!detect_input_pending ());
7184 /* If there is unread keyboard input, also return. */
7186 && requeued_events_pending_p ())
7189 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
7191 EMACS_TIME difference
;
7192 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
7193 if (EMACS_TIME_NEG_P (difference
))
7195 timeout
= timer_delay
;
7196 timeout_reduced_for_timers
= 1;
7201 /* Cause C-g and alarm signals to take immediate action,
7202 and cause input available signals to zero out timeout. */
7204 set_waiting_for_input (&timeout
);
7206 /* Wait till there is something to do. */
7208 if (! read_kbd
&& NILP (wait_for_cell
))
7209 FD_ZERO (&waitchannels
);
7211 FD_SET (0, &waitchannels
);
7213 /* If a frame has been newly mapped and needs updating,
7214 reprocess its display stuff. */
7215 if (frame_garbaged
&& do_display
)
7217 clear_waiting_for_input ();
7218 redisplay_preserve_echo_area (15);
7220 set_waiting_for_input (&timeout
);
7223 if (read_kbd
&& detect_input_pending ())
7226 FD_ZERO (&waitchannels
);
7229 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7234 /* Make C-g and alarm signals set flags again */
7235 clear_waiting_for_input ();
7237 /* If we woke up due to SIGWINCH, actually change size now. */
7238 do_pending_window_change (0);
7240 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7241 /* We waited the full specified time, so return now. */
7246 /* If the system call was interrupted, then go around the
7248 if (xerrno
== EINTR
)
7249 FD_ZERO (&waitchannels
);
7251 error ("select error: %s", emacs_strerror (xerrno
));
7254 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7255 /* System sometimes fails to deliver SIGIO. */
7256 kill (getpid (), SIGIO
);
7259 if (read_kbd
&& interrupt_input
&& (waitchannels
& 1))
7260 kill (getpid (), SIGIO
);
7263 /* Check for keyboard input */
7266 && detect_input_pending_run_timers (do_display
))
7268 swallow_events (do_display
);
7269 if (detect_input_pending_run_timers (do_display
))
7273 /* If there is unread keyboard input, also return. */
7275 && requeued_events_pending_p ())
7278 /* If wait_for_cell. check for keyboard input
7279 but don't run any timers.
7280 ??? (It seems wrong to me to check for keyboard
7281 input at all when wait_for_cell, but the code
7282 has been this way since July 1994.
7283 Try changing this after version 19.31.) */
7284 if (! NILP (wait_for_cell
)
7285 && detect_input_pending ())
7287 swallow_events (do_display
);
7288 if (detect_input_pending ())
7292 /* Exit now if the cell we're waiting for became non-nil. */
7293 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7303 /* Don't confuse make-docfile by having two doc strings for this function.
7304 make-docfile does not pay attention to #if, for good reason! */
7305 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7308 register Lisp_Object name
;
7313 /* Don't confuse make-docfile by having two doc strings for this function.
7314 make-docfile does not pay attention to #if, for good reason! */
7315 DEFUN ("process-inherit-coding-system-flag",
7316 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7320 register Lisp_Object process
;
7322 /* Ignore the argument and return the value of
7323 inherit-process-coding-system. */
7324 return inherit_process_coding_system
? Qt
: Qnil
;
7327 /* Kill all processes associated with `buffer'.
7328 If `buffer' is nil, kill all processes.
7329 Since we have no subprocesses, this does nothing. */
7332 kill_buffer_processes (buffer
)
7345 QCtype
= intern (":type");
7346 staticpro (&QCtype
);
7348 defsubr (&Sget_buffer_process
);
7349 defsubr (&Sprocess_inherit_coding_system_flag
);
7353 #endif /* not subprocesses */
7355 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7356 (do not change this comment) */