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.
2326 The address format has been basically validated by
2327 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2328 it could have come from user data. So if FAMILY is not valid,
2329 we return after zeroing *SA. */
2332 conv_lisp_to_sockaddr (family
, address
, sa
, len
)
2334 Lisp_Object address
;
2335 struct sockaddr
*sa
;
2338 register struct Lisp_Vector
*p
;
2339 register unsigned char *cp
= NULL
;
2344 if (VECTORP (address
))
2346 p
= XVECTOR (address
);
2347 if (family
== AF_INET
)
2349 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2350 len
= sizeof (sin
->sin_addr
) + 1;
2351 i
= XINT (p
->contents
[--len
]);
2352 sin
->sin_port
= htons (i
);
2353 cp
= (unsigned char *)&sin
->sin_addr
;
2354 sa
->sa_family
= family
;
2357 else if (family
== AF_INET6
)
2359 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2360 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2361 len
= sizeof (sin6
->sin6_addr
) + 1;
2362 i
= XINT (p
->contents
[--len
]);
2363 sin6
->sin6_port
= htons (i
);
2364 for (i
= 0; i
< len
; i
++)
2365 if (INTEGERP (p
->contents
[i
]))
2367 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2370 sa
->sa_family
= family
;
2375 else if (STRINGP (address
))
2377 #ifdef HAVE_LOCAL_SOCKETS
2378 if (family
== AF_LOCAL
)
2380 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2381 cp
= SDATA (address
);
2382 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2383 sockun
->sun_path
[i
] = *cp
++;
2384 sa
->sa_family
= family
;
2391 p
= XVECTOR (XCDR (address
));
2392 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2395 for (i
= 0; i
< len
; i
++)
2396 if (INTEGERP (p
->contents
[i
]))
2397 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2400 #ifdef DATAGRAM_SOCKETS
2401 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2403 doc
: /* Get the current datagram address associated with PROCESS. */)
2405 Lisp_Object process
;
2409 CHECK_PROCESS (process
);
2411 if (!DATAGRAM_CONN_P (process
))
2414 channel
= XINT (XPROCESS (process
)->infd
);
2415 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2416 datagram_address
[channel
].len
);
2419 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2421 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2422 Returns nil upon error setting address, ADDRESS otherwise. */)
2424 Lisp_Object process
, address
;
2429 CHECK_PROCESS (process
);
2431 if (!DATAGRAM_CONN_P (process
))
2434 channel
= XINT (XPROCESS (process
)->infd
);
2436 len
= get_lisp_to_sockaddr_size (address
, &family
);
2437 if (datagram_address
[channel
].len
!= len
)
2439 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2445 static struct socket_options
{
2446 /* The name of this option. Should be lowercase version of option
2447 name without SO_ prefix. */
2449 /* Option level SOL_... */
2451 /* Option number SO_... */
2453 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2454 enum { OPIX_NONE
=0, OPIX_MISC
=1, OPIX_REUSEADDR
=2 } optbit
;
2455 } socket_options
[] =
2457 #ifdef SO_BINDTODEVICE
2458 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2461 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2464 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2467 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2470 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2473 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2476 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2479 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2481 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2484 /* Set option OPT to value VAL on socket S.
2486 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2487 Signals an error if setting a known option fails.
2491 set_socket_option (s
, opt
, val
)
2493 Lisp_Object opt
, val
;
2496 struct socket_options
*sopt
;
2501 name
= (char *) SDATA (SYMBOL_NAME (opt
));
2502 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2503 if (strcmp (name
, sopt
->name
) == 0)
2506 switch (sopt
->opttype
)
2511 optval
= NILP (val
) ? 0 : 1;
2512 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2513 &optval
, sizeof (optval
));
2521 optval
= XINT (val
);
2523 error ("Bad option value for %s", name
);
2524 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2525 &optval
, sizeof (optval
));
2529 #ifdef SO_BINDTODEVICE
2532 char devname
[IFNAMSIZ
+1];
2534 /* This is broken, at least in the Linux 2.4 kernel.
2535 To unbind, the arg must be a zero integer, not the empty string.
2536 This should work on all systems. KFS. 2003-09-23. */
2537 bzero (devname
, sizeof devname
);
2540 char *arg
= (char *) SDATA (val
);
2541 int len
= min (strlen (arg
), IFNAMSIZ
);
2542 bcopy (arg
, devname
, len
);
2544 else if (!NILP (val
))
2545 error ("Bad option value for %s", name
);
2546 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2555 struct linger linger
;
2558 linger
.l_linger
= 0;
2560 linger
.l_linger
= XINT (val
);
2562 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2563 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2564 &linger
, sizeof (linger
));
2574 report_file_error ("Cannot set network option",
2575 Fcons (opt
, Fcons (val
, Qnil
)));
2576 return (1 << sopt
->optbit
);
2580 DEFUN ("set-network-process-option",
2581 Fset_network_process_option
, Sset_network_process_option
,
2583 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2584 See `make-network-process' for a list of options and values.
2585 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2586 OPTION is not a supported option, return nil instead; otherwise return t. */)
2587 (process
, option
, value
, no_error
)
2588 Lisp_Object process
, option
, value
;
2589 Lisp_Object no_error
;
2592 struct Lisp_Process
*p
;
2594 CHECK_PROCESS (process
);
2595 p
= XPROCESS (process
);
2596 if (!NETCONN1_P (p
))
2597 error ("Process is not a network process");
2601 error ("Process is not running");
2603 if (set_socket_option (s
, option
, value
))
2605 p
->childp
= Fplist_put (p
->childp
, option
, value
);
2609 if (NILP (no_error
))
2610 error ("Unknown or unsupported option");
2616 /* A version of request_sigio suitable for a record_unwind_protect. */
2619 unwind_request_sigio (dummy
)
2622 if (interrupt_input
)
2627 /* Create a network stream/datagram client/server process. Treated
2628 exactly like a normal process when reading and writing. Primary
2629 differences are in status display and process deletion. A network
2630 connection has no PID; you cannot signal it. All you can do is
2631 stop/continue it and deactivate/close it via delete-process */
2633 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
2635 doc
: /* Create and return a network server or client process.
2637 In Emacs, network connections are represented by process objects, so
2638 input and output work as for subprocesses and `delete-process' closes
2639 a network connection. However, a network process has no process id,
2640 it cannot be signaled, and the status codes are different from normal
2643 Arguments are specified as keyword/argument pairs. The following
2644 arguments are defined:
2646 :name NAME -- NAME is name for process. It is modified if necessary
2649 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2650 with the process. Process output goes at end of that buffer, unless
2651 you specify an output stream or filter function to handle the output.
2652 BUFFER may be also nil, meaning that this process is not associated
2655 :host HOST -- HOST is name of the host to connect to, or its IP
2656 address. The symbol `local' specifies the local host. If specified
2657 for a server process, it must be a valid name or address for the local
2658 host, and only clients connecting to that address will be accepted.
2660 :service SERVICE -- SERVICE is name of the service desired, or an
2661 integer specifying a port number to connect to. If SERVICE is t,
2662 a random port number is selected for the server.
2664 :type TYPE -- TYPE is the type of connection. The default (nil) is a
2665 stream type connection, `datagram' creates a datagram type connection.
2667 :family FAMILY -- FAMILY is the address (and protocol) family for the
2668 service specified by HOST and SERVICE. The default (nil) is to use
2669 whatever address family (IPv4 or IPv6) that is defined for the host
2670 and port number specified by HOST and SERVICE. Other address families
2672 local -- for a local (i.e. UNIX) address specified by SERVICE.
2673 ipv4 -- use IPv4 address family only.
2674 ipv6 -- use IPv6 address family only.
2676 :local ADDRESS -- ADDRESS is the local address used for the connection.
2677 This parameter is ignored when opening a client process. When specified
2678 for a server process, the FAMILY, HOST and SERVICE args are ignored.
2680 :remote ADDRESS -- ADDRESS is the remote partner's address for the
2681 connection. This parameter is ignored when opening a stream server
2682 process. For a datagram server process, it specifies the initial
2683 setting of the remote datagram address. When specified for a client
2684 process, the FAMILY, HOST, and SERVICE args are ignored.
2686 The format of ADDRESS depends on the address family:
2687 - An IPv4 address is represented as an vector of integers [A B C D P]
2688 corresponding to numeric IP address A.B.C.D and port number P.
2689 - A local address is represented as a string with the address in the
2690 local address space.
2691 - An "unsupported family" address is represented by a cons (F . AV)
2692 where F is the family number and AV is a vector containing the socket
2693 address data with one element per address data byte. Do not rely on
2694 this format in portable code, as it may depend on implementation
2695 defined constants, data sizes, and data structure alignment.
2697 :coding CODING -- If CODING is a symbol, it specifies the coding
2698 system used for both reading and writing for this process. If CODING
2699 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2700 ENCODING is used for writing.
2702 :nowait BOOL -- If BOOL is non-nil for a stream type client process,
2703 return without waiting for the connection to complete; instead, the
2704 sentinel function will be called with second arg matching "open" (if
2705 successful) or "failed" when the connect completes. Default is to use
2706 a blocking connect (i.e. wait) for stream type connections.
2708 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2709 running when Emacs is exited.
2711 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2712 In the stopped state, a server process does not accept new
2713 connections, and a client process does not handle incoming traffic.
2714 The stopped state is cleared by `continue-process' and set by
2717 :filter FILTER -- Install FILTER as the process filter.
2719 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2720 process filter are multibyte, otherwise they are unibyte.
2721 If this keyword is not specified, the strings are multibyte iff
2722 `default-enable-multibyte-characters' is non-nil.
2724 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2726 :log LOG -- Install LOG as the server process log function. This
2727 function is called when the server accepts a network connection from a
2728 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2729 is the server process, CLIENT is the new process for the connection,
2730 and MESSAGE is a string.
2732 :plist PLIST -- Install PLIST as the new process' initial plist.
2734 :server QLEN -- if QLEN is non-nil, create a server process for the
2735 specified FAMILY, SERVICE, and connection type (stream or datagram).
2736 If QLEN is an integer, it is used as the max. length of the server's
2737 pending connection queue (also known as the backlog); the default
2738 queue length is 5. Default is to create a client process.
2740 The following network options can be specified for this connection:
2742 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
2743 :dontroute BOOL -- Only send to directly connected hosts.
2744 :keepalive BOOL -- Send keep-alive messages on network stream.
2745 :linger BOOL or TIMEOUT -- Send queued messages before closing.
2746 :oobinline BOOL -- Place out-of-band data in receive data stream.
2747 :priority INT -- Set protocol defined priority for sent packets.
2748 :reuseaddr BOOL -- Allow reusing a recently used local address
2749 (this is allowed by default for a server process).
2750 :bindtodevice NAME -- bind to interface NAME. Using this may require
2751 special privileges on some systems.
2753 Consult the relevant system programmer's manual pages for more
2754 information on using these options.
2757 A server process will listen for and accept connections from clients.
2758 When a client connection is accepted, a new network process is created
2759 for the connection with the following parameters:
2761 - The client's process name is constructed by concatenating the server
2762 process' NAME and a client identification string.
2763 - If the FILTER argument is non-nil, the client process will not get a
2764 separate process buffer; otherwise, the client's process buffer is a newly
2765 created buffer named after the server process' BUFFER name or process
2766 NAME concatenated with the client identification string.
2767 - The connection type and the process filter and sentinel parameters are
2768 inherited from the server process' TYPE, FILTER and SENTINEL.
2769 - The client process' contact info is set according to the client's
2770 addressing information (typically an IP address and a port number).
2771 - The client process' plist is initialized from the server's plist.
2773 Notice that the FILTER and SENTINEL args are never used directly by
2774 the server process. Also, the BUFFER argument is not used directly by
2775 the server process, but via the optional :log function, accepted (and
2776 failed) connections may be logged in the server process' buffer.
2778 The original argument list, modified with the actual connection
2779 information, is available via the `process-contact' function.
2781 usage: (make-network-process &rest ARGS) */)
2787 Lisp_Object contact
;
2788 struct Lisp_Process
*p
;
2789 #ifdef HAVE_GETADDRINFO
2790 struct addrinfo ai
, *res
, *lres
;
2791 struct addrinfo hints
;
2792 char *portstring
, portbuf
[128];
2793 #else /* HAVE_GETADDRINFO */
2794 struct _emacs_addrinfo
2800 struct sockaddr
*ai_addr
;
2801 struct _emacs_addrinfo
*ai_next
;
2803 #endif /* HAVE_GETADDRINFO */
2804 struct sockaddr_in address_in
;
2805 #ifdef HAVE_LOCAL_SOCKETS
2806 struct sockaddr_un address_un
;
2811 int s
= -1, outch
, inch
;
2812 struct gcpro gcpro1
;
2813 int count
= SPECPDL_INDEX ();
2815 Lisp_Object QCaddress
; /* one of QClocal or QCremote */
2817 Lisp_Object name
, buffer
, host
, service
, address
;
2818 Lisp_Object filter
, sentinel
;
2819 int is_non_blocking_client
= 0;
2820 int is_server
= 0, backlog
= 5;
2827 /* Save arguments for process-contact and clone-process. */
2828 contact
= Flist (nargs
, args
);
2832 /* Ensure socket support is loaded if available. */
2833 init_winsock (TRUE
);
2836 /* :type TYPE (nil: stream, datagram */
2837 tem
= Fplist_get (contact
, QCtype
);
2839 socktype
= SOCK_STREAM
;
2840 #ifdef DATAGRAM_SOCKETS
2841 else if (EQ (tem
, Qdatagram
))
2842 socktype
= SOCK_DGRAM
;
2845 error ("Unsupported connection type");
2848 tem
= Fplist_get (contact
, QCserver
);
2851 /* Don't support network sockets when non-blocking mode is
2852 not available, since a blocked Emacs is not useful. */
2853 #if defined(TERM) || (!defined(O_NONBLOCK) && !defined(O_NDELAY))
2854 error ("Network servers not supported");
2858 backlog
= XINT (tem
);
2862 /* Make QCaddress an alias for :local (server) or :remote (client). */
2863 QCaddress
= is_server
? QClocal
: QCremote
;
2866 if (!is_server
&& socktype
== SOCK_STREAM
2867 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
2869 #ifndef NON_BLOCKING_CONNECT
2870 error ("Non-blocking connect not supported");
2872 is_non_blocking_client
= 1;
2876 name
= Fplist_get (contact
, QCname
);
2877 buffer
= Fplist_get (contact
, QCbuffer
);
2878 filter
= Fplist_get (contact
, QCfilter
);
2879 sentinel
= Fplist_get (contact
, QCsentinel
);
2881 CHECK_STRING (name
);
2884 /* Let's handle TERM before things get complicated ... */
2885 host
= Fplist_get (contact
, QChost
);
2886 CHECK_STRING (host
);
2888 service
= Fplist_get (contact
, QCservice
);
2889 if (INTEGERP (service
))
2890 port
= htons ((unsigned short) XINT (service
));
2893 struct servent
*svc_info
;
2894 CHECK_STRING (service
);
2895 svc_info
= getservbyname (SDATA (service
), "tcp");
2897 error ("Unknown service: %s", SDATA (service
));
2898 port
= svc_info
->s_port
;
2901 s
= connect_server (0);
2903 report_file_error ("error creating socket", Fcons (name
, Qnil
));
2904 send_command (s
, C_PORT
, 0, "%s:%d", SDATA (host
), ntohs (port
));
2905 send_command (s
, C_DUMB
, 1, 0);
2907 #else /* not TERM */
2909 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2910 ai
.ai_socktype
= socktype
;
2915 /* :local ADDRESS or :remote ADDRESS */
2916 address
= Fplist_get (contact
, QCaddress
);
2917 if (!NILP (address
))
2919 host
= service
= Qnil
;
2921 if (!(ai
.ai_addrlen
= get_lisp_to_sockaddr_size (address
, &family
)))
2922 error ("Malformed :address");
2923 ai
.ai_family
= family
;
2924 ai
.ai_addr
= alloca (ai
.ai_addrlen
);
2925 conv_lisp_to_sockaddr (family
, address
, ai
.ai_addr
, ai
.ai_addrlen
);
2929 /* :family FAMILY -- nil (for Inet), local, or integer. */
2930 tem
= Fplist_get (contact
, QCfamily
);
2933 #if defined(HAVE_GETADDRINFO) && defined(AF_INET6)
2939 #ifdef HAVE_LOCAL_SOCKETS
2940 else if (EQ (tem
, Qlocal
))
2944 else if (EQ (tem
, Qipv6
))
2947 else if (EQ (tem
, Qipv4
))
2949 else if (INTEGERP (tem
))
2950 family
= XINT (tem
);
2952 error ("Unknown address family");
2954 ai
.ai_family
= family
;
2956 /* :service SERVICE -- string, integer (port number), or t (random port). */
2957 service
= Fplist_get (contact
, QCservice
);
2959 #ifdef HAVE_LOCAL_SOCKETS
2960 if (family
== AF_LOCAL
)
2962 /* Host is not used. */
2964 CHECK_STRING (service
);
2965 bzero (&address_un
, sizeof address_un
);
2966 address_un
.sun_family
= AF_LOCAL
;
2967 strncpy (address_un
.sun_path
, SDATA (service
), sizeof address_un
.sun_path
);
2968 ai
.ai_addr
= (struct sockaddr
*) &address_un
;
2969 ai
.ai_addrlen
= sizeof address_un
;
2974 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2975 host
= Fplist_get (contact
, QChost
);
2978 if (EQ (host
, Qlocal
))
2979 host
= build_string ("localhost");
2980 CHECK_STRING (host
);
2983 /* Slow down polling to every ten seconds.
2984 Some kernels have a bug which causes retrying connect to fail
2985 after a connect. Polling can interfere with gethostbyname too. */
2986 #ifdef POLL_FOR_INPUT
2987 if (socktype
== SOCK_STREAM
)
2989 record_unwind_protect (unwind_stop_other_atimers
, Qnil
);
2990 bind_polling_period (10);
2994 #ifdef HAVE_GETADDRINFO
2995 /* If we have a host, use getaddrinfo to resolve both host and service.
2996 Otherwise, use getservbyname to lookup the service. */
3000 /* SERVICE can either be a string or int.
3001 Convert to a C string for later use by getaddrinfo. */
3002 if (EQ (service
, Qt
))
3004 else if (INTEGERP (service
))
3006 sprintf (portbuf
, "%ld", (long) XINT (service
));
3007 portstring
= portbuf
;
3011 CHECK_STRING (service
);
3012 portstring
= SDATA (service
);
3017 memset (&hints
, 0, sizeof (hints
));
3019 hints
.ai_family
= family
;
3020 hints
.ai_socktype
= socktype
;
3021 hints
.ai_protocol
= 0;
3022 ret
= getaddrinfo (SDATA (host
), portstring
, &hints
, &res
);
3024 #ifdef HAVE_GAI_STRERROR
3025 error ("%s/%s %s", SDATA (host
), portstring
, gai_strerror(ret
));
3027 error ("%s/%s getaddrinfo error %d", SDATA (host
), portstring
, ret
);
3033 #endif /* HAVE_GETADDRINFO */
3035 /* We end up here if getaddrinfo is not defined, or in case no hostname
3036 has been specified (e.g. for a local server process). */
3038 if (EQ (service
, Qt
))
3040 else if (INTEGERP (service
))
3041 port
= htons ((unsigned short) XINT (service
));
3044 struct servent
*svc_info
;
3045 CHECK_STRING (service
);
3046 svc_info
= getservbyname (SDATA (service
),
3047 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3049 error ("Unknown service: %s", SDATA (service
));
3050 port
= svc_info
->s_port
;
3053 bzero (&address_in
, sizeof address_in
);
3054 address_in
.sin_family
= family
;
3055 address_in
.sin_addr
.s_addr
= INADDR_ANY
;
3056 address_in
.sin_port
= port
;
3058 #ifndef HAVE_GETADDRINFO
3061 struct hostent
*host_info_ptr
;
3063 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
3064 as it may `hang' Emacs for a very long time. */
3067 host_info_ptr
= gethostbyname (SDATA (host
));
3072 bcopy (host_info_ptr
->h_addr
, (char *) &address_in
.sin_addr
,
3073 host_info_ptr
->h_length
);
3074 family
= host_info_ptr
->h_addrtype
;
3075 address_in
.sin_family
= family
;
3078 /* Attempt to interpret host as numeric inet address */
3080 IN_ADDR numeric_addr
;
3081 numeric_addr
= inet_addr ((char *) SDATA (host
));
3082 if (NUMERIC_ADDR_ERROR
)
3083 error ("Unknown host \"%s\"", SDATA (host
));
3085 bcopy ((char *)&numeric_addr
, (char *) &address_in
.sin_addr
,
3086 sizeof (address_in
.sin_addr
));
3090 #endif /* not HAVE_GETADDRINFO */
3092 ai
.ai_family
= family
;
3093 ai
.ai_addr
= (struct sockaddr
*) &address_in
;
3094 ai
.ai_addrlen
= sizeof address_in
;
3098 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
3099 when connect is interrupted. So let's not let it get interrupted.
3100 Note we do not turn off polling, because polling is only used
3101 when not interrupt_input, and thus not normally used on the systems
3102 which have this bug. On systems which use polling, there's no way
3103 to quit if polling is turned off. */
3105 && !is_server
&& socktype
== SOCK_STREAM
)
3107 /* Comment from KFS: The original open-network-stream code
3108 didn't unwind protect this, but it seems like the proper
3109 thing to do. In any case, I don't see how it could harm to
3110 do this -- and it makes cleanup (using unbind_to) easier. */
3111 record_unwind_protect (unwind_request_sigio
, Qnil
);
3115 /* Do this in case we never enter the for-loop below. */
3116 count1
= SPECPDL_INDEX ();
3119 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3125 s
= socket (lres
->ai_family
, lres
->ai_socktype
, lres
->ai_protocol
);
3132 #ifdef DATAGRAM_SOCKETS
3133 if (!is_server
&& socktype
== SOCK_DGRAM
)
3135 #endif /* DATAGRAM_SOCKETS */
3137 #ifdef NON_BLOCKING_CONNECT
3138 if (is_non_blocking_client
)
3141 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3143 ret
= fcntl (s
, F_SETFL
, O_NDELAY
);
3155 /* Make us close S if quit. */
3156 record_unwind_protect (close_file_unwind
, make_number (s
));
3158 /* Parse network options in the arg list.
3159 We simply ignore anything which isn't a known option (including other keywords).
3160 An error is signalled if setting a known option fails. */
3161 for (optn
= optbits
= 0; optn
< nargs
-1; optn
+= 2)
3162 optbits
|= set_socket_option (s
, args
[optn
], args
[optn
+1]);
3166 /* Configure as a server socket. */
3168 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3169 explicit :reuseaddr key to override this. */
3170 #ifdef HAVE_LOCAL_SOCKETS
3171 if (family
!= AF_LOCAL
)
3173 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3176 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3177 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3180 if (bind (s
, lres
->ai_addr
, lres
->ai_addrlen
))
3181 report_file_error ("Cannot bind server socket", Qnil
);
3183 #ifdef HAVE_GETSOCKNAME
3184 if (EQ (service
, Qt
))
3186 struct sockaddr_in sa1
;
3187 int len1
= sizeof (sa1
);
3188 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3190 ((struct sockaddr_in
*)(lres
->ai_addr
))->sin_port
= sa1
.sin_port
;
3191 service
= make_number (ntohs (sa1
.sin_port
));
3192 contact
= Fplist_put (contact
, QCservice
, service
);
3197 if (socktype
== SOCK_STREAM
&& listen (s
, backlog
))
3198 report_file_error ("Cannot listen on server socket", Qnil
);
3206 /* This turns off all alarm-based interrupts; the
3207 bind_polling_period call above doesn't always turn all the
3208 short-interval ones off, especially if interrupt_input is
3211 It'd be nice to be able to control the connect timeout
3212 though. Would non-blocking connect calls be portable?
3214 This used to be conditioned by HAVE_GETADDRINFO. Why? */
3216 turn_on_atimers (0);
3218 ret
= connect (s
, lres
->ai_addr
, lres
->ai_addrlen
);
3221 turn_on_atimers (1);
3223 if (ret
== 0 || xerrno
== EISCONN
)
3225 /* The unwind-protect will be discarded afterwards.
3226 Likewise for immediate_quit. */
3230 #ifdef NON_BLOCKING_CONNECT
3232 if (is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3236 if (is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3244 /* Discard the unwind protect closing S. */
3245 specpdl_ptr
= specpdl
+ count1
;
3249 if (xerrno
== EINTR
)
3255 #ifdef DATAGRAM_SOCKETS
3256 if (socktype
== SOCK_DGRAM
)
3258 if (datagram_address
[s
].sa
)
3260 datagram_address
[s
].sa
= (struct sockaddr
*) xmalloc (lres
->ai_addrlen
);
3261 datagram_address
[s
].len
= lres
->ai_addrlen
;
3265 bzero (datagram_address
[s
].sa
, lres
->ai_addrlen
);
3266 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3269 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3270 if (rfamily
== lres
->ai_family
&& rlen
== lres
->ai_addrlen
)
3271 conv_lisp_to_sockaddr (rfamily
, remote
,
3272 datagram_address
[s
].sa
, rlen
);
3276 bcopy (lres
->ai_addr
, datagram_address
[s
].sa
, lres
->ai_addrlen
);
3279 contact
= Fplist_put (contact
, QCaddress
,
3280 conv_sockaddr_to_lisp (lres
->ai_addr
, lres
->ai_addrlen
));
3281 #ifdef HAVE_GETSOCKNAME
3284 struct sockaddr_in sa1
;
3285 int len1
= sizeof (sa1
);
3286 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3287 contact
= Fplist_put (contact
, QClocal
,
3288 conv_sockaddr_to_lisp (&sa1
, len1
));
3293 #ifdef HAVE_GETADDRINFO
3300 /* Discard the unwind protect for closing S, if any. */
3301 specpdl_ptr
= specpdl
+ count1
;
3303 /* Unwind bind_polling_period and request_sigio. */
3304 unbind_to (count
, Qnil
);
3308 /* If non-blocking got this far - and failed - assume non-blocking is
3309 not supported after all. This is probably a wrong assumption, but
3310 the normal blocking calls to open-network-stream handles this error
3312 if (is_non_blocking_client
)
3317 report_file_error ("make server process failed", contact
);
3319 report_file_error ("make client process failed", contact
);
3322 #endif /* not TERM */
3328 buffer
= Fget_buffer_create (buffer
);
3329 proc
= make_process (name
);
3331 chan_process
[inch
] = proc
;
3334 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3337 fcntl (inch
, F_SETFL
, O_NDELAY
);
3341 p
= XPROCESS (proc
);
3343 p
->childp
= contact
;
3344 p
->plist
= Fcopy_sequence (Fplist_get (contact
, QCplist
));
3347 p
->sentinel
= sentinel
;
3349 p
->filter_multibyte
= buffer_defaults
.enable_multibyte_characters
;
3350 /* Override the above only if :filter-multibyte is specified. */
3351 if (! NILP (Fplist_member (contact
, QCfilter_multibyte
)))
3352 p
->filter_multibyte
= Fplist_get (contact
, QCfilter_multibyte
);
3353 p
->log
= Fplist_get (contact
, QClog
);
3354 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3355 p
->kill_without_query
= Qt
;
3356 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3359 XSETINT (p
->infd
, inch
);
3360 XSETINT (p
->outfd
, outch
);
3361 if (is_server
&& socktype
== SOCK_STREAM
)
3362 p
->status
= Qlisten
;
3364 /* Make the process marker point into the process buffer (if any). */
3365 if (BUFFERP (buffer
))
3366 set_marker_both (p
->mark
, buffer
,
3367 BUF_ZV (XBUFFER (buffer
)),
3368 BUF_ZV_BYTE (XBUFFER (buffer
)));
3370 #ifdef NON_BLOCKING_CONNECT
3371 if (is_non_blocking_client
)
3373 /* We may get here if connect did succeed immediately. However,
3374 in that case, we still need to signal this like a non-blocking
3376 p
->status
= Qconnect
;
3377 if (!FD_ISSET (inch
, &connect_wait_mask
))
3379 FD_SET (inch
, &connect_wait_mask
);
3380 num_pending_connects
++;
3385 /* A server may have a client filter setting of Qt, but it must
3386 still listen for incoming connects unless it is stopped. */
3387 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3388 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3390 FD_SET (inch
, &input_wait_mask
);
3391 FD_SET (inch
, &non_keyboard_wait_mask
);
3394 if (inch
> max_process_desc
)
3395 max_process_desc
= inch
;
3397 tem
= Fplist_member (contact
, QCcoding
);
3398 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3399 tem
= Qnil
; /* No error message (too late!). */
3402 /* Setup coding systems for communicating with the network stream. */
3403 struct gcpro gcpro1
;
3404 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3405 Lisp_Object coding_systems
= Qt
;
3406 Lisp_Object args
[5], val
;
3410 val
= XCAR (XCDR (tem
));
3414 else if (!NILP (Vcoding_system_for_read
))
3415 val
= Vcoding_system_for_read
;
3416 else if ((!NILP (buffer
) && NILP (XBUFFER (buffer
)->enable_multibyte_characters
))
3417 || (NILP (buffer
) && NILP (buffer_defaults
.enable_multibyte_characters
)))
3418 /* We dare not decode end-of-line format by setting VAL to
3419 Qraw_text, because the existing Emacs Lisp libraries
3420 assume that they receive bare code including a sequene of
3425 if (NILP (host
) || NILP (service
))
3426 coding_systems
= Qnil
;
3429 args
[0] = Qopen_network_stream
, args
[1] = name
,
3430 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3432 coding_systems
= Ffind_operation_coding_system (5, args
);
3435 if (CONSP (coding_systems
))
3436 val
= XCAR (coding_systems
);
3437 else if (CONSP (Vdefault_process_coding_system
))
3438 val
= XCAR (Vdefault_process_coding_system
);
3442 p
->decode_coding_system
= val
;
3446 val
= XCAR (XCDR (tem
));
3450 else if (!NILP (Vcoding_system_for_write
))
3451 val
= Vcoding_system_for_write
;
3452 else if (NILP (current_buffer
->enable_multibyte_characters
))
3456 if (EQ (coding_systems
, Qt
))
3458 if (NILP (host
) || NILP (service
))
3459 coding_systems
= Qnil
;
3462 args
[0] = Qopen_network_stream
, args
[1] = name
,
3463 args
[2] = buffer
, args
[3] = host
, args
[4] = service
;
3465 coding_systems
= Ffind_operation_coding_system (5, args
);
3469 if (CONSP (coding_systems
))
3470 val
= XCDR (coding_systems
);
3471 else if (CONSP (Vdefault_process_coding_system
))
3472 val
= XCDR (Vdefault_process_coding_system
);
3476 p
->encode_coding_system
= val
;
3478 setup_process_coding_systems (proc
);
3480 p
->decoding_buf
= make_uninit_string (0);
3481 p
->decoding_carryover
= make_number (0);
3482 p
->encoding_buf
= make_uninit_string (0);
3483 p
->encoding_carryover
= make_number (0);
3485 p
->inherit_coding_system_flag
3486 = (!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
3492 #endif /* HAVE_SOCKETS */
3495 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
3498 DEFUN ("network-interface-list", Fnetwork_interface_list
, Snetwork_interface_list
, 0, 0, 0,
3499 doc
: /* Return an alist of all network interfaces and their network address.
3500 Each element is a cons, the car of which is a string containing the
3501 interface name, and the cdr is the network address in internal
3502 format; see the description of ADDRESS in `make-network-process'. */)
3505 struct ifconf ifconf
;
3506 struct ifreq
*ifreqs
= NULL
;
3511 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3517 buf_size
= ifaces
* sizeof(ifreqs
[0]);
3518 ifreqs
= (struct ifreq
*)xrealloc(ifreqs
, buf_size
);
3525 ifconf
.ifc_len
= buf_size
;
3526 ifconf
.ifc_req
= ifreqs
;
3527 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3533 if (ifconf
.ifc_len
== buf_size
)
3537 ifaces
= ifconf
.ifc_len
/ sizeof (ifreqs
[0]);
3540 while (--ifaces
>= 0)
3542 struct ifreq
*ifq
= &ifreqs
[ifaces
];
3543 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3544 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3546 bcopy (ifq
->ifr_name
, namebuf
, sizeof (ifq
->ifr_name
));
3547 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
3548 res
= Fcons (Fcons (build_string (namebuf
),
3549 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
3550 sizeof (struct sockaddr
))),
3556 #endif /* SIOCGIFCONF */
3558 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
3565 static struct ifflag_def ifflag_table
[] = {
3569 #ifdef IFF_BROADCAST
3570 { IFF_BROADCAST
, "broadcast" },
3573 { IFF_DEBUG
, "debug" },
3576 { IFF_LOOPBACK
, "loopback" },
3578 #ifdef IFF_POINTOPOINT
3579 { IFF_POINTOPOINT
, "pointopoint" },
3582 { IFF_RUNNING
, "running" },
3585 { IFF_NOARP
, "noarp" },
3588 { IFF_PROMISC
, "promisc" },
3590 #ifdef IFF_NOTRAILERS
3591 { IFF_NOTRAILERS
, "notrailers" },
3594 { IFF_ALLMULTI
, "allmulti" },
3597 { IFF_MASTER
, "master" },
3600 { IFF_SLAVE
, "slave" },
3602 #ifdef IFF_MULTICAST
3603 { IFF_MULTICAST
, "multicast" },
3606 { IFF_PORTSEL
, "portsel" },
3608 #ifdef IFF_AUTOMEDIA
3609 { IFF_AUTOMEDIA
, "automedia" },
3612 { IFF_DYNAMIC
, "dynamic" },
3615 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress */
3618 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions */
3621 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit */
3624 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit */
3627 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit */
3632 DEFUN ("network-interface-info", Fnetwork_interface_info
, Snetwork_interface_info
, 1, 1, 0,
3633 doc
: /* Return information about network interface named IFNAME.
3634 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3635 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
3636 NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
3637 FLAGS is the current flags of the interface. */)
3642 Lisp_Object res
= Qnil
;
3647 CHECK_STRING (ifname
);
3649 bzero (rq
.ifr_name
, sizeof rq
.ifr_name
);
3650 strncpy (rq
.ifr_name
, SDATA (ifname
), sizeof (rq
.ifr_name
));
3652 s
= socket (AF_INET
, SOCK_STREAM
, 0);
3657 #if defined(SIOCGIFFLAGS) && defined(HAVE_STRUCT_IFREQ_IFR_FLAGS)
3658 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
3660 int flags
= rq
.ifr_flags
;
3661 struct ifflag_def
*fp
;
3665 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
3667 if (flags
& fp
->flag_bit
)
3669 elt
= Fcons (intern (fp
->flag_sym
), elt
);
3670 flags
-= fp
->flag_bit
;
3673 for (fnum
= 0; flags
&& fnum
< 32; fnum
++)
3675 if (flags
& (1 << fnum
))
3677 elt
= Fcons (make_number (fnum
), elt
);
3682 res
= Fcons (elt
, res
);
3685 #if defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
3686 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
3688 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
3689 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
3693 for (n
= 0; n
< 6; n
++)
3694 p
->contents
[n
] = make_number (((unsigned char *)&rq
.ifr_hwaddr
.sa_data
[0])[n
]);
3695 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
3698 res
= Fcons (elt
, res
);
3701 #if defined(SIOCGIFNETMASK) && (defined(HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined(HAVE_STRUCT_IFREQ_IFR_ADDR))
3702 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
3705 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
3706 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
3708 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3712 res
= Fcons (elt
, res
);
3715 #if defined(SIOCGIFBRDADDR) && defined(HAVE_STRUCT_IFREQ_IFR_BROADADDR)
3716 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
3719 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
3722 res
= Fcons (elt
, res
);
3725 #if defined(SIOCGIFADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ADDR)
3726 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
3729 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
3732 res
= Fcons (elt
, res
);
3736 return any
? res
: Qnil
;
3739 #endif /* HAVE_SOCKETS */
3741 /* Turn off input and output for process PROC. */
3744 deactivate_process (proc
)
3747 register int inchannel
, outchannel
;
3748 register struct Lisp_Process
*p
= XPROCESS (proc
);
3750 inchannel
= XINT (p
->infd
);
3751 outchannel
= XINT (p
->outfd
);
3753 #ifdef ADAPTIVE_READ_BUFFERING
3754 if (XINT (p
->read_output_delay
) > 0)
3756 if (--process_output_delay_count
< 0)
3757 process_output_delay_count
= 0;
3758 XSETINT (p
->read_output_delay
, 0);
3759 p
->read_output_skip
= Qnil
;
3765 /* Beware SIGCHLD hereabouts. */
3766 flush_pending_output (inchannel
);
3769 VMS_PROC_STUFF
*get_vms_process_pointer (), *vs
;
3770 sys$
dassgn (outchannel
);
3771 vs
= get_vms_process_pointer (p
->pid
);
3773 give_back_vms_process_stuff (vs
);
3776 emacs_close (inchannel
);
3777 if (outchannel
>= 0 && outchannel
!= inchannel
)
3778 emacs_close (outchannel
);
3781 XSETINT (p
->infd
, -1);
3782 XSETINT (p
->outfd
, -1);
3783 #ifdef DATAGRAM_SOCKETS
3784 if (DATAGRAM_CHAN_P (inchannel
))
3786 xfree (datagram_address
[inchannel
].sa
);
3787 datagram_address
[inchannel
].sa
= 0;
3788 datagram_address
[inchannel
].len
= 0;
3791 chan_process
[inchannel
] = Qnil
;
3792 FD_CLR (inchannel
, &input_wait_mask
);
3793 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
3794 #ifdef NON_BLOCKING_CONNECT
3795 if (FD_ISSET (inchannel
, &connect_wait_mask
))
3797 FD_CLR (inchannel
, &connect_wait_mask
);
3798 if (--num_pending_connects
< 0)
3802 if (inchannel
== max_process_desc
)
3805 /* We just closed the highest-numbered process input descriptor,
3806 so recompute the highest-numbered one now. */
3807 max_process_desc
= 0;
3808 for (i
= 0; i
< MAXDESC
; i
++)
3809 if (!NILP (chan_process
[i
]))
3810 max_process_desc
= i
;
3815 /* Close all descriptors currently in use for communication
3816 with subprocess. This is used in a newly-forked subprocess
3817 to get rid of irrelevant descriptors. */
3820 close_process_descs ()
3824 for (i
= 0; i
< MAXDESC
; i
++)
3826 Lisp_Object process
;
3827 process
= chan_process
[i
];
3828 if (!NILP (process
))
3830 int in
= XINT (XPROCESS (process
)->infd
);
3831 int out
= XINT (XPROCESS (process
)->outfd
);
3834 if (out
>= 0 && in
!= out
)
3841 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
3843 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
3844 It is read into the process' buffers or given to their filter functions.
3845 Non-nil arg PROCESS means do not return until some output has been received
3848 Non-nil second arg SECONDS and third arg MILLISEC are number of
3849 seconds and milliseconds to wait; return after that much time whether
3850 or not there is input. If SECONDS is a floating point number,
3851 it specifies a fractional number of seconds to wait.
3853 If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3854 from PROCESS, suspending reading output from other processes.
3855 If JUST-THIS-ONE is an integer, don't run any timers either.
3856 Return non-nil iff we received any output before the timeout expired. */)
3857 (process
, seconds
, millisec
, just_this_one
)
3858 register Lisp_Object process
, seconds
, millisec
, just_this_one
;
3860 int secs
, usecs
= 0;
3862 if (! NILP (process
))
3863 CHECK_PROCESS (process
);
3865 just_this_one
= Qnil
;
3867 if (!NILP (seconds
))
3869 if (INTEGERP (seconds
))
3870 secs
= XINT (seconds
);
3871 else if (FLOATP (seconds
))
3873 double timeout
= XFLOAT_DATA (seconds
);
3874 secs
= (int) timeout
;
3875 usecs
= (int) ((timeout
- (double) secs
) * 1000000);
3878 wrong_type_argument (Qnumberp
, seconds
);
3880 if (INTEGERP (millisec
))
3883 usecs
+= XINT (millisec
) * 1000;
3884 carry
= usecs
/ 1000000;
3886 if ((usecs
-= carry
* 1000000) < 0)
3893 if (secs
< 0 || (secs
== 0 && usecs
== 0))
3894 secs
= -1, usecs
= 0;
3897 secs
= NILP (process
) ? -1 : 0;
3900 (wait_reading_process_output (secs
, usecs
, 0, 0,
3902 !NILP (process
) ? XPROCESS (process
) : NULL
,
3903 NILP (just_this_one
) ? 0 :
3904 !INTEGERP (just_this_one
) ? 1 : -1)
3908 /* Accept a connection for server process SERVER on CHANNEL. */
3910 static int connect_counter
= 0;
3913 server_accept_connection (server
, channel
)
3917 Lisp_Object proc
, caller
, name
, buffer
;
3918 Lisp_Object contact
, host
, service
;
3919 struct Lisp_Process
*ps
= XPROCESS (server
);
3920 struct Lisp_Process
*p
;
3924 struct sockaddr_in in
;
3926 struct sockaddr_in6 in6
;
3928 #ifdef HAVE_LOCAL_SOCKETS
3929 struct sockaddr_un un
;
3932 int len
= sizeof saddr
;
3934 s
= accept (channel
, &saddr
.sa
, &len
);
3943 if (code
== EWOULDBLOCK
)
3947 if (!NILP (ps
->log
))
3948 call3 (ps
->log
, server
, Qnil
,
3949 concat3 (build_string ("accept failed with code"),
3950 Fnumber_to_string (make_number (code
)),
3951 build_string ("\n")));
3957 /* Setup a new process to handle the connection. */
3959 /* Generate a unique identification of the caller, and build contact
3960 information for this process. */
3963 switch (saddr
.sa
.sa_family
)
3967 Lisp_Object args
[5];
3968 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
3969 args
[0] = build_string ("%d.%d.%d.%d");
3970 args
[1] = make_number (*ip
++);
3971 args
[2] = make_number (*ip
++);
3972 args
[3] = make_number (*ip
++);
3973 args
[4] = make_number (*ip
++);
3974 host
= Fformat (5, args
);
3975 service
= make_number (ntohs (saddr
.in
.sin_port
));
3977 args
[0] = build_string (" <%s:%d>");
3980 caller
= Fformat (3, args
);
3987 Lisp_Object args
[9];
3988 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
3990 args
[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
3991 for (i
= 0; i
< 8; i
++)
3992 args
[i
+1] = make_number (ntohs(ip6
[i
]));
3993 host
= Fformat (9, args
);
3994 service
= make_number (ntohs (saddr
.in
.sin_port
));
3996 args
[0] = build_string (" <[%s]:%d>");
3999 caller
= Fformat (3, args
);
4004 #ifdef HAVE_LOCAL_SOCKETS
4008 caller
= Fnumber_to_string (make_number (connect_counter
));
4009 caller
= concat3 (build_string (" <*"), caller
, build_string ("*>"));
4013 /* Create a new buffer name for this process if it doesn't have a
4014 filter. The new buffer name is based on the buffer name or
4015 process name of the server process concatenated with the caller
4018 if (!NILP (ps
->filter
) && !EQ (ps
->filter
, Qt
))
4022 buffer
= ps
->buffer
;
4024 buffer
= Fbuffer_name (buffer
);
4029 buffer
= concat2 (buffer
, caller
);
4030 buffer
= Fget_buffer_create (buffer
);
4034 /* Generate a unique name for the new server process. Combine the
4035 server process name with the caller identification. */
4037 name
= concat2 (ps
->name
, caller
);
4038 proc
= make_process (name
);
4040 chan_process
[s
] = proc
;
4043 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4046 fcntl (s
, F_SETFL
, O_NDELAY
);
4050 p
= XPROCESS (proc
);
4052 /* Build new contact information for this setup. */
4053 contact
= Fcopy_sequence (ps
->childp
);
4054 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4055 contact
= Fplist_put (contact
, QChost
, host
);
4056 if (!NILP (service
))
4057 contact
= Fplist_put (contact
, QCservice
, service
);
4058 contact
= Fplist_put (contact
, QCremote
,
4059 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4060 #ifdef HAVE_GETSOCKNAME
4062 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4063 contact
= Fplist_put (contact
, QClocal
,
4064 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4067 p
->childp
= contact
;
4068 p
->plist
= Fcopy_sequence (ps
->plist
);
4071 p
->sentinel
= ps
->sentinel
;
4072 p
->filter
= ps
->filter
;
4075 XSETINT (p
->infd
, s
);
4076 XSETINT (p
->outfd
, s
);
4079 /* Client processes for accepted connections are not stopped initially. */
4080 if (!EQ (p
->filter
, Qt
))
4082 FD_SET (s
, &input_wait_mask
);
4083 FD_SET (s
, &non_keyboard_wait_mask
);
4086 if (s
> max_process_desc
)
4087 max_process_desc
= s
;
4089 /* Setup coding system for new process based on server process.
4090 This seems to be the proper thing to do, as the coding system
4091 of the new process should reflect the settings at the time the
4092 server socket was opened; not the current settings. */
4094 p
->decode_coding_system
= ps
->decode_coding_system
;
4095 p
->encode_coding_system
= ps
->encode_coding_system
;
4096 setup_process_coding_systems (proc
);
4098 p
->decoding_buf
= make_uninit_string (0);
4099 p
->decoding_carryover
= make_number (0);
4100 p
->encoding_buf
= make_uninit_string (0);
4101 p
->encoding_carryover
= make_number (0);
4103 p
->inherit_coding_system_flag
4104 = (NILP (buffer
) ? Qnil
: ps
->inherit_coding_system_flag
);
4106 if (!NILP (ps
->log
))
4107 call3 (ps
->log
, server
, proc
,
4108 concat3 (build_string ("accept from "),
4109 (STRINGP (host
) ? host
: build_string ("-")),
4110 build_string ("\n")));
4112 if (!NILP (p
->sentinel
))
4113 exec_sentinel (proc
,
4114 concat3 (build_string ("open from "),
4115 (STRINGP (host
) ? host
: build_string ("-")),
4116 build_string ("\n")));
4119 /* This variable is different from waiting_for_input in keyboard.c.
4120 It is used to communicate to a lisp process-filter/sentinel (via the
4121 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4122 for user-input when that process-filter was called.
4123 waiting_for_input cannot be used as that is by definition 0 when
4124 lisp code is being evalled.
4125 This is also used in record_asynch_buffer_change.
4126 For that purpose, this must be 0
4127 when not inside wait_reading_process_output. */
4128 static int waiting_for_user_input_p
;
4130 /* This is here so breakpoints can be put on it. */
4132 wait_reading_process_output_1 ()
4136 /* Read and dispose of subprocess output while waiting for timeout to
4137 elapse and/or keyboard input to be available.
4140 timeout in seconds, or
4141 zero for no limit, or
4142 -1 means gobble data immediately available but don't wait for any.
4145 an additional duration to wait, measured in microseconds.
4146 If this is nonzero and time_limit is 0, then the timeout
4147 consists of MICROSECS only.
4149 READ_KBD is a lisp value:
4150 0 to ignore keyboard input, or
4151 1 to return when input is available, or
4152 -1 meaning caller will actually read the input, so don't throw to
4153 the quit handler, or
4155 DO_DISPLAY != 0 means redisplay should be done to show subprocess
4156 output that arrives.
4158 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4159 (and gobble terminal input into the buffer if any arrives).
4161 If WAIT_PROC is specified, wait until something arrives from that
4162 process. The return value is true iff we read some input from
4165 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4166 (suspending output from other processes). A negative value
4167 means don't run any timers either.
4169 If WAIT_PROC is specified, then the function returns true iff we
4170 received input from that process before the timeout elapsed.
4171 Otherwise, return true iff we received input from any process. */
4174 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
4175 wait_for_cell
, wait_proc
, just_wait_proc
)
4176 int time_limit
, microsecs
, read_kbd
, do_display
;
4177 Lisp_Object wait_for_cell
;
4178 struct Lisp_Process
*wait_proc
;
4181 register int channel
, nfds
;
4182 SELECT_TYPE Available
;
4183 #ifdef NON_BLOCKING_CONNECT
4184 SELECT_TYPE Connecting
;
4187 int check_delay
, no_avail
;
4190 EMACS_TIME timeout
, end_time
;
4191 int wait_channel
= -1;
4192 int got_some_input
= 0;
4193 /* Either nil or a cons cell, the car of which is of interest and
4194 may be changed outside of this routine. */
4195 int saved_waiting_for_user_input_p
= waiting_for_user_input_p
;
4197 FD_ZERO (&Available
);
4198 #ifdef NON_BLOCKING_CONNECT
4199 FD_ZERO (&Connecting
);
4202 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4203 if (wait_proc
!= NULL
)
4204 wait_channel
= XINT (wait_proc
->infd
);
4206 waiting_for_user_input_p
= read_kbd
;
4208 /* Since we may need to wait several times,
4209 compute the absolute time to return at. */
4210 if (time_limit
|| microsecs
)
4212 EMACS_GET_TIME (end_time
);
4213 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
4214 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
4216 #ifdef POLL_INTERRUPTED_SYS_CALL
4217 /* AlainF 5-Jul-1996
4218 HP-UX 10.10 seem to have problems with signals coming in
4219 Causes "poll: interrupted system call" messages when Emacs is run
4221 Turn off periodic alarms (in case they are in use),
4222 and then turn off any other atimers. */
4224 turn_on_atimers (0);
4225 #endif /* POLL_INTERRUPTED_SYS_CALL */
4229 int timeout_reduced_for_timers
= 0;
4231 /* If calling from keyboard input, do not quit
4232 since we want to return C-g as an input character.
4233 Otherwise, do pending quit if requested. */
4237 else if (interrupt_input_pending
)
4238 handle_async_input ();
4241 /* Exit now if the cell we're waiting for became non-nil. */
4242 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4245 /* Compute time from now till when time limit is up */
4246 /* Exit if already run out */
4247 if (time_limit
== -1)
4249 /* -1 specified for timeout means
4250 gobble output available now
4251 but don't wait at all. */
4253 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4255 else if (time_limit
|| microsecs
)
4257 EMACS_GET_TIME (timeout
);
4258 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
4259 if (EMACS_TIME_NEG_P (timeout
))
4264 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
4267 /* Normally we run timers here.
4268 But not if wait_for_cell; in those cases,
4269 the wait is supposed to be short,
4270 and those callers cannot handle running arbitrary Lisp code here. */
4271 if (NILP (wait_for_cell
)
4272 && just_wait_proc
>= 0)
4274 EMACS_TIME timer_delay
;
4278 int old_timers_run
= timers_run
;
4279 struct buffer
*old_buffer
= current_buffer
;
4281 timer_delay
= timer_check (1);
4283 /* If a timer has run, this might have changed buffers
4284 an alike. Make read_key_sequence aware of that. */
4285 if (timers_run
!= old_timers_run
4286 && old_buffer
!= current_buffer
4287 && waiting_for_user_input_p
== -1)
4288 record_asynch_buffer_change ();
4290 if (timers_run
!= old_timers_run
&& do_display
)
4291 /* We must retry, since a timer may have requeued itself
4292 and that could alter the time_delay. */
4293 redisplay_preserve_echo_area (9);
4297 while (!detect_input_pending ());
4299 /* If there is unread keyboard input, also return. */
4301 && requeued_events_pending_p ())
4304 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
4306 EMACS_TIME difference
;
4307 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
4308 if (EMACS_TIME_NEG_P (difference
))
4310 timeout
= timer_delay
;
4311 timeout_reduced_for_timers
= 1;
4314 /* If time_limit is -1, we are not going to wait at all. */
4315 else if (time_limit
!= -1)
4317 /* This is so a breakpoint can be put here. */
4318 wait_reading_process_output_1 ();
4322 /* Cause C-g and alarm signals to take immediate action,
4323 and cause input available signals to zero out timeout.
4325 It is important that we do this before checking for process
4326 activity. If we get a SIGCHLD after the explicit checks for
4327 process activity, timeout is the only way we will know. */
4329 set_waiting_for_input (&timeout
);
4331 /* If status of something has changed, and no input is
4332 available, notify the user of the change right away. After
4333 this explicit check, we'll let the SIGCHLD handler zap
4334 timeout to get our attention. */
4335 if (update_tick
!= process_tick
&& do_display
)
4338 #ifdef NON_BLOCKING_CONNECT
4342 Atemp
= input_wait_mask
;
4344 /* On Mac OS X 10.0, the SELECT system call always says input is
4345 present (for reading) at stdin, even when none is. This
4346 causes the call to SELECT below to return 1 and
4347 status_notify not to be called. As a result output of
4348 subprocesses are incorrectly discarded.
4352 IF_NON_BLOCKING_CONNECT (Ctemp
= connect_wait_mask
);
4354 EMACS_SET_SECS_USECS (timeout
, 0, 0);
4355 if ((select (max (max_process_desc
, max_keyboard_desc
) + 1,
4357 #ifdef NON_BLOCKING_CONNECT
4358 (num_pending_connects
> 0 ? &Ctemp
: (SELECT_TYPE
*)0),
4362 (SELECT_TYPE
*)0, &timeout
)
4365 /* It's okay for us to do this and then continue with
4366 the loop, since timeout has already been zeroed out. */
4367 clear_waiting_for_input ();
4368 status_notify (NULL
);
4372 /* Don't wait for output from a non-running process. Just
4373 read whatever data has already been received. */
4374 if (wait_proc
&& wait_proc
->raw_status_new
)
4375 update_status (wait_proc
);
4377 && ! EQ (wait_proc
->status
, Qrun
)
4378 && ! EQ (wait_proc
->status
, Qconnect
))
4380 int nread
, total_nread
= 0;
4382 clear_waiting_for_input ();
4383 XSETPROCESS (proc
, wait_proc
);
4385 /* Read data from the process, until we exhaust it. */
4386 while (XINT (wait_proc
->infd
) >= 0)
4388 nread
= read_process_output (proc
, XINT (wait_proc
->infd
));
4394 total_nread
+= nread
;
4396 else if (nread
== -1 && EIO
== errno
)
4400 else if (nread
== -1 && EAGAIN
== errno
)
4404 else if (nread
== -1 && EWOULDBLOCK
== errno
)
4408 if (total_nread
> 0 && do_display
)
4409 redisplay_preserve_echo_area (10);
4414 /* Wait till there is something to do */
4416 if (wait_proc
&& just_wait_proc
)
4418 if (XINT (wait_proc
->infd
) < 0) /* Terminated */
4420 FD_SET (XINT (wait_proc
->infd
), &Available
);
4422 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4424 else if (!NILP (wait_for_cell
))
4426 Available
= non_process_wait_mask
;
4428 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4433 Available
= non_keyboard_wait_mask
;
4435 Available
= input_wait_mask
;
4436 IF_NON_BLOCKING_CONNECT (check_connect
= (num_pending_connects
> 0));
4437 check_delay
= wait_channel
>= 0 ? 0 : process_output_delay_count
;
4440 /* If frame size has changed or the window is newly mapped,
4441 redisplay now, before we start to wait. There is a race
4442 condition here; if a SIGIO arrives between now and the select
4443 and indicates that a frame is trashed, the select may block
4444 displaying a trashed screen. */
4445 if (frame_garbaged
&& do_display
)
4447 clear_waiting_for_input ();
4448 redisplay_preserve_echo_area (11);
4450 set_waiting_for_input (&timeout
);
4454 if (read_kbd
&& detect_input_pending ())
4461 #ifdef NON_BLOCKING_CONNECT
4463 Connecting
= connect_wait_mask
;
4466 #ifdef ADAPTIVE_READ_BUFFERING
4467 /* Set the timeout for adaptive read buffering if any
4468 process has non-nil read_output_skip and non-zero
4469 read_output_delay, and we are not reading output for a
4470 specific wait_channel. It is not executed if
4471 Vprocess_adaptive_read_buffering is nil. */
4472 if (process_output_skip
&& check_delay
> 0)
4474 int usecs
= EMACS_USECS (timeout
);
4475 if (EMACS_SECS (timeout
) > 0 || usecs
> READ_OUTPUT_DELAY_MAX
)
4476 usecs
= READ_OUTPUT_DELAY_MAX
;
4477 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
4479 proc
= chan_process
[channel
];
4482 /* Find minimum non-zero read_output_delay among the
4483 processes with non-nil read_output_skip. */
4484 if (XINT (XPROCESS (proc
)->read_output_delay
) > 0)
4487 if (NILP (XPROCESS (proc
)->read_output_skip
))
4489 FD_CLR (channel
, &Available
);
4490 XPROCESS (proc
)->read_output_skip
= Qnil
;
4491 if (XINT (XPROCESS (proc
)->read_output_delay
) < usecs
)
4492 usecs
= XINT (XPROCESS (proc
)->read_output_delay
);
4495 EMACS_SET_SECS_USECS (timeout
, 0, usecs
);
4496 process_output_skip
= 0;
4500 nfds
= select (max (max_process_desc
, max_keyboard_desc
) + 1,
4502 #ifdef NON_BLOCKING_CONNECT
4503 (check_connect
? &Connecting
: (SELECT_TYPE
*)0),
4507 (SELECT_TYPE
*)0, &timeout
);
4512 /* Make C-g and alarm signals set flags again */
4513 clear_waiting_for_input ();
4515 /* If we woke up due to SIGWINCH, actually change size now. */
4516 do_pending_window_change (0);
4518 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
4519 /* We wanted the full specified time, so return now. */
4523 if (xerrno
== EINTR
)
4526 /* Ultrix select seems to return ENOMEM when it is
4527 interrupted. Treat it just like EINTR. Bleah. Note
4528 that we want to test for the "ultrix" CPP symbol, not
4529 "__ultrix__"; the latter is only defined under GCC, but
4530 not by DEC's bundled CC. -JimB */
4531 else if (xerrno
== ENOMEM
)
4535 /* This happens for no known reason on ALLIANT.
4536 I am guessing that this is the right response. -- RMS. */
4537 else if (xerrno
== EFAULT
)
4540 else if (xerrno
== EBADF
)
4543 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4544 the child's closure of the pts gives the parent a SIGHUP, and
4545 the ptc file descriptor is automatically closed,
4546 yielding EBADF here or at select() call above.
4547 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
4548 in m/ibmrt-aix.h), and here we just ignore the select error.
4549 Cleanup occurs c/o status_notify after SIGCLD. */
4550 no_avail
= 1; /* Cannot depend on values returned */
4556 error ("select error: %s", emacs_strerror (xerrno
));
4561 FD_ZERO (&Available
);
4562 IF_NON_BLOCKING_CONNECT (check_connect
= 0);
4565 #if defined(sun) && !defined(USG5_4)
4566 if (nfds
> 0 && keyboard_bit_set (&Available
)
4568 /* System sometimes fails to deliver SIGIO.
4570 David J. Mackenzie says that Emacs doesn't compile under
4571 Solaris if this code is enabled, thus the USG5_4 in the CPP
4572 conditional. "I haven't noticed any ill effects so far.
4573 If you find a Solaris expert somewhere, they might know
4575 kill (getpid (), SIGIO
);
4578 #if 0 /* When polling is used, interrupt_input is 0,
4579 so get_input_pending should read the input.
4580 So this should not be needed. */
4581 /* If we are using polling for input,
4582 and we see input available, make it get read now.
4583 Otherwise it might not actually get read for a second.
4584 And on hpux, since we turn off polling in wait_reading_process_output,
4585 it might never get read at all if we don't spend much time
4586 outside of wait_reading_process_output. */
4587 if (read_kbd
&& interrupt_input
4588 && keyboard_bit_set (&Available
)
4589 && input_polling_used ())
4590 kill (getpid (), SIGALRM
);
4593 /* Check for keyboard input */
4594 /* If there is any, return immediately
4595 to give it higher priority than subprocesses */
4599 int old_timers_run
= timers_run
;
4600 struct buffer
*old_buffer
= current_buffer
;
4603 if (detect_input_pending_run_timers (do_display
))
4605 swallow_events (do_display
);
4606 if (detect_input_pending_run_timers (do_display
))
4610 /* If a timer has run, this might have changed buffers
4611 an alike. Make read_key_sequence aware of that. */
4612 if (timers_run
!= old_timers_run
4613 && waiting_for_user_input_p
== -1
4614 && old_buffer
!= current_buffer
)
4615 record_asynch_buffer_change ();
4621 /* If there is unread keyboard input, also return. */
4623 && requeued_events_pending_p ())
4626 /* If we are not checking for keyboard input now,
4627 do process events (but don't run any timers).
4628 This is so that X events will be processed.
4629 Otherwise they may have to wait until polling takes place.
4630 That would causes delays in pasting selections, for example.
4632 (We used to do this only if wait_for_cell.) */
4633 if (read_kbd
== 0 && detect_input_pending ())
4635 swallow_events (do_display
);
4636 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
4637 if (detect_input_pending ())
4642 /* Exit now if the cell we're waiting for became non-nil. */
4643 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4647 /* If we think we have keyboard input waiting, but didn't get SIGIO,
4648 go read it. This can happen with X on BSD after logging out.
4649 In that case, there really is no input and no SIGIO,
4650 but select says there is input. */
4652 if (read_kbd
&& interrupt_input
4653 && keyboard_bit_set (&Available
) && ! noninteractive
)
4654 kill (getpid (), SIGIO
);
4658 got_some_input
|= nfds
> 0;
4660 /* If checking input just got us a size-change event from X,
4661 obey it now if we should. */
4662 if (read_kbd
|| ! NILP (wait_for_cell
))
4663 do_pending_window_change (0);
4665 /* Check for data from a process. */
4666 if (no_avail
|| nfds
== 0)
4669 /* Really FIRST_PROC_DESC should be 0 on Unix,
4670 but this is safer in the short run. */
4671 for (channel
= 0; channel
<= max_process_desc
; channel
++)
4673 if (FD_ISSET (channel
, &Available
)
4674 && FD_ISSET (channel
, &non_keyboard_wait_mask
))
4678 /* If waiting for this channel, arrange to return as
4679 soon as no more input to be processed. No more
4681 if (wait_channel
== channel
)
4687 proc
= chan_process
[channel
];
4691 /* If this is a server stream socket, accept connection. */
4692 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
4694 server_accept_connection (proc
, channel
);
4698 /* Read data from the process, starting with our
4699 buffered-ahead character if we have one. */
4701 nread
= read_process_output (proc
, channel
);
4704 /* Since read_process_output can run a filter,
4705 which can call accept-process-output,
4706 don't try to read from any other processes
4707 before doing the select again. */
4708 FD_ZERO (&Available
);
4711 redisplay_preserve_echo_area (12);
4714 else if (nread
== -1 && errno
== EWOULDBLOCK
)
4717 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4718 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
4720 else if (nread
== -1 && errno
== EAGAIN
)
4724 else if (nread
== -1 && errno
== EAGAIN
)
4726 /* Note that we cannot distinguish between no input
4727 available now and a closed pipe.
4728 With luck, a closed pipe will be accompanied by
4729 subprocess termination and SIGCHLD. */
4730 else if (nread
== 0 && !NETCONN_P (proc
))
4732 #endif /* O_NDELAY */
4733 #endif /* O_NONBLOCK */
4735 /* On some OSs with ptys, when the process on one end of
4736 a pty exits, the other end gets an error reading with
4737 errno = EIO instead of getting an EOF (0 bytes read).
4738 Therefore, if we get an error reading and errno =
4739 EIO, just continue, because the child process has
4740 exited and should clean itself up soon (e.g. when we
4743 However, it has been known to happen that the SIGCHLD
4744 got lost. So raise the signl again just in case.
4746 else if (nread
== -1 && errno
== EIO
)
4747 kill (getpid (), SIGCHLD
);
4748 #endif /* HAVE_PTYS */
4749 /* If we can detect process termination, don't consider the process
4750 gone just because its pipe is closed. */
4752 else if (nread
== 0 && !NETCONN_P (proc
))
4757 /* Preserve status of processes already terminated. */
4758 XSETINT (XPROCESS (proc
)->tick
, ++process_tick
);
4759 deactivate_process (proc
);
4760 if (XPROCESS (proc
)->raw_status_new
)
4761 update_status (XPROCESS (proc
));
4762 if (EQ (XPROCESS (proc
)->status
, Qrun
))
4763 XPROCESS (proc
)->status
4764 = Fcons (Qexit
, Fcons (make_number (256), Qnil
));
4767 #ifdef NON_BLOCKING_CONNECT
4768 if (check_connect
&& FD_ISSET (channel
, &Connecting
)
4769 && FD_ISSET (channel
, &connect_wait_mask
))
4771 struct Lisp_Process
*p
;
4773 FD_CLR (channel
, &connect_wait_mask
);
4774 if (--num_pending_connects
< 0)
4777 proc
= chan_process
[channel
];
4781 p
= XPROCESS (proc
);
4784 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
4785 So only use it on systems where it is known to work. */
4787 int xlen
= sizeof(xerrno
);
4788 if (getsockopt(channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
4793 struct sockaddr pname
;
4794 int pnamelen
= sizeof(pname
);
4796 /* If connection failed, getpeername will fail. */
4798 if (getpeername(channel
, &pname
, &pnamelen
) < 0)
4800 /* Obtain connect failure code through error slippage. */
4803 if (errno
== ENOTCONN
&& read(channel
, &dummy
, 1) < 0)
4810 XSETINT (p
->tick
, ++process_tick
);
4811 p
->status
= Fcons (Qfailed
, Fcons (make_number (xerrno
), Qnil
));
4812 deactivate_process (proc
);
4817 /* Execute the sentinel here. If we had relied on
4818 status_notify to do it later, it will read input
4819 from the process before calling the sentinel. */
4820 exec_sentinel (proc
, build_string ("open\n"));
4821 if (!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
4823 FD_SET (XINT (p
->infd
), &input_wait_mask
);
4824 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
4828 #endif /* NON_BLOCKING_CONNECT */
4829 } /* end for each file descriptor */
4830 } /* end while exit conditions not met */
4832 waiting_for_user_input_p
= saved_waiting_for_user_input_p
;
4834 /* If calling from keyboard input, do not quit
4835 since we want to return C-g as an input character.
4836 Otherwise, do pending quit if requested. */
4839 /* Prevent input_pending from remaining set if we quit. */
4840 clear_input_pending ();
4843 #ifdef POLL_INTERRUPTED_SYS_CALL
4844 /* AlainF 5-Jul-1996
4845 HP-UX 10.10 seems to have problems with signals coming in
4846 Causes "poll: interrupted system call" messages when Emacs is run
4848 Turn periodic alarms back on */
4850 #endif /* POLL_INTERRUPTED_SYS_CALL */
4852 return got_some_input
;
4855 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4858 read_process_output_call (fun_and_args
)
4859 Lisp_Object fun_and_args
;
4861 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
4865 read_process_output_error_handler (error
)
4868 cmd_error_internal (error
, "error in process filter: ");
4870 update_echo_area ();
4871 Fsleep_for (make_number (2), Qnil
);
4875 /* Read pending output from the process channel,
4876 starting with our buffered-ahead character if we have one.
4877 Yield number of decoded characters read.
4879 This function reads at most 4096 characters.
4880 If you want to read all available subprocess output,
4881 you must call it repeatedly until it returns zero.
4883 The characters read are decoded according to PROC's coding-system
4887 read_process_output (proc
, channel
)
4889 register int channel
;
4891 register int nbytes
;
4893 register Lisp_Object outstream
;
4894 register struct buffer
*old
= current_buffer
;
4895 register struct Lisp_Process
*p
= XPROCESS (proc
);
4896 register int opoint
;
4897 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
4898 int carryover
= XINT (p
->decoding_carryover
);
4902 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
4904 vs
= get_vms_process_pointer (p
->pid
);
4908 return (0); /* Really weird if it does this */
4909 if (!(vs
->iosb
[0] & 1))
4910 return -1; /* I/O error */
4913 error ("Could not get VMS process pointer");
4914 chars
= vs
->inputBuffer
;
4915 nbytes
= clean_vms_buffer (chars
, vs
->iosb
[1]);
4918 start_vms_process_read (vs
); /* Crank up the next read on the process */
4919 return 1; /* Nothing worth printing, say we got 1 */
4923 /* The data carried over in the previous decoding (which are at
4924 the tail of decoding buffer) should be prepended to the new
4925 data read to decode all together. */
4926 chars
= (char *) alloca (nbytes
+ carryover
);
4927 bcopy (SDATA (p
->decoding_buf
), buf
, carryover
);
4928 bcopy (vs
->inputBuffer
, chars
+ carryover
, nbytes
);
4932 chars
= (char *) alloca (carryover
+ readmax
);
4934 /* See the comment above. */
4935 bcopy (SDATA (p
->decoding_buf
), chars
, carryover
);
4937 #ifdef DATAGRAM_SOCKETS
4938 /* We have a working select, so proc_buffered_char is always -1. */
4939 if (DATAGRAM_CHAN_P (channel
))
4941 int len
= datagram_address
[channel
].len
;
4942 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
4943 0, datagram_address
[channel
].sa
, &len
);
4947 if (proc_buffered_char
[channel
] < 0)
4949 nbytes
= emacs_read (channel
, chars
+ carryover
, readmax
);
4950 #ifdef ADAPTIVE_READ_BUFFERING
4951 if (nbytes
> 0 && !NILP (p
->adaptive_read_buffering
))
4953 int delay
= XINT (p
->read_output_delay
);
4956 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
4959 process_output_delay_count
++;
4960 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
4963 else if (delay
> 0 && (nbytes
== readmax
))
4965 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
4967 process_output_delay_count
--;
4969 XSETINT (p
->read_output_delay
, delay
);
4972 p
->read_output_skip
= Qt
;
4973 process_output_skip
= 1;
4980 chars
[carryover
] = proc_buffered_char
[channel
];
4981 proc_buffered_char
[channel
] = -1;
4982 nbytes
= emacs_read (channel
, chars
+ carryover
+ 1, readmax
- 1);
4986 nbytes
= nbytes
+ 1;
4988 #endif /* not VMS */
4990 XSETINT (p
->decoding_carryover
, 0);
4992 /* At this point, NBYTES holds number of bytes just received
4993 (including the one in proc_buffered_char[channel]). */
4996 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
4998 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5001 /* Now set NBYTES how many bytes we must decode. */
5002 nbytes
+= carryover
;
5004 /* Read and dispose of the process output. */
5005 outstream
= p
->filter
;
5006 if (!NILP (outstream
))
5008 /* We inhibit quit here instead of just catching it so that
5009 hitting ^G when a filter happens to be running won't screw
5011 int count
= SPECPDL_INDEX ();
5012 Lisp_Object odeactivate
;
5013 Lisp_Object obuffer
, okeymap
;
5015 int outer_running_asynch_code
= running_asynch_code
;
5016 int waiting
= waiting_for_user_input_p
;
5018 /* No need to gcpro these, because all we do with them later
5019 is test them for EQness, and none of them should be a string. */
5020 odeactivate
= Vdeactivate_mark
;
5021 XSETBUFFER (obuffer
, current_buffer
);
5022 okeymap
= current_buffer
->keymap
;
5024 specbind (Qinhibit_quit
, Qt
);
5025 specbind (Qlast_nonmenu_event
, Qt
);
5027 /* In case we get recursively called,
5028 and we already saved the match data nonrecursively,
5029 save the same match data in safely recursive fashion. */
5030 if (outer_running_asynch_code
)
5033 /* Don't clobber the CURRENT match data, either! */
5034 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5035 restore_search_regs ();
5036 record_unwind_save_match_data ();
5037 Fset_match_data (tem
, Qt
);
5040 /* For speed, if a search happens within this code,
5041 save the match data in a special nonrecursive fashion. */
5042 running_asynch_code
= 1;
5044 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5046 Vlast_coding_system_used
= coding
->symbol
;
5047 /* A new coding system might be found. */
5048 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5050 p
->decode_coding_system
= coding
->symbol
;
5052 /* Don't call setup_coding_system for
5053 proc_decode_coding_system[channel] here. It is done in
5054 detect_coding called via decode_coding above. */
5056 /* If a coding system for encoding is not yet decided, we set
5057 it as the same as coding-system for decoding.
5059 But, before doing that we must check if
5060 proc_encode_coding_system[p->outfd] surely points to a
5061 valid memory because p->outfd will be changed once EOF is
5062 sent to the process. */
5063 if (NILP (p
->encode_coding_system
)
5064 && proc_encode_coding_system
[XINT (p
->outfd
)])
5066 p
->encode_coding_system
= coding
->symbol
;
5067 setup_coding_system (coding
->symbol
,
5068 proc_encode_coding_system
[XINT (p
->outfd
)]);
5072 carryover
= nbytes
- coding
->consumed
;
5073 if (SCHARS (p
->decoding_buf
) < carryover
)
5074 p
->decoding_buf
= make_uninit_string (carryover
);
5075 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5077 XSETINT (p
->decoding_carryover
, carryover
);
5078 /* Adjust the multibyteness of TEXT to that of the filter. */
5079 if (NILP (p
->filter_multibyte
) != ! STRING_MULTIBYTE (text
))
5080 text
= (STRING_MULTIBYTE (text
)
5081 ? Fstring_as_unibyte (text
)
5082 : Fstring_to_multibyte (text
));
5083 if (SBYTES (text
) > 0)
5084 internal_condition_case_1 (read_process_output_call
,
5086 Fcons (proc
, Fcons (text
, Qnil
))),
5087 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5088 read_process_output_error_handler
);
5090 /* If we saved the match data nonrecursively, restore it now. */
5091 restore_search_regs ();
5092 running_asynch_code
= outer_running_asynch_code
;
5094 /* Handling the process output should not deactivate the mark. */
5095 Vdeactivate_mark
= odeactivate
;
5097 /* Restore waiting_for_user_input_p as it was
5098 when we were called, in case the filter clobbered it. */
5099 waiting_for_user_input_p
= waiting
;
5101 #if 0 /* Call record_asynch_buffer_change unconditionally,
5102 because we might have changed minor modes or other things
5103 that affect key bindings. */
5104 if (! EQ (Fcurrent_buffer (), obuffer
)
5105 || ! EQ (current_buffer
->keymap
, okeymap
))
5107 /* But do it only if the caller is actually going to read events.
5108 Otherwise there's no need to make him wake up, and it could
5109 cause trouble (for example it would make Fsit_for return). */
5110 if (waiting_for_user_input_p
== -1)
5111 record_asynch_buffer_change ();
5114 start_vms_process_read (vs
);
5116 unbind_to (count
, Qnil
);
5120 /* If no filter, write into buffer if it isn't dead. */
5121 if (!NILP (p
->buffer
) && !NILP (XBUFFER (p
->buffer
)->name
))
5123 Lisp_Object old_read_only
;
5124 int old_begv
, old_zv
;
5125 int old_begv_byte
, old_zv_byte
;
5126 Lisp_Object odeactivate
;
5127 int before
, before_byte
;
5132 odeactivate
= Vdeactivate_mark
;
5134 Fset_buffer (p
->buffer
);
5136 opoint_byte
= PT_BYTE
;
5137 old_read_only
= current_buffer
->read_only
;
5140 old_begv_byte
= BEGV_BYTE
;
5141 old_zv_byte
= ZV_BYTE
;
5143 current_buffer
->read_only
= Qnil
;
5145 /* Insert new output into buffer
5146 at the current end-of-output marker,
5147 thus preserving logical ordering of input and output. */
5148 if (XMARKER (p
->mark
)->buffer
)
5149 SET_PT_BOTH (clip_to_bounds (BEGV
, marker_position (p
->mark
), ZV
),
5150 clip_to_bounds (BEGV_BYTE
, marker_byte_position (p
->mark
),
5153 SET_PT_BOTH (ZV
, ZV_BYTE
);
5155 before_byte
= PT_BYTE
;
5157 /* If the output marker is outside of the visible region, save
5158 the restriction and widen. */
5159 if (! (BEGV
<= PT
&& PT
<= ZV
))
5162 text
= decode_coding_string (make_unibyte_string (chars
, nbytes
),
5164 Vlast_coding_system_used
= coding
->symbol
;
5165 /* A new coding system might be found. See the comment in the
5166 similar code in the previous `if' block. */
5167 if (!EQ (p
->decode_coding_system
, coding
->symbol
))
5169 p
->decode_coding_system
= coding
->symbol
;
5170 if (NILP (p
->encode_coding_system
)
5171 && proc_encode_coding_system
[XINT (p
->outfd
)])
5173 p
->encode_coding_system
= coding
->symbol
;
5174 setup_coding_system (coding
->symbol
,
5175 proc_encode_coding_system
[XINT (p
->outfd
)]);
5178 carryover
= nbytes
- coding
->consumed
;
5179 if (SCHARS (p
->decoding_buf
) < carryover
)
5180 p
->decoding_buf
= make_uninit_string (carryover
);
5181 bcopy (chars
+ coding
->consumed
, SDATA (p
->decoding_buf
),
5183 XSETINT (p
->decoding_carryover
, carryover
);
5184 /* Adjust the multibyteness of TEXT to that of the buffer. */
5185 if (NILP (current_buffer
->enable_multibyte_characters
)
5186 != ! STRING_MULTIBYTE (text
))
5187 text
= (STRING_MULTIBYTE (text
)
5188 ? Fstring_as_unibyte (text
)
5189 : Fstring_to_multibyte (text
));
5190 /* Insert before markers in case we are inserting where
5191 the buffer's mark is, and the user's next command is Meta-y. */
5192 insert_from_string_before_markers (text
, 0, 0,
5193 SCHARS (text
), SBYTES (text
), 0);
5195 /* Make sure the process marker's position is valid when the
5196 process buffer is changed in the signal_after_change above.
5197 W3 is known to do that. */
5198 if (BUFFERP (p
->buffer
)
5199 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5200 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5202 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5204 update_mode_lines
++;
5206 /* Make sure opoint and the old restrictions
5207 float ahead of any new text just as point would. */
5208 if (opoint
>= before
)
5210 opoint
+= PT
- before
;
5211 opoint_byte
+= PT_BYTE
- before_byte
;
5213 if (old_begv
> before
)
5215 old_begv
+= PT
- before
;
5216 old_begv_byte
+= PT_BYTE
- before_byte
;
5218 if (old_zv
>= before
)
5220 old_zv
+= PT
- before
;
5221 old_zv_byte
+= PT_BYTE
- before_byte
;
5224 /* If the restriction isn't what it should be, set it. */
5225 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5226 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5228 /* Handling the process output should not deactivate the mark. */
5229 Vdeactivate_mark
= odeactivate
;
5231 current_buffer
->read_only
= old_read_only
;
5232 SET_PT_BOTH (opoint
, opoint_byte
);
5233 set_buffer_internal (old
);
5236 start_vms_process_read (vs
);
5241 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
, Swaiting_for_user_input_p
,
5243 doc
: /* Returns non-nil if Emacs is waiting for input from the user.
5244 This is intended for use by asynchronous process output filters and sentinels. */)
5247 return (waiting_for_user_input_p
? Qt
: Qnil
);
5250 /* Sending data to subprocess */
5252 jmp_buf send_process_frame
;
5253 Lisp_Object process_sent_to
;
5256 send_process_trap ()
5258 SIGNAL_THREAD_CHECK (SIGPIPE
);
5263 sigunblock (sigmask (SIGPIPE
));
5264 longjmp (send_process_frame
, 1);
5267 /* Send some data to process PROC.
5268 BUF is the beginning of the data; LEN is the number of characters.
5269 OBJECT is the Lisp object that the data comes from. If OBJECT is
5270 nil or t, it means that the data comes from C string.
5272 If OBJECT is not nil, the data is encoded by PROC's coding-system
5273 for encoding before it is sent.
5275 This function can evaluate Lisp code and can garbage collect. */
5278 send_process (proc
, buf
, len
, object
)
5279 volatile Lisp_Object proc
;
5280 unsigned char *volatile buf
;
5282 volatile Lisp_Object object
;
5284 /* Use volatile to protect variables from being clobbered by longjmp. */
5285 struct Lisp_Process
*p
= XPROCESS (proc
);
5287 struct coding_system
*coding
;
5288 struct gcpro gcpro1
;
5289 SIGTYPE (*volatile old_sigpipe
) ();
5294 VMS_PROC_STUFF
*vs
, *get_vms_process_pointer();
5297 if (p
->raw_status_new
)
5299 if (! EQ (p
->status
, Qrun
))
5300 error ("Process %s not running", SDATA (p
->name
));
5301 if (XINT (p
->outfd
) < 0)
5302 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
5304 coding
= proc_encode_coding_system
[XINT (p
->outfd
)];
5305 Vlast_coding_system_used
= coding
->symbol
;
5307 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
5308 || (BUFFERP (object
)
5309 && !NILP (XBUFFER (object
)->enable_multibyte_characters
))
5312 if (!EQ (coding
->symbol
, p
->encode_coding_system
))
5313 /* The coding system for encoding was changed to raw-text
5314 because we sent a unibyte text previously. Now we are
5315 sending a multibyte text, thus we must encode it by the
5316 original coding system specified for the current process. */
5317 setup_coding_system (p
->encode_coding_system
, coding
);
5318 /* src_multibyte should be set to 1 _after_ a call to
5319 setup_coding_system, since it resets src_multibyte to
5321 coding
->src_multibyte
= 1;
5325 /* For sending a unibyte text, character code conversion should
5326 not take place but EOL conversion should. So, setup raw-text
5327 or one of the subsidiary if we have not yet done it. */
5328 if (coding
->type
!= coding_type_raw_text
)
5330 if (CODING_REQUIRE_FLUSHING (coding
))
5332 /* But, before changing the coding, we must flush out data. */
5333 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5334 send_process (proc
, "", 0, Qt
);
5336 coding
->src_multibyte
= 0;
5337 setup_raw_text_coding_system (coding
);
5340 coding
->dst_multibyte
= 0;
5342 if (CODING_REQUIRE_ENCODING (coding
))
5344 int require
= encoding_buffer_size (coding
, len
);
5345 int from_byte
= -1, from
= -1, to
= -1;
5347 if (BUFFERP (object
))
5349 from_byte
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5350 from
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
);
5351 to
= buf_bytepos_to_charpos (XBUFFER (object
), from_byte
+ len
);
5353 else if (STRINGP (object
))
5355 from_byte
= buf
- SDATA (object
);
5356 from
= string_byte_to_char (object
, from_byte
);
5357 to
= string_byte_to_char (object
, from_byte
+ len
);
5360 if (coding
->composing
!= COMPOSITION_DISABLED
)
5363 coding_save_composition (coding
, from
, to
, object
);
5365 coding
->composing
= COMPOSITION_DISABLED
;
5368 if (SBYTES (p
->encoding_buf
) < require
)
5369 p
->encoding_buf
= make_uninit_string (require
);
5372 buf
= (BUFFERP (object
)
5373 ? BUF_BYTE_ADDRESS (XBUFFER (object
), from_byte
)
5374 : SDATA (object
) + from_byte
);
5376 object
= p
->encoding_buf
;
5377 encode_coding (coding
, (char *) buf
, SDATA (object
),
5378 len
, SBYTES (object
));
5379 coding_free_composition_data (coding
);
5380 len
= coding
->produced
;
5381 buf
= SDATA (object
);
5385 vs
= get_vms_process_pointer (p
->pid
);
5387 error ("Could not find this process: %x", p
->pid
);
5388 else if (write_to_vms_process (vs
, buf
, len
))
5392 if (pty_max_bytes
== 0)
5394 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
5395 pty_max_bytes
= fpathconf (XFASTINT (p
->outfd
), _PC_MAX_CANON
);
5396 if (pty_max_bytes
< 0)
5397 pty_max_bytes
= 250;
5399 pty_max_bytes
= 250;
5401 /* Deduct one, to leave space for the eof. */
5405 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5406 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5407 when returning with longjmp despite being declared volatile. */
5408 if (!setjmp (send_process_frame
))
5410 process_sent_to
= proc
;
5415 /* Decide how much data we can send in one batch.
5416 Long lines need to be split into multiple batches. */
5417 if (!NILP (p
->pty_flag
))
5419 /* Starting this at zero is always correct when not the first
5420 iteration because the previous iteration ended by sending C-d.
5421 It may not be correct for the first iteration
5422 if a partial line was sent in a separate send_process call.
5423 If that proves worth handling, we need to save linepos
5424 in the process object. */
5426 unsigned char *ptr
= (unsigned char *) buf
;
5427 unsigned char *end
= (unsigned char *) buf
+ len
;
5429 /* Scan through this text for a line that is too long. */
5430 while (ptr
!= end
&& linepos
< pty_max_bytes
)
5438 /* If we found one, break the line there
5439 and put in a C-d to force the buffer through. */
5443 /* Send this batch, using one or more write calls. */
5446 int outfd
= XINT (p
->outfd
);
5447 old_sigpipe
= (SIGTYPE (*) ()) signal (SIGPIPE
, send_process_trap
);
5448 #ifdef DATAGRAM_SOCKETS
5449 if (DATAGRAM_CHAN_P (outfd
))
5451 rv
= sendto (outfd
, (char *) buf
, this,
5452 0, datagram_address
[outfd
].sa
,
5453 datagram_address
[outfd
].len
);
5454 if (rv
< 0 && errno
== EMSGSIZE
)
5456 signal (SIGPIPE
, old_sigpipe
);
5457 report_file_error ("sending datagram",
5458 Fcons (proc
, Qnil
));
5464 rv
= emacs_write (outfd
, (char *) buf
, this);
5465 #ifdef ADAPTIVE_READ_BUFFERING
5466 if (XINT (p
->read_output_delay
) > 0
5467 && EQ (p
->adaptive_read_buffering
, Qt
))
5469 XSETFASTINT (p
->read_output_delay
, 0);
5470 process_output_delay_count
--;
5471 p
->read_output_skip
= Qnil
;
5475 signal (SIGPIPE
, old_sigpipe
);
5481 || errno
== EWOULDBLOCK
5487 /* Buffer is full. Wait, accepting input;
5488 that may allow the program
5489 to finish doing output and read more. */
5493 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
5494 /* A gross hack to work around a bug in FreeBSD.
5495 In the following sequence, read(2) returns
5499 write(2) 954 bytes, get EAGAIN
5500 read(2) 1024 bytes in process_read_output
5501 read(2) 11 bytes in process_read_output
5503 That is, read(2) returns more bytes than have
5504 ever been written successfully. The 1033 bytes
5505 read are the 1022 bytes written successfully
5506 after processing (for example with CRs added if
5507 the terminal is set up that way which it is
5508 here). The same bytes will be seen again in a
5509 later read(2), without the CRs. */
5511 if (errno
== EAGAIN
)
5514 ioctl (XINT (p
->outfd
), TIOCFLUSH
, &flags
);
5516 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
5518 /* Running filters might relocate buffers or strings.
5519 Arrange to relocate BUF. */
5520 if (BUFFERP (object
))
5521 offset
= BUF_PTR_BYTE_POS (XBUFFER (object
), buf
);
5522 else if (STRINGP (object
))
5523 offset
= buf
- SDATA (object
);
5525 #ifdef EMACS_HAS_USECS
5526 wait_reading_process_output (0, 20000, 0, 0, Qnil
, NULL
, 0);
5528 wait_reading_process_output (1, 0, 0, 0, Qnil
, NULL
, 0);
5531 if (BUFFERP (object
))
5532 buf
= BUF_BYTE_ADDRESS (XBUFFER (object
), offset
);
5533 else if (STRINGP (object
))
5534 buf
= offset
+ SDATA (object
);
5539 /* This is a real error. */
5540 report_file_error ("writing to process", Fcons (proc
, Qnil
));
5547 /* If we sent just part of the string, put in an EOF
5548 to force it through, before we send the rest. */
5550 Fprocess_send_eof (proc
);
5553 #endif /* not VMS */
5556 signal (SIGPIPE
, old_sigpipe
);
5558 proc
= process_sent_to
;
5559 p
= XPROCESS (proc
);
5561 p
->raw_status_new
= 0;
5562 p
->status
= Fcons (Qexit
, Fcons (make_number (256), Qnil
));
5563 XSETINT (p
->tick
, ++process_tick
);
5564 deactivate_process (proc
);
5566 error ("Error writing to process %s; closed it", SDATA (p
->name
));
5568 error ("SIGPIPE raised on process %s; closed it", SDATA (p
->name
));
5575 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
5577 doc
: /* Send current contents of region as input to PROCESS.
5578 PROCESS may be a process, a buffer, the name of a process or buffer, or
5579 nil, indicating the current buffer's process.
5580 Called from program, takes three arguments, PROCESS, START and END.
5581 If the region is more than 500 characters long,
5582 it is sent in several bunches. This may happen even for shorter regions.
5583 Output from processes can arrive in between bunches. */)
5584 (process
, start
, end
)
5585 Lisp_Object process
, start
, end
;
5590 proc
= get_process (process
);
5591 validate_region (&start
, &end
);
5593 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
5594 move_gap (XINT (start
));
5596 start1
= CHAR_TO_BYTE (XINT (start
));
5597 end1
= CHAR_TO_BYTE (XINT (end
));
5598 send_process (proc
, BYTE_POS_ADDR (start1
), end1
- start1
,
5599 Fcurrent_buffer ());
5604 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
5606 doc
: /* Send PROCESS the contents of STRING as input.
5607 PROCESS may be a process, a buffer, the name of a process or buffer, or
5608 nil, indicating the current buffer's process.
5609 If STRING is more than 500 characters long,
5610 it is sent in several bunches. This may happen even for shorter strings.
5611 Output from processes can arrive in between bunches. */)
5613 Lisp_Object process
, string
;
5616 CHECK_STRING (string
);
5617 proc
= get_process (process
);
5618 send_process (proc
, SDATA (string
),
5619 SBYTES (string
), string
);
5623 /* Return the foreground process group for the tty/pty that
5624 the process P uses. */
5626 emacs_get_tty_pgrp (p
)
5627 struct Lisp_Process
*p
;
5632 if (ioctl (XINT (p
->infd
), TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
5635 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5636 master side. Try the slave side. */
5637 fd
= emacs_open (XSTRING (p
->tty_name
)->data
, O_RDONLY
, 0);
5641 ioctl (fd
, TIOCGPGRP
, &gid
);
5645 #endif /* defined (TIOCGPGRP ) */
5650 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
5651 Sprocess_running_child_p
, 0, 1, 0,
5652 doc
: /* Return t if PROCESS has given the terminal to a child.
5653 If the operating system does not make it possible to find out,
5654 return t unconditionally. */)
5656 Lisp_Object process
;
5658 /* Initialize in case ioctl doesn't exist or gives an error,
5659 in a way that will cause returning t. */
5662 struct Lisp_Process
*p
;
5664 proc
= get_process (process
);
5665 p
= XPROCESS (proc
);
5667 if (!EQ (p
->childp
, Qt
))
5668 error ("Process %s is not a subprocess",
5670 if (XINT (p
->infd
) < 0)
5671 error ("Process %s is not active",
5674 gid
= emacs_get_tty_pgrp (p
);
5681 /* send a signal number SIGNO to PROCESS.
5682 If CURRENT_GROUP is t, that means send to the process group
5683 that currently owns the terminal being used to communicate with PROCESS.
5684 This is used for various commands in shell mode.
5685 If CURRENT_GROUP is lambda, that means send to the process group
5686 that currently owns the terminal, but only if it is NOT the shell itself.
5688 If NOMSG is zero, insert signal-announcements into process's buffers
5691 If we can, we try to signal PROCESS by sending control characters
5692 down the pty. This allows us to signal inferiors who have changed
5693 their uid, for which killpg would return an EPERM error. */
5696 process_send_signal (process
, signo
, current_group
, nomsg
)
5697 Lisp_Object process
;
5699 Lisp_Object current_group
;
5703 register struct Lisp_Process
*p
;
5707 proc
= get_process (process
);
5708 p
= XPROCESS (proc
);
5710 if (!EQ (p
->childp
, Qt
))
5711 error ("Process %s is not a subprocess",
5713 if (XINT (p
->infd
) < 0)
5714 error ("Process %s is not active",
5717 if (NILP (p
->pty_flag
))
5718 current_group
= Qnil
;
5720 /* If we are using pgrps, get a pgrp number and make it negative. */
5721 if (NILP (current_group
))
5722 /* Send the signal to the shell's process group. */
5726 #ifdef SIGNALS_VIA_CHARACTERS
5727 /* If possible, send signals to the entire pgrp
5728 by sending an input character to it. */
5730 /* TERMIOS is the latest and bestest, and seems most likely to
5731 work. If the system has it, use it. */
5734 cc_t
*sig_char
= NULL
;
5736 tcgetattr (XINT (p
->infd
), &t
);
5741 sig_char
= &t
.c_cc
[VINTR
];
5745 sig_char
= &t
.c_cc
[VQUIT
];
5749 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
5750 sig_char
= &t
.c_cc
[VSWTCH
];
5752 sig_char
= &t
.c_cc
[VSUSP
];
5757 if (sig_char
&& *sig_char
!= CDISABLE
)
5759 send_process (proc
, sig_char
, 1, Qnil
);
5762 /* If we can't send the signal with a character,
5763 fall through and send it another way. */
5764 #else /* ! HAVE_TERMIOS */
5766 /* On Berkeley descendants, the following IOCTL's retrieve the
5767 current control characters. */
5768 #if defined (TIOCGLTC) && defined (TIOCGETC)
5776 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5777 send_process (proc
, &c
.t_intrc
, 1, Qnil
);
5780 ioctl (XINT (p
->infd
), TIOCGETC
, &c
);
5781 send_process (proc
, &c
.t_quitc
, 1, Qnil
);
5785 ioctl (XINT (p
->infd
), TIOCGLTC
, &lc
);
5786 send_process (proc
, &lc
.t_suspc
, 1, Qnil
);
5788 #endif /* ! defined (SIGTSTP) */
5791 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5793 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
5800 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5801 send_process (proc
, &t
.c_cc
[VINTR
], 1, Qnil
);
5804 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5805 send_process (proc
, &t
.c_cc
[VQUIT
], 1, Qnil
);
5809 ioctl (XINT (p
->infd
), TCGETA
, &t
);
5810 send_process (proc
, &t
.c_cc
[VSWTCH
], 1, Qnil
);
5812 #endif /* ! defined (SIGTSTP) */
5814 #else /* ! defined (TCGETA) */
5815 Your configuration files are messed up
.
5816 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
5817 you'd better be using one of the alternatives above! */
5818 #endif /* ! defined (TCGETA) */
5819 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
5820 /* In this case, the code above should alway returns. */
5822 #endif /* ! defined HAVE_TERMIOS */
5824 /* The code above may fall through if it can't
5825 handle the signal. */
5826 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
5829 /* Get the current pgrp using the tty itself, if we have that.
5830 Otherwise, use the pty to get the pgrp.
5831 On pfa systems, saka@pfu.fujitsu.co.JP writes:
5832 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5833 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
5834 His patch indicates that if TIOCGPGRP returns an error, then
5835 we should just assume that p->pid is also the process group id. */
5837 gid
= emacs_get_tty_pgrp (p
);
5840 /* If we can't get the information, assume
5841 the shell owns the tty. */
5844 /* It is not clear whether anything really can set GID to -1.
5845 Perhaps on some system one of those ioctls can or could do so.
5846 Or perhaps this is vestigial. */
5849 #else /* ! defined (TIOCGPGRP ) */
5850 /* Can't select pgrps on this system, so we know that
5851 the child itself heads the pgrp. */
5853 #endif /* ! defined (TIOCGPGRP ) */
5855 /* If current_group is lambda, and the shell owns the terminal,
5856 don't send any signal. */
5857 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
5865 p
->raw_status_new
= 0;
5867 XSETINT (p
->tick
, ++process_tick
);
5869 status_notify (NULL
);
5871 #endif /* ! defined (SIGCONT) */
5874 send_process (proc
, "\003", 1, Qnil
); /* ^C */
5879 send_process (proc
, "\031", 1, Qnil
); /* ^Y */
5884 sys$
forcex (&(p
->pid
), 0, 1);
5887 flush_pending_output (XINT (p
->infd
));
5891 /* If we don't have process groups, send the signal to the immediate
5892 subprocess. That isn't really right, but it's better than any
5893 obvious alternative. */
5896 kill (p
->pid
, signo
);
5900 /* gid may be a pid, or minus a pgrp's number */
5902 if (!NILP (current_group
))
5904 if (ioctl (XINT (p
->infd
), TIOCSIGSEND
, signo
) == -1)
5905 EMACS_KILLPG (gid
, signo
);
5912 #else /* ! defined (TIOCSIGSEND) */
5913 EMACS_KILLPG (gid
, signo
);
5914 #endif /* ! defined (TIOCSIGSEND) */
5917 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
5918 doc
: /* Interrupt process PROCESS.
5919 PROCESS may be a process, a buffer, or the name of a process or buffer.
5920 No arg or nil means current buffer's process.
5921 Second arg CURRENT-GROUP non-nil means send signal to
5922 the current process-group of the process's controlling terminal
5923 rather than to the process's own process group.
5924 If the process is a shell, this means interrupt current subjob
5925 rather than the shell.
5927 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5928 don't send the signal. */)
5929 (process
, current_group
)
5930 Lisp_Object process
, current_group
;
5932 process_send_signal (process
, SIGINT
, current_group
, 0);
5936 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
5937 doc
: /* Kill process PROCESS. May be process or name of one.
5938 See function `interrupt-process' for more details on usage. */)
5939 (process
, current_group
)
5940 Lisp_Object process
, current_group
;
5942 process_send_signal (process
, SIGKILL
, current_group
, 0);
5946 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
5947 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
5948 See function `interrupt-process' for more details on usage. */)
5949 (process
, current_group
)
5950 Lisp_Object process
, current_group
;
5952 process_send_signal (process
, SIGQUIT
, current_group
, 0);
5956 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
5957 doc
: /* Stop process PROCESS. May be process or name of one.
5958 See function `interrupt-process' for more details on usage.
5959 If PROCESS is a network process, inhibit handling of incoming traffic. */)
5960 (process
, current_group
)
5961 Lisp_Object process
, current_group
;
5964 if (PROCESSP (process
) && NETCONN_P (process
))
5966 struct Lisp_Process
*p
;
5968 p
= XPROCESS (process
);
5969 if (NILP (p
->command
)
5970 && XINT (p
->infd
) >= 0)
5972 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
5973 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
5980 error ("No SIGTSTP support");
5982 process_send_signal (process
, SIGTSTP
, current_group
, 0);
5987 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
5988 doc
: /* Continue process PROCESS. May be process or name of one.
5989 See function `interrupt-process' for more details on usage.
5990 If PROCESS is a network process, resume handling of incoming traffic. */)
5991 (process
, current_group
)
5992 Lisp_Object process
, current_group
;
5995 if (PROCESSP (process
) && NETCONN_P (process
))
5997 struct Lisp_Process
*p
;
5999 p
= XPROCESS (process
);
6000 if (EQ (p
->command
, Qt
)
6001 && XINT (p
->infd
) >= 0
6002 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6004 FD_SET (XINT (p
->infd
), &input_wait_mask
);
6005 FD_SET (XINT (p
->infd
), &non_keyboard_wait_mask
);
6012 process_send_signal (process
, SIGCONT
, current_group
, 0);
6014 error ("No SIGCONT support");
6019 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6020 2, 2, "sProcess (name or number): \nnSignal code: ",
6021 doc
: /* Send PROCESS the signal with code SIGCODE.
6022 PROCESS may also be an integer specifying the process id of the
6023 process to signal; in this case, the process need not be a child of
6025 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6027 Lisp_Object process
, sigcode
;
6031 if (INTEGERP (process
))
6033 pid
= XINT (process
);
6037 if (FLOATP (process
))
6039 pid
= (pid_t
) XFLOAT (process
);
6043 if (STRINGP (process
))
6046 if (tem
= Fget_process (process
), NILP (tem
))
6048 pid
= XINT (Fstring_to_number (process
, make_number (10)));
6055 process
= get_process (process
);
6060 CHECK_PROCESS (process
);
6061 pid
= XPROCESS (process
)->pid
;
6063 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6067 #define handle_signal(NAME, VALUE) \
6068 else if (!strcmp (name, NAME)) \
6069 XSETINT (sigcode, VALUE)
6071 if (INTEGERP (sigcode
))
6075 unsigned char *name
;
6077 CHECK_SYMBOL (sigcode
);
6078 name
= SDATA (SYMBOL_NAME (sigcode
));
6080 if (!strncmp(name
, "SIG", 3))
6086 handle_signal ("HUP", SIGHUP
);
6089 handle_signal ("INT", SIGINT
);
6092 handle_signal ("QUIT", SIGQUIT
);
6095 handle_signal ("ILL", SIGILL
);
6098 handle_signal ("ABRT", SIGABRT
);
6101 handle_signal ("EMT", SIGEMT
);
6104 handle_signal ("KILL", SIGKILL
);
6107 handle_signal ("FPE", SIGFPE
);
6110 handle_signal ("BUS", SIGBUS
);
6113 handle_signal ("SEGV", SIGSEGV
);
6116 handle_signal ("SYS", SIGSYS
);
6119 handle_signal ("PIPE", SIGPIPE
);
6122 handle_signal ("ALRM", SIGALRM
);
6125 handle_signal ("TERM", SIGTERM
);
6128 handle_signal ("URG", SIGURG
);
6131 handle_signal ("STOP", SIGSTOP
);
6134 handle_signal ("TSTP", SIGTSTP
);
6137 handle_signal ("CONT", SIGCONT
);
6140 handle_signal ("CHLD", SIGCHLD
);
6143 handle_signal ("TTIN", SIGTTIN
);
6146 handle_signal ("TTOU", SIGTTOU
);
6149 handle_signal ("IO", SIGIO
);
6152 handle_signal ("XCPU", SIGXCPU
);
6155 handle_signal ("XFSZ", SIGXFSZ
);
6158 handle_signal ("VTALRM", SIGVTALRM
);
6161 handle_signal ("PROF", SIGPROF
);
6164 handle_signal ("WINCH", SIGWINCH
);
6167 handle_signal ("INFO", SIGINFO
);
6170 handle_signal ("USR1", SIGUSR1
);
6173 handle_signal ("USR2", SIGUSR2
);
6176 error ("Undefined signal name %s", name
);
6179 #undef handle_signal
6181 return make_number (kill (pid
, XINT (sigcode
)));
6184 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6185 doc
: /* Make PROCESS see end-of-file in its input.
6186 EOF comes after any text already sent to it.
6187 PROCESS may be a process, a buffer, the name of a process or buffer, or
6188 nil, indicating the current buffer's process.
6189 If PROCESS is a network connection, or is a process communicating
6190 through a pipe (as opposed to a pty), then you cannot send any more
6191 text to PROCESS after you call this function. */)
6193 Lisp_Object process
;
6196 struct coding_system
*coding
;
6198 if (DATAGRAM_CONN_P (process
))
6201 proc
= get_process (process
);
6202 coding
= proc_encode_coding_system
[XINT (XPROCESS (proc
)->outfd
)];
6204 /* Make sure the process is really alive. */
6205 if (XPROCESS (proc
)->raw_status_new
)
6206 update_status (XPROCESS (proc
));
6207 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6208 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6210 if (CODING_REQUIRE_FLUSHING (coding
))
6212 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6213 send_process (proc
, "", 0, Qnil
);
6217 send_process (proc
, "\032", 1, Qnil
); /* ^z */
6219 if (!NILP (XPROCESS (proc
)->pty_flag
))
6220 send_process (proc
, "\004", 1, Qnil
);
6223 int old_outfd
, new_outfd
;
6225 #ifdef HAVE_SHUTDOWN
6226 /* If this is a network connection, or socketpair is used
6227 for communication with the subprocess, call shutdown to cause EOF.
6228 (In some old system, shutdown to socketpair doesn't work.
6229 Then we just can't win.) */
6230 if (XPROCESS (proc
)->pid
== 0
6231 || XINT (XPROCESS (proc
)->outfd
) == XINT (XPROCESS (proc
)->infd
))
6232 shutdown (XINT (XPROCESS (proc
)->outfd
), 1);
6233 /* In case of socketpair, outfd == infd, so don't close it. */
6234 if (XINT (XPROCESS (proc
)->outfd
) != XINT (XPROCESS (proc
)->infd
))
6235 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6236 #else /* not HAVE_SHUTDOWN */
6237 emacs_close (XINT (XPROCESS (proc
)->outfd
));
6238 #endif /* not HAVE_SHUTDOWN */
6239 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6242 old_outfd
= XINT (XPROCESS (proc
)->outfd
);
6244 if (!proc_encode_coding_system
[new_outfd
])
6245 proc_encode_coding_system
[new_outfd
]
6246 = (struct coding_system
*) xmalloc (sizeof (struct coding_system
));
6247 bcopy (proc_encode_coding_system
[old_outfd
],
6248 proc_encode_coding_system
[new_outfd
],
6249 sizeof (struct coding_system
));
6250 bzero (proc_encode_coding_system
[old_outfd
],
6251 sizeof (struct coding_system
));
6253 XSETINT (XPROCESS (proc
)->outfd
, new_outfd
);
6259 /* Kill all processes associated with `buffer'.
6260 If `buffer' is nil, kill all processes */
6263 kill_buffer_processes (buffer
)
6266 Lisp_Object tail
, proc
;
6268 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6270 proc
= XCDR (XCAR (tail
));
6271 if (GC_PROCESSP (proc
)
6272 && (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
)))
6274 if (NETCONN_P (proc
))
6275 Fdelete_process (proc
);
6276 else if (XINT (XPROCESS (proc
)->infd
) >= 0)
6277 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
6282 /* On receipt of a signal that a child status has changed, loop asking
6283 about children with changed statuses until the system says there
6286 All we do is change the status; we do not run sentinels or print
6287 notifications. That is saved for the next time keyboard input is
6288 done, in order to avoid timing errors.
6290 ** WARNING: this can be called during garbage collection.
6291 Therefore, it must not be fooled by the presence of mark bits in
6294 ** USG WARNING: Although it is not obvious from the documentation
6295 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6296 signal() before executing at least one wait(), otherwise the
6297 handler will be called again, resulting in an infinite loop. The
6298 relevant portion of the documentation reads "SIGCLD signals will be
6299 queued and the signal-catching function will be continually
6300 reentered until the queue is empty". Invoking signal() causes the
6301 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6304 ** Malloc WARNING: This should never call malloc either directly or
6305 indirectly; if it does, that is a bug */
6308 sigchld_handler (signo
)
6311 int old_errno
= errno
;
6313 register struct Lisp_Process
*p
;
6314 extern EMACS_TIME
*input_available_clear_time
;
6316 SIGNAL_THREAD_CHECK (signo
);
6320 sigheld
|= sigbit (SIGCHLD
);
6332 #endif /* no WUNTRACED */
6333 /* Keep trying to get a status until we get a definitive result. */
6337 pid
= wait3 (&w
, WNOHANG
| WUNTRACED
, 0);
6339 while (pid
< 0 && errno
== EINTR
);
6343 /* PID == 0 means no processes found, PID == -1 means a real
6344 failure. We have done all our job, so return. */
6346 /* USG systems forget handlers when they are used;
6347 must reestablish each time */
6348 #if defined (USG) && !defined (POSIX_SIGNALS)
6349 signal (signo
, sigchld_handler
); /* WARNING - must come after wait3() */
6352 sigheld
&= ~sigbit (SIGCHLD
);
6360 #endif /* no WNOHANG */
6362 /* Find the process that signaled us, and record its status. */
6365 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6367 proc
= XCDR (XCAR (tail
));
6368 p
= XPROCESS (proc
);
6369 if (GC_EQ (p
->childp
, Qt
) && p
->pid
== pid
)
6374 /* Look for an asynchronous process whose pid hasn't been filled
6377 for (tail
= Vprocess_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
6379 proc
= XCDR (XCAR (tail
));
6380 p
= XPROCESS (proc
);
6386 /* Change the status of the process that was found. */
6389 union { int i
; WAITTYPE wt
; } u
;
6390 int clear_desc_flag
= 0;
6392 XSETINT (p
->tick
, ++process_tick
);
6394 p
->raw_status
= u
.i
;
6395 p
->raw_status_new
= 1;
6397 /* If process has terminated, stop waiting for its output. */
6398 if ((WIFSIGNALED (w
) || WIFEXITED (w
))
6399 && XINT (p
->infd
) >= 0)
6400 clear_desc_flag
= 1;
6402 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6403 if (clear_desc_flag
)
6405 FD_CLR (XINT (p
->infd
), &input_wait_mask
);
6406 FD_CLR (XINT (p
->infd
), &non_keyboard_wait_mask
);
6409 /* Tell wait_reading_process_output that it needs to wake up and
6411 if (input_available_clear_time
)
6412 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6415 /* There was no asynchronous process found for that id. Check
6416 if we have a synchronous process. */
6419 synch_process_alive
= 0;
6421 /* Report the status of the synchronous process. */
6423 synch_process_retcode
= WRETCODE (w
);
6424 else if (WIFSIGNALED (w
))
6425 synch_process_termsig
= WTERMSIG (w
);
6427 /* Tell wait_reading_process_output that it needs to wake up and
6429 if (input_available_clear_time
)
6430 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
6433 /* On some systems, we must return right away.
6434 If any more processes want to signal us, we will
6436 Otherwise (on systems that have WNOHANG), loop around
6437 to use up all the processes that have something to tell us. */
6438 #if (defined WINDOWSNT \
6439 || (defined USG && !defined GNU_LINUX \
6440 && !(defined HPUX && defined WNOHANG)))
6441 #if defined (USG) && ! defined (POSIX_SIGNALS)
6442 signal (signo
, sigchld_handler
);
6446 #endif /* USG, but not HPUX with WNOHANG */
6452 exec_sentinel_unwind (data
)
6455 XPROCESS (XCAR (data
))->sentinel
= XCDR (data
);
6460 exec_sentinel_error_handler (error
)
6463 cmd_error_internal (error
, "error in process sentinel: ");
6465 update_echo_area ();
6466 Fsleep_for (make_number (2), Qnil
);
6471 exec_sentinel (proc
, reason
)
6472 Lisp_Object proc
, reason
;
6474 Lisp_Object sentinel
, obuffer
, odeactivate
, okeymap
;
6475 register struct Lisp_Process
*p
= XPROCESS (proc
);
6476 int count
= SPECPDL_INDEX ();
6477 int outer_running_asynch_code
= running_asynch_code
;
6478 int waiting
= waiting_for_user_input_p
;
6480 /* No need to gcpro these, because all we do with them later
6481 is test them for EQness, and none of them should be a string. */
6482 odeactivate
= Vdeactivate_mark
;
6483 XSETBUFFER (obuffer
, current_buffer
);
6484 okeymap
= current_buffer
->keymap
;
6486 sentinel
= p
->sentinel
;
6487 if (NILP (sentinel
))
6490 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6491 assure that it gets restored no matter how the sentinel exits. */
6493 record_unwind_protect (exec_sentinel_unwind
, Fcons (proc
, sentinel
));
6494 /* Inhibit quit so that random quits don't screw up a running filter. */
6495 specbind (Qinhibit_quit
, Qt
);
6496 specbind (Qlast_nonmenu_event
, Qt
);
6498 /* In case we get recursively called,
6499 and we already saved the match data nonrecursively,
6500 save the same match data in safely recursive fashion. */
6501 if (outer_running_asynch_code
)
6504 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6505 restore_search_regs ();
6506 record_unwind_save_match_data ();
6507 Fset_match_data (tem
, Qt
);
6510 /* For speed, if a search happens within this code,
6511 save the match data in a special nonrecursive fashion. */
6512 running_asynch_code
= 1;
6514 internal_condition_case_1 (read_process_output_call
,
6516 Fcons (proc
, Fcons (reason
, Qnil
))),
6517 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6518 exec_sentinel_error_handler
);
6520 /* If we saved the match data nonrecursively, restore it now. */
6521 restore_search_regs ();
6522 running_asynch_code
= outer_running_asynch_code
;
6524 Vdeactivate_mark
= odeactivate
;
6526 /* Restore waiting_for_user_input_p as it was
6527 when we were called, in case the filter clobbered it. */
6528 waiting_for_user_input_p
= waiting
;
6531 if (! EQ (Fcurrent_buffer (), obuffer
)
6532 || ! EQ (current_buffer
->keymap
, okeymap
))
6534 /* But do it only if the caller is actually going to read events.
6535 Otherwise there's no need to make him wake up, and it could
6536 cause trouble (for example it would make Fsit_for return). */
6537 if (waiting_for_user_input_p
== -1)
6538 record_asynch_buffer_change ();
6540 unbind_to (count
, Qnil
);
6543 /* Report all recent events of a change in process status
6544 (either run the sentinel or output a message).
6545 This is usually done while Emacs is waiting for keyboard input
6546 but can be done at other times. */
6549 status_notify (deleting_process
)
6550 struct Lisp_Process
*deleting_process
;
6552 register Lisp_Object proc
, buffer
;
6553 Lisp_Object tail
, msg
;
6554 struct gcpro gcpro1
, gcpro2
;
6558 /* We need to gcpro tail; if read_process_output calls a filter
6559 which deletes a process and removes the cons to which tail points
6560 from Vprocess_alist, and then causes a GC, tail is an unprotected
6564 /* Set this now, so that if new processes are created by sentinels
6565 that we run, we get called again to handle their status changes. */
6566 update_tick
= process_tick
;
6568 for (tail
= Vprocess_alist
; !NILP (tail
); tail
= Fcdr (tail
))
6571 register struct Lisp_Process
*p
;
6573 proc
= Fcdr (Fcar (tail
));
6574 p
= XPROCESS (proc
);
6576 if (XINT (p
->tick
) != XINT (p
->update_tick
))
6578 XSETINT (p
->update_tick
, XINT (p
->tick
));
6580 /* If process is still active, read any output that remains. */
6581 while (! EQ (p
->filter
, Qt
)
6582 && ! EQ (p
->status
, Qconnect
)
6583 && ! EQ (p
->status
, Qlisten
)
6584 && ! EQ (p
->command
, Qt
) /* Network process not stopped. */
6585 && XINT (p
->infd
) >= 0
6586 && p
!= deleting_process
6587 && read_process_output (proc
, XINT (p
->infd
)) > 0);
6591 /* Get the text to use for the message. */
6592 if (p
->raw_status_new
)
6594 msg
= status_message (p
);
6596 /* If process is terminated, deactivate it or delete it. */
6598 if (CONSP (p
->status
))
6599 symbol
= XCAR (p
->status
);
6601 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
6602 || EQ (symbol
, Qclosed
))
6604 if (delete_exited_processes
)
6605 remove_process (proc
);
6607 deactivate_process (proc
);
6610 /* The actions above may have further incremented p->tick.
6611 So set p->update_tick again
6612 so that an error in the sentinel will not cause
6613 this code to be run again. */
6614 XSETINT (p
->update_tick
, XINT (p
->tick
));
6615 /* Now output the message suitably. */
6616 if (!NILP (p
->sentinel
))
6617 exec_sentinel (proc
, msg
);
6618 /* Don't bother with a message in the buffer
6619 when a process becomes runnable. */
6620 else if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
6622 Lisp_Object ro
, tem
;
6623 struct buffer
*old
= current_buffer
;
6624 int opoint
, opoint_byte
;
6625 int before
, before_byte
;
6627 ro
= XBUFFER (buffer
)->read_only
;
6629 /* Avoid error if buffer is deleted
6630 (probably that's why the process is dead, too) */
6631 if (NILP (XBUFFER (buffer
)->name
))
6633 Fset_buffer (buffer
);
6636 opoint_byte
= PT_BYTE
;
6637 /* Insert new output into buffer
6638 at the current end-of-output marker,
6639 thus preserving logical ordering of input and output. */
6640 if (XMARKER (p
->mark
)->buffer
)
6641 Fgoto_char (p
->mark
);
6643 SET_PT_BOTH (ZV
, ZV_BYTE
);
6646 before_byte
= PT_BYTE
;
6648 tem
= current_buffer
->read_only
;
6649 current_buffer
->read_only
= Qnil
;
6650 insert_string ("\nProcess ");
6651 Finsert (1, &p
->name
);
6652 insert_string (" ");
6654 current_buffer
->read_only
= tem
;
6655 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6657 if (opoint
>= before
)
6658 SET_PT_BOTH (opoint
+ (PT
- before
),
6659 opoint_byte
+ (PT_BYTE
- before_byte
));
6661 SET_PT_BOTH (opoint
, opoint_byte
);
6663 set_buffer_internal (old
);
6668 update_mode_lines
++; /* in case buffers use %s in mode-line-format */
6669 redisplay_preserve_echo_area (13);
6675 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
6676 Sset_process_coding_system
, 1, 3, 0,
6677 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
6678 DECODING will be used to decode subprocess output and ENCODING to
6679 encode subprocess input. */)
6680 (process
, decoding
, encoding
)
6681 register Lisp_Object process
, decoding
, encoding
;
6683 register struct Lisp_Process
*p
;
6685 CHECK_PROCESS (process
);
6686 p
= XPROCESS (process
);
6687 if (XINT (p
->infd
) < 0)
6688 error ("Input file descriptor of %s closed", SDATA (p
->name
));
6689 if (XINT (p
->outfd
) < 0)
6690 error ("Output file descriptor of %s closed", SDATA (p
->name
));
6691 Fcheck_coding_system (decoding
);
6692 Fcheck_coding_system (encoding
);
6694 p
->decode_coding_system
= decoding
;
6695 p
->encode_coding_system
= encoding
;
6696 setup_process_coding_systems (process
);
6701 DEFUN ("process-coding-system",
6702 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
6703 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
6705 register Lisp_Object process
;
6707 CHECK_PROCESS (process
);
6708 return Fcons (XPROCESS (process
)->decode_coding_system
,
6709 XPROCESS (process
)->encode_coding_system
);
6712 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
6713 Sset_process_filter_multibyte
, 2, 2, 0,
6714 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
6715 If FLAG is non-nil, the filter is given multibyte strings.
6716 If FLAG is nil, the filter is given unibyte strings. In this case,
6717 all character code conversion except for end-of-line conversion is
6720 Lisp_Object process
, flag
;
6722 register struct Lisp_Process
*p
;
6724 CHECK_PROCESS (process
);
6725 p
= XPROCESS (process
);
6726 p
->filter_multibyte
= flag
;
6727 setup_process_coding_systems (process
);
6732 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
6733 Sprocess_filter_multibyte_p
, 1, 1, 0,
6734 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
6736 Lisp_Object process
;
6738 register struct Lisp_Process
*p
;
6740 CHECK_PROCESS (process
);
6741 p
= XPROCESS (process
);
6743 return (NILP (p
->filter_multibyte
) ? Qnil
: Qt
);
6748 /* The first time this is called, assume keyboard input comes from DESC
6749 instead of from where we used to expect it.
6750 Subsequent calls mean assume input keyboard can come from DESC
6751 in addition to other places. */
6753 static int add_keyboard_wait_descriptor_called_flag
;
6756 add_keyboard_wait_descriptor (desc
)
6759 if (! add_keyboard_wait_descriptor_called_flag
)
6760 FD_CLR (0, &input_wait_mask
);
6761 add_keyboard_wait_descriptor_called_flag
= 1;
6762 FD_SET (desc
, &input_wait_mask
);
6763 FD_SET (desc
, &non_process_wait_mask
);
6764 if (desc
> max_keyboard_desc
)
6765 max_keyboard_desc
= desc
;
6768 /* From now on, do not expect DESC to give keyboard input. */
6771 delete_keyboard_wait_descriptor (desc
)
6775 int lim
= max_keyboard_desc
;
6777 FD_CLR (desc
, &input_wait_mask
);
6778 FD_CLR (desc
, &non_process_wait_mask
);
6780 if (desc
== max_keyboard_desc
)
6781 for (fd
= 0; fd
< lim
; fd
++)
6782 if (FD_ISSET (fd
, &input_wait_mask
)
6783 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6784 max_keyboard_desc
= fd
;
6787 /* Return nonzero if *MASK has a bit set
6788 that corresponds to one of the keyboard input descriptors. */
6791 keyboard_bit_set (mask
)
6796 for (fd
= 0; fd
<= max_keyboard_desc
; fd
++)
6797 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
6798 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
6811 if (! noninteractive
|| initialized
)
6813 signal (SIGCHLD
, sigchld_handler
);
6816 FD_ZERO (&input_wait_mask
);
6817 FD_ZERO (&non_keyboard_wait_mask
);
6818 FD_ZERO (&non_process_wait_mask
);
6819 max_process_desc
= 0;
6821 #ifdef NON_BLOCKING_CONNECT
6822 FD_ZERO (&connect_wait_mask
);
6823 num_pending_connects
= 0;
6826 #ifdef ADAPTIVE_READ_BUFFERING
6827 process_output_delay_count
= 0;
6828 process_output_skip
= 0;
6831 FD_SET (0, &input_wait_mask
);
6833 Vprocess_alist
= Qnil
;
6834 for (i
= 0; i
< MAXDESC
; i
++)
6836 chan_process
[i
] = Qnil
;
6837 proc_buffered_char
[i
] = -1;
6839 bzero (proc_decode_coding_system
, sizeof proc_decode_coding_system
);
6840 bzero (proc_encode_coding_system
, sizeof proc_encode_coding_system
);
6841 #ifdef DATAGRAM_SOCKETS
6842 bzero (datagram_address
, sizeof datagram_address
);
6847 Lisp_Object subfeatures
= Qnil
;
6848 struct socket_options
*sopt
;
6850 #define ADD_SUBFEATURE(key, val) \
6851 subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
6853 #ifdef NON_BLOCKING_CONNECT
6854 ADD_SUBFEATURE (QCnowait
, Qt
);
6856 #ifdef DATAGRAM_SOCKETS
6857 ADD_SUBFEATURE (QCtype
, Qdatagram
);
6859 #ifdef HAVE_LOCAL_SOCKETS
6860 ADD_SUBFEATURE (QCfamily
, Qlocal
);
6862 ADD_SUBFEATURE (QCfamily
, Qipv4
);
6864 ADD_SUBFEATURE (QCfamily
, Qipv6
);
6866 #ifdef HAVE_GETSOCKNAME
6867 ADD_SUBFEATURE (QCservice
, Qt
);
6869 #if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
6870 ADD_SUBFEATURE (QCserver
, Qt
);
6873 for (sopt
= socket_options
; sopt
->name
; sopt
++)
6874 subfeatures
= Fcons (intern (sopt
->name
), subfeatures
);
6876 Fprovide (intern ("make-network-process"), subfeatures
);
6878 #endif /* HAVE_SOCKETS */
6880 #if defined (DARWIN) || defined (MAC_OSX)
6881 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
6882 processes. As such, we only change the default value. */
6885 char *release
= get_operating_system_release();
6886 if (!release
|| !release
[0] || (release
[0] < MIN_PTY_KERNEL_VERSION
6887 && release
[1] == '.')) {
6888 Vprocess_connection_type
= Qnil
;
6897 Qprocessp
= intern ("processp");
6898 staticpro (&Qprocessp
);
6899 Qrun
= intern ("run");
6901 Qstop
= intern ("stop");
6903 Qsignal
= intern ("signal");
6904 staticpro (&Qsignal
);
6906 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
6909 Qexit = intern ("exit");
6910 staticpro (&Qexit); */
6912 Qopen
= intern ("open");
6914 Qclosed
= intern ("closed");
6915 staticpro (&Qclosed
);
6916 Qconnect
= intern ("connect");
6917 staticpro (&Qconnect
);
6918 Qfailed
= intern ("failed");
6919 staticpro (&Qfailed
);
6920 Qlisten
= intern ("listen");
6921 staticpro (&Qlisten
);
6922 Qlocal
= intern ("local");
6923 staticpro (&Qlocal
);
6924 Qipv4
= intern ("ipv4");
6927 Qipv6
= intern ("ipv6");
6930 Qdatagram
= intern ("datagram");
6931 staticpro (&Qdatagram
);
6933 QCname
= intern (":name");
6934 staticpro (&QCname
);
6935 QCbuffer
= intern (":buffer");
6936 staticpro (&QCbuffer
);
6937 QChost
= intern (":host");
6938 staticpro (&QChost
);
6939 QCservice
= intern (":service");
6940 staticpro (&QCservice
);
6941 QCtype
= intern (":type");
6942 staticpro (&QCtype
);
6943 QClocal
= intern (":local");
6944 staticpro (&QClocal
);
6945 QCremote
= intern (":remote");
6946 staticpro (&QCremote
);
6947 QCcoding
= intern (":coding");
6948 staticpro (&QCcoding
);
6949 QCserver
= intern (":server");
6950 staticpro (&QCserver
);
6951 QCnowait
= intern (":nowait");
6952 staticpro (&QCnowait
);
6953 QCsentinel
= intern (":sentinel");
6954 staticpro (&QCsentinel
);
6955 QClog
= intern (":log");
6957 QCnoquery
= intern (":noquery");
6958 staticpro (&QCnoquery
);
6959 QCstop
= intern (":stop");
6960 staticpro (&QCstop
);
6961 QCoptions
= intern (":options");
6962 staticpro (&QCoptions
);
6963 QCplist
= intern (":plist");
6964 staticpro (&QCplist
);
6965 QCfilter_multibyte
= intern (":filter-multibyte");
6966 staticpro (&QCfilter_multibyte
);
6968 Qlast_nonmenu_event
= intern ("last-nonmenu-event");
6969 staticpro (&Qlast_nonmenu_event
);
6971 staticpro (&Vprocess_alist
);
6973 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes
,
6974 doc
: /* *Non-nil means delete processes immediately when they exit.
6975 nil means don't delete them until `list-processes' is run. */);
6977 delete_exited_processes
= 1;
6979 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type
,
6980 doc
: /* Control type of device used to communicate with subprocesses.
6981 Values are nil to use a pipe, or t or `pty' to use a pty.
6982 The value has no effect if the system has no ptys or if all ptys are busy:
6983 then a pipe is used in any case.
6984 The value takes effect when `start-process' is called. */);
6985 Vprocess_connection_type
= Qt
;
6987 #ifdef ADAPTIVE_READ_BUFFERING
6988 DEFVAR_LISP ("process-adaptive-read-buffering", &Vprocess_adaptive_read_buffering
,
6989 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
6990 On some systems, when Emacs reads the output from a subprocess, the output data
6991 is read in very small blocks, potentially resulting in very poor performance.
6992 This behavior can be remedied to some extent by setting this variable to a
6993 non-nil value, as it will automatically delay reading from such processes, to
6994 allow them to produce more output before Emacs tries to read it.
6995 If the value is t, the delay is reset after each write to the process; any other
6996 non-nil value means that the delay is not reset on write.
6997 The variable takes effect when `start-process' is called. */);
6998 Vprocess_adaptive_read_buffering
= Qt
;
7001 defsubr (&Sprocessp
);
7002 defsubr (&Sget_process
);
7003 defsubr (&Sget_buffer_process
);
7004 defsubr (&Sdelete_process
);
7005 defsubr (&Sprocess_status
);
7006 defsubr (&Sprocess_exit_status
);
7007 defsubr (&Sprocess_id
);
7008 defsubr (&Sprocess_name
);
7009 defsubr (&Sprocess_tty_name
);
7010 defsubr (&Sprocess_command
);
7011 defsubr (&Sset_process_buffer
);
7012 defsubr (&Sprocess_buffer
);
7013 defsubr (&Sprocess_mark
);
7014 defsubr (&Sset_process_filter
);
7015 defsubr (&Sprocess_filter
);
7016 defsubr (&Sset_process_sentinel
);
7017 defsubr (&Sprocess_sentinel
);
7018 defsubr (&Sset_process_window_size
);
7019 defsubr (&Sset_process_inherit_coding_system_flag
);
7020 defsubr (&Sprocess_inherit_coding_system_flag
);
7021 defsubr (&Sset_process_query_on_exit_flag
);
7022 defsubr (&Sprocess_query_on_exit_flag
);
7023 defsubr (&Sprocess_contact
);
7024 defsubr (&Sprocess_plist
);
7025 defsubr (&Sset_process_plist
);
7026 defsubr (&Slist_processes
);
7027 defsubr (&Sprocess_list
);
7028 defsubr (&Sstart_process
);
7030 defsubr (&Sset_network_process_option
);
7031 defsubr (&Smake_network_process
);
7032 defsubr (&Sformat_network_address
);
7033 #endif /* HAVE_SOCKETS */
7034 #if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
7036 defsubr (&Snetwork_interface_list
);
7038 #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
7039 defsubr (&Snetwork_interface_info
);
7041 #endif /* HAVE_SOCKETS ... */
7042 #ifdef DATAGRAM_SOCKETS
7043 defsubr (&Sprocess_datagram_address
);
7044 defsubr (&Sset_process_datagram_address
);
7046 defsubr (&Saccept_process_output
);
7047 defsubr (&Sprocess_send_region
);
7048 defsubr (&Sprocess_send_string
);
7049 defsubr (&Sinterrupt_process
);
7050 defsubr (&Skill_process
);
7051 defsubr (&Squit_process
);
7052 defsubr (&Sstop_process
);
7053 defsubr (&Scontinue_process
);
7054 defsubr (&Sprocess_running_child_p
);
7055 defsubr (&Sprocess_send_eof
);
7056 defsubr (&Ssignal_process
);
7057 defsubr (&Swaiting_for_user_input_p
);
7058 /* defsubr (&Sprocess_connection); */
7059 defsubr (&Sset_process_coding_system
);
7060 defsubr (&Sprocess_coding_system
);
7061 defsubr (&Sset_process_filter_multibyte
);
7062 defsubr (&Sprocess_filter_multibyte_p
);
7066 #else /* not subprocesses */
7068 #include <sys/types.h>
7072 #include "systime.h"
7073 #include "charset.h"
7075 #include "termopts.h"
7076 #include "sysselect.h"
7078 extern int frame_garbaged
;
7080 extern EMACS_TIME
timer_check ();
7081 extern int timers_run
;
7085 /* As described above, except assuming that there are no subprocesses:
7087 Wait for timeout to elapse and/or keyboard input to be available.
7090 timeout in seconds, or
7091 zero for no limit, or
7092 -1 means gobble data immediately available but don't wait for any.
7094 read_kbd is a Lisp_Object:
7095 0 to ignore keyboard input, or
7096 1 to return when input is available, or
7097 -1 means caller will actually read the input, so don't throw to
7100 see full version for other parameters. We know that wait_proc will
7101 always be NULL, since `subprocesses' isn't defined.
7103 do_display != 0 means redisplay should be done to show subprocess
7104 output that arrives.
7106 Return true iff we received input from any process. */
7109 wait_reading_process_output (time_limit
, microsecs
, read_kbd
, do_display
,
7110 wait_for_cell
, wait_proc
, just_wait_proc
)
7111 int time_limit
, microsecs
, read_kbd
, do_display
;
7112 Lisp_Object wait_for_cell
;
7113 struct Lisp_Process
*wait_proc
;
7117 EMACS_TIME end_time
, timeout
;
7118 SELECT_TYPE waitchannels
;
7121 /* What does time_limit really mean? */
7122 if (time_limit
|| microsecs
)
7124 EMACS_GET_TIME (end_time
);
7125 EMACS_SET_SECS_USECS (timeout
, time_limit
, microsecs
);
7126 EMACS_ADD_TIME (end_time
, end_time
, timeout
);
7129 /* Turn off periodic alarms (in case they are in use)
7130 and then turn off any other atimers,
7131 because the select emulator uses alarms. */
7133 turn_on_atimers (0);
7137 int timeout_reduced_for_timers
= 0;
7139 /* If calling from keyboard input, do not quit
7140 since we want to return C-g as an input character.
7141 Otherwise, do pending quit if requested. */
7145 /* Exit now if the cell we're waiting for became non-nil. */
7146 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7149 /* Compute time from now till when time limit is up */
7150 /* Exit if already run out */
7151 if (time_limit
== -1)
7153 /* -1 specified for timeout means
7154 gobble output available now
7155 but don't wait at all. */
7157 EMACS_SET_SECS_USECS (timeout
, 0, 0);
7159 else if (time_limit
|| microsecs
)
7161 EMACS_GET_TIME (timeout
);
7162 EMACS_SUB_TIME (timeout
, end_time
, timeout
);
7163 if (EMACS_TIME_NEG_P (timeout
))
7168 EMACS_SET_SECS_USECS (timeout
, 100000, 0);
7171 /* If our caller will not immediately handle keyboard events,
7172 run timer events directly.
7173 (Callers that will immediately read keyboard events
7174 call timer_delay on their own.) */
7175 if (NILP (wait_for_cell
))
7177 EMACS_TIME timer_delay
;
7181 int old_timers_run
= timers_run
;
7182 timer_delay
= timer_check (1);
7183 if (timers_run
!= old_timers_run
&& do_display
)
7184 /* We must retry, since a timer may have requeued itself
7185 and that could alter the time delay. */
7186 redisplay_preserve_echo_area (14);
7190 while (!detect_input_pending ());
7192 /* If there is unread keyboard input, also return. */
7194 && requeued_events_pending_p ())
7197 if (! EMACS_TIME_NEG_P (timer_delay
) && time_limit
!= -1)
7199 EMACS_TIME difference
;
7200 EMACS_SUB_TIME (difference
, timer_delay
, timeout
);
7201 if (EMACS_TIME_NEG_P (difference
))
7203 timeout
= timer_delay
;
7204 timeout_reduced_for_timers
= 1;
7209 /* Cause C-g and alarm signals to take immediate action,
7210 and cause input available signals to zero out timeout. */
7212 set_waiting_for_input (&timeout
);
7214 /* Wait till there is something to do. */
7216 if (! read_kbd
&& NILP (wait_for_cell
))
7217 FD_ZERO (&waitchannels
);
7219 FD_SET (0, &waitchannels
);
7221 /* If a frame has been newly mapped and needs updating,
7222 reprocess its display stuff. */
7223 if (frame_garbaged
&& do_display
)
7225 clear_waiting_for_input ();
7226 redisplay_preserve_echo_area (15);
7228 set_waiting_for_input (&timeout
);
7231 if (read_kbd
&& detect_input_pending ())
7234 FD_ZERO (&waitchannels
);
7237 nfds
= select (1, &waitchannels
, (SELECT_TYPE
*)0, (SELECT_TYPE
*)0,
7242 /* Make C-g and alarm signals set flags again */
7243 clear_waiting_for_input ();
7245 /* If we woke up due to SIGWINCH, actually change size now. */
7246 do_pending_window_change (0);
7248 if (time_limit
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7249 /* We waited the full specified time, so return now. */
7254 /* If the system call was interrupted, then go around the
7256 if (xerrno
== EINTR
)
7257 FD_ZERO (&waitchannels
);
7259 error ("select error: %s", emacs_strerror (xerrno
));
7262 else if (nfds
> 0 && (waitchannels
& 1) && interrupt_input
)
7263 /* System sometimes fails to deliver SIGIO. */
7264 kill (getpid (), SIGIO
);
7267 if (read_kbd
&& interrupt_input
&& (waitchannels
& 1))
7268 kill (getpid (), SIGIO
);
7271 /* Check for keyboard input */
7274 && detect_input_pending_run_timers (do_display
))
7276 swallow_events (do_display
);
7277 if (detect_input_pending_run_timers (do_display
))
7281 /* If there is unread keyboard input, also return. */
7283 && requeued_events_pending_p ())
7286 /* If wait_for_cell. check for keyboard input
7287 but don't run any timers.
7288 ??? (It seems wrong to me to check for keyboard
7289 input at all when wait_for_cell, but the code
7290 has been this way since July 1994.
7291 Try changing this after version 19.31.) */
7292 if (! NILP (wait_for_cell
)
7293 && detect_input_pending ())
7295 swallow_events (do_display
);
7296 if (detect_input_pending ())
7300 /* Exit now if the cell we're waiting for became non-nil. */
7301 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7311 /* Don't confuse make-docfile by having two doc strings for this function.
7312 make-docfile does not pay attention to #if, for good reason! */
7313 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7316 register Lisp_Object name
;
7321 /* Don't confuse make-docfile by having two doc strings for this function.
7322 make-docfile does not pay attention to #if, for good reason! */
7323 DEFUN ("process-inherit-coding-system-flag",
7324 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7328 register Lisp_Object process
;
7330 /* Ignore the argument and return the value of
7331 inherit-process-coding-system. */
7332 return inherit_process_coding_system
? Qt
: Qnil
;
7335 /* Kill all processes associated with `buffer'.
7336 If `buffer' is nil, kill all processes.
7337 Since we have no subprocesses, this does nothing. */
7340 kill_buffer_processes (buffer
)
7353 QCtype
= intern (":type");
7354 staticpro (&QCtype
);
7356 defsubr (&Sget_buffer_process
);
7357 defsubr (&Sprocess_inherit_coding_system_flag
);
7361 #endif /* not subprocesses */
7363 /* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
7364 (do not change this comment) */