(window_loop) <GET_BUFFER_WINDOW>: Prefer to return
[bpt/emacs.git] / src / process.c
CommitLineData
d0d6b7c5 1/* Asynchronous subprocess control for GNU Emacs.
68c45bf0 2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999
03832893 3 Free Software Foundation, Inc.
d0d6b7c5
JB
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
1dc77cc3 9the Free Software Foundation; either version 2, or (at your option)
d0d6b7c5
JB
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN
19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
d0d6b7c5
JB
21
22
827a1788 23#define _GNU_SOURCE /* to get strsignal declared with glibc 2 */
18160b98 24#include <config.h>
68c45bf0
PE
25#include <signal.h>
26
6720a7fb
JB
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. */
33
34\f
d0d6b7c5 35#ifdef subprocesses
d0d6b7c5
JB
36
37#include <stdio.h>
38#include <errno.h>
39#include <setjmp.h>
40#include <sys/types.h> /* some typedefs are used in sys/file.h */
41#include <sys/file.h>
42#include <sys/stat.h>
93b4f699
RS
43#ifdef HAVE_UNISTD_H
44#include <unistd.h>
45#endif
d0d6b7c5 46
f22ac298 47#if defined(WINDOWSNT) || defined(UNIX98_PTYS)
e98d950b
RS
48#include <stdlib.h>
49#include <fcntl.h>
50#endif /* not WINDOWSNT */
51
d0d6b7c5
JB
52#ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
53#include <sys/socket.h>
54#include <netdb.h>
55#include <netinet/in.h>
56#include <arpa/inet.h>
f2cfa9a6
RS
57#ifdef NEED_NET_ERRNO_H
58#include <net/errno.h>
59#endif /* NEED_NET_ERRNO_H */
d0d6b7c5
JB
60#endif /* HAVE_SOCKETS */
61
827a1788 62/* TERM is a poor-man's SLIP, used on GNU/Linux. */
1d2c16fa
RS
63#ifdef TERM
64#include <client.h>
65#endif
66
cf32fea0
PR
67/* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */
68#ifdef HAVE_BROKEN_INET_ADDR
79967d5e
RS
69#define IN_ADDR struct in_addr
70#define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1)
71#else
72#define IN_ADDR unsigned long
73#define NUMERIC_ADDR_ERROR (numeric_addr == -1)
74#endif
75
6df54671 76#if defined(BSD_SYSTEM) || defined(STRIDE)
d0d6b7c5 77#include <sys/ioctl.h>
0ad77c54 78#if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
d0d6b7c5
JB
79#include <fcntl.h>
80#endif /* HAVE_PTYS and no O_NDELAY */
6df54671 81#endif /* BSD_SYSTEM || STRIDE */
d0d6b7c5 82
99e3d726
RS
83#ifdef BROKEN_O_NONBLOCK
84#undef O_NONBLOCK
85#endif /* BROKEN_O_NONBLOCK */
86
d0d6b7c5
JB
87#ifdef NEED_BSDTTY
88#include <bsdtty.h>
89#endif
90
d0d6b7c5
JB
91#ifdef IRIS
92#include <sys/sysmacros.h> /* for "minor" */
93#endif /* not IRIS */
94
95#include "systime.h"
36ebaafa 96#include "systty.h"
d0d6b7c5
JB
97
98#include "lisp.h"
99#include "window.h"
100#include "buffer.h"
0fa1789e
KH
101#include "charset.h"
102#include "coding.h"
d0d6b7c5
JB
103#include "process.h"
104#include "termhooks.h"
105#include "termopts.h"
106#include "commands.h"
3ec68006 107#include "keyboard.h"
1dc77cc3 108#include "frame.h"
ececcbec 109#include "blockinput.h"
dfcf069d 110#include "dispextern.h"
e0016554 111#include "composite.h"
30904ab7 112#include "atimer.h"
d0d6b7c5 113
0c9960e9
RS
114#define max(a, b) ((a) > (b) ? (a) : (b))
115
dd2281ae 116Lisp_Object Qprocessp;
d0d6b7c5 117Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed;
6545aada 118Lisp_Object Qlast_nonmenu_event;
d0d6b7c5
JB
119/* Qexit is declared and initialized in eval.c. */
120
121/* a process object is a network connection when its childp field is neither
de282a05 122 Qt nor Qnil but is instead a cons cell (HOSTNAME PORTNUM). */
d0d6b7c5
JB
123
124#ifdef HAVE_SOCKETS
de282a05 125#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
d0d6b7c5
JB
126#else
127#define NETCONN_P(p) 0
128#endif /* HAVE_SOCKETS */
129
130/* Define first descriptor number available for subprocesses. */
131#ifdef VMS
132#define FIRST_PROC_DESC 1
133#else /* Not VMS */
134#define FIRST_PROC_DESC 3
135#endif
136
137/* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
138 testing SIGCHLD. */
139
140#if !defined (SIGCHLD) && defined (SIGCLD)
141#define SIGCHLD SIGCLD
142#endif /* SIGCLD */
143
144#include "syssignal.h"
145
889255b4 146#include "syswait.h"
d0d6b7c5 147
41d03b9a
GM
148extern void set_waiting_for_input P_ ((EMACS_TIME *));
149
3ec68006 150#ifndef USE_CRT_DLL
b062d1fe 151extern int errno;
3ec68006 152#endif
b062d1fe 153#ifdef VMS
d0d6b7c5 154extern char *sys_errlist[];
b062d1fe 155#endif
d0d6b7c5 156
5f0929a7
RS
157#ifndef HAVE_H_ERRNO
158extern int h_errno;
159#endif
160
d0d6b7c5
JB
161/* t means use pty, nil means use a pipe,
162 maybe other values to come. */
dd2281ae 163static Lisp_Object Vprocess_connection_type;
d0d6b7c5
JB
164
165#ifdef SKTPAIR
166#ifndef HAVE_SOCKETS
167#include <sys/socket.h>
168#endif
169#endif /* SKTPAIR */
170
17d02632
KH
171/* These next two vars are non-static since sysdep.c uses them in the
172 emulation of `select'. */
d0d6b7c5 173/* Number of events of change of status of a process. */
17d02632 174int process_tick;
d0d6b7c5 175/* Number of events for which the user or sentinel has been notified. */
17d02632 176int update_tick;
d0d6b7c5 177
5886acf9 178#include "sysselect.h"
d0d6b7c5 179
41d03b9a
GM
180extern int keyboard_bit_set P_ ((SELECT_TYPE *));
181
583dcae4 182/* If we support a window system, turn on the code to poll periodically
44ade2e9 183 to detect C-g. It isn't actually used when doing interrupt input. */
583dcae4 184#ifdef HAVE_WINDOW_SYSTEM
44ade2e9
RS
185#define POLL_FOR_INPUT
186#endif
187
a69281ff 188/* Mask of bits indicating the descriptors that we wait for input on. */
d0d6b7c5 189
dd2281ae
RS
190static SELECT_TYPE input_wait_mask;
191
a69281ff
RS
192/* Mask that excludes keyboard input descriptor (s). */
193
194static SELECT_TYPE non_keyboard_wait_mask;
195
b5dc1c83
RS
196/* Mask that excludes process input descriptor (s). */
197
198static SELECT_TYPE non_process_wait_mask;
199
7d0e672e
RS
200/* The largest descriptor currently in use for a process object. */
201static int max_process_desc;
202
a69281ff
RS
203/* The largest descriptor currently in use for keyboard input. */
204static int max_keyboard_desc;
d0d6b7c5 205
dd2281ae
RS
206/* Nonzero means delete a process right away if it exits. */
207static int delete_exited_processes;
d0d6b7c5
JB
208
209/* Indexed by descriptor, gives the process (if any) for that descriptor */
41f3aa98 210Lisp_Object chan_process[MAXDESC];
d0d6b7c5
JB
211
212/* Alist of elements (NAME . PROCESS) */
41f3aa98 213Lisp_Object Vprocess_alist;
d0d6b7c5
JB
214
215/* Buffered-ahead input char from process, indexed by channel.
216 -1 means empty (no char is buffered).
217 Used on sys V where the only way to tell if there is any
218 output from the process is to read at least one char.
219 Always -1 on systems that support FIONREAD. */
220
e98d950b
RS
221/* Don't make static; need to access externally. */
222int proc_buffered_char[MAXDESC];
dd2281ae 223
0fa1789e 224/* Table of `struct coding-system' for each process. */
c7580538
KH
225static struct coding_system *proc_decode_coding_system[MAXDESC];
226static struct coding_system *proc_encode_coding_system[MAXDESC];
0fa1789e 227
dd2281ae 228static Lisp_Object get_process ();
93b4f699 229
fb4c3627 230extern EMACS_TIME timer_check ();
5de50bfb 231extern int timers_run;
fb4c3627 232
93b4f699
RS
233/* Maximum number of bytes to send to a pty without an eof. */
234static int pty_max_bytes;
3b9a3dfa 235
14dc6093 236extern Lisp_Object Vfile_name_coding_system, Vdefault_file_name_coding_system;
a932f187 237
875e6b94
KH
238#ifdef HAVE_PTYS
239/* The file name of the pty opened by allocate_pty. */
3b9a3dfa
RS
240
241static char pty_name[24];
875e6b94 242#endif
d0d6b7c5
JB
243\f
244/* Compute the Lisp form of the process status, p->status, from
245 the numeric status that was returned by `wait'. */
246
f9738840
JB
247Lisp_Object status_convert ();
248
dfcf069d 249void
d0d6b7c5
JB
250update_status (p)
251 struct Lisp_Process *p;
252{
253 union { int i; WAITTYPE wt; } u;
254 u.i = XFASTINT (p->raw_status_low) + (XFASTINT (p->raw_status_high) << 16);
255 p->status = status_convert (u.wt);
256 p->raw_status_low = Qnil;
257 p->raw_status_high = Qnil;
258}
259
91d10fa8 260/* Convert a process status word in Unix format to
d0d6b7c5
JB
261 the list that we use internally. */
262
263Lisp_Object
264status_convert (w)
265 WAITTYPE w;
266{
267 if (WIFSTOPPED (w))
268 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
269 else if (WIFEXITED (w))
270 return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
271 WCOREDUMP (w) ? Qt : Qnil));
272 else if (WIFSIGNALED (w))
273 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
274 WCOREDUMP (w) ? Qt : Qnil));
275 else
276 return Qrun;
277}
278
279/* Given a status-list, extract the three pieces of information
280 and store them individually through the three pointers. */
281
282void
283decode_status (l, symbol, code, coredump)
284 Lisp_Object l;
285 Lisp_Object *symbol;
286 int *code;
287 int *coredump;
288{
289 Lisp_Object tem;
290
bcd69aea 291 if (SYMBOLP (l))
d0d6b7c5
JB
292 {
293 *symbol = l;
294 *code = 0;
295 *coredump = 0;
296 }
297 else
298 {
70949dac
KR
299 *symbol = XCAR (l);
300 tem = XCDR (l);
301 *code = XFASTINT (XCAR (tem));
302 tem = XCDR (tem);
d0d6b7c5
JB
303 *coredump = !NILP (tem);
304 }
305}
306
307/* Return a string describing a process status list. */
308
309Lisp_Object
310status_message (status)
311 Lisp_Object status;
312{
313 Lisp_Object symbol;
314 int code, coredump;
315 Lisp_Object string, string2;
316
317 decode_status (status, &symbol, &code, &coredump);
318
319 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
320 {
68c45bf0 321 char *signame;
ca9c0567 322 synchronize_system_messages_locale ();
68c45bf0 323 signame = strsignal (code);
b97ad9ea
RS
324 if (signame == 0)
325 signame = "unknown";
326 string = build_string (signame);
d0d6b7c5
JB
327 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
328 XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
329 return concat2 (string, string2);
330 }
331 else if (EQ (symbol, Qexit))
332 {
333 if (code == 0)
334 return build_string ("finished\n");
f2980264 335 string = Fnumber_to_string (make_number (code));
d0d6b7c5
JB
336 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
337 return concat2 (build_string ("exited abnormally with code "),
338 concat2 (string, string2));
339 }
340 else
341 return Fcopy_sequence (Fsymbol_name (symbol));
342}
343\f
344#ifdef HAVE_PTYS
d0d6b7c5 345
875e6b94
KH
346/* Open an available pty, returning a file descriptor.
347 Return -1 on failure.
348 The file name of the terminal corresponding to the pty
349 is left in the variable pty_name. */
350
d0d6b7c5
JB
351int
352allocate_pty ()
353{
354 struct stat stb;
dfcf069d 355 register int c, i;
d0d6b7c5
JB
356 int fd;
357
32676c08
JB
358 /* Some systems name their pseudoterminals so that there are gaps in
359 the usual sequence - for example, on HP9000/S700 systems, there
360 are no pseudoterminals with names ending in 'f'. So we wait for
361 three failures in a row before deciding that we've reached the
362 end of the ptys. */
363 int failed_count = 0;
364
d0d6b7c5
JB
365#ifdef PTY_ITERATION
366 PTY_ITERATION
367#else
368 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
369 for (i = 0; i < 16; i++)
370#endif
371 {
372#ifdef PTY_NAME_SPRINTF
373 PTY_NAME_SPRINTF
d0d6b7c5
JB
374#else
375 sprintf (pty_name, "/dev/pty%c%x", c, i);
d0d6b7c5
JB
376#endif /* no PTY_NAME_SPRINTF */
377
4d7c105e
RS
378#ifdef PTY_OPEN
379 PTY_OPEN;
380#else /* no PTY_OPEN */
32676c08
JB
381#ifdef IRIS
382 /* Unusual IRIS code */
68c45bf0 383 *ptyv = emacs_open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
32676c08
JB
384 if (fd < 0)
385 return -1;
386 if (fstat (fd, &stb) < 0)
d0d6b7c5 387 return -1;
4d7c105e 388#else /* not IRIS */
32676c08
JB
389 if (stat (pty_name, &stb) < 0)
390 {
391 failed_count++;
392 if (failed_count >= 3)
393 return -1;
394 }
395 else
396 failed_count = 0;
d0d6b7c5 397#ifdef O_NONBLOCK
68c45bf0 398 fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
d0d6b7c5 399#else
68c45bf0 400 fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
d0d6b7c5 401#endif
4d7c105e
RS
402#endif /* not IRIS */
403#endif /* no PTY_OPEN */
d0d6b7c5
JB
404
405 if (fd >= 0)
406 {
407 /* check to make certain that both sides are available
408 this avoids a nasty yet stupid bug in rlogins */
409#ifdef PTY_TTY_NAME_SPRINTF
410 PTY_TTY_NAME_SPRINTF
d0d6b7c5
JB
411#else
412 sprintf (pty_name, "/dev/tty%c%x", c, i);
d0d6b7c5
JB
413#endif /* no PTY_TTY_NAME_SPRINTF */
414#ifndef UNIPLUS
415 if (access (pty_name, 6) != 0)
416 {
68c45bf0 417 emacs_close (fd);
fad97cbe 418#if !defined(IRIS) && !defined(__sgi)
d0d6b7c5
JB
419 continue;
420#else
421 return -1;
422#endif /* IRIS */
423 }
424#endif /* not UNIPLUS */
425 setup_pty (fd);
426 return fd;
427 }
428 }
429 return -1;
430}
431#endif /* HAVE_PTYS */
432\f
433Lisp_Object
434make_process (name)
435 Lisp_Object name;
436{
23d6bb9c 437 struct Lisp_Vector *vec;
d0d6b7c5
JB
438 register Lisp_Object val, tem, name1;
439 register struct Lisp_Process *p;
440 char suffix[10];
441 register int i;
442
23d6bb9c
KH
443 vec = allocate_vectorlike ((EMACS_INT) VECSIZE (struct Lisp_Process));
444 for (i = 0; i < VECSIZE (struct Lisp_Process); i++)
445 vec->contents[i] = Qnil;
446 vec->size = VECSIZE (struct Lisp_Process);
447 p = (struct Lisp_Process *)vec;
448
1d056e64
KH
449 XSETINT (p->infd, -1);
450 XSETINT (p->outfd, -1);
22719df2
KH
451 XSETFASTINT (p->pid, 0);
452 XSETFASTINT (p->tick, 0);
453 XSETFASTINT (p->update_tick, 0);
d0d6b7c5
JB
454 p->raw_status_low = Qnil;
455 p->raw_status_high = Qnil;
456 p->status = Qrun;
457 p->mark = Fmake_marker ();
458
459 /* If name is already in use, modify it until it is unused. */
460
461 name1 = name;
462 for (i = 1; ; i++)
463 {
464 tem = Fget_process (name1);
465 if (NILP (tem)) break;
466 sprintf (suffix, "<%d>", i);
467 name1 = concat2 (name, build_string (suffix));
468 }
469 name = name1;
470 p->name = name;
23d6bb9c 471 XSETPROCESS (val, p);
d0d6b7c5
JB
472 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
473 return val;
474}
475
dfcf069d 476void
d0d6b7c5
JB
477remove_process (proc)
478 register Lisp_Object proc;
479{
480 register Lisp_Object pair;
481
482 pair = Frassq (proc, Vprocess_alist);
483 Vprocess_alist = Fdelq (pair, Vprocess_alist);
d0d6b7c5
JB
484
485 deactivate_process (proc);
486}
487\f
488DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
489 "Return t if OBJECT is a process.")
4ee3e309
EN
490 (object)
491 Lisp_Object object;
d0d6b7c5 492{
4ee3e309 493 return PROCESSP (object) ? Qt : Qnil;
d0d6b7c5
JB
494}
495
496DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
497 "Return the process named NAME, or nil if there is none.")
498 (name)
499 register Lisp_Object name;
500{
bcd69aea 501 if (PROCESSP (name))
d0d6b7c5
JB
502 return name;
503 CHECK_STRING (name, 0);
504 return Fcdr (Fassoc (name, Vprocess_alist));
505}
506
507DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
7744ca33 508 "Return the (or a) process associated with BUFFER.\n\
d0d6b7c5 509BUFFER may be a buffer or the name of one.")
4ee3e309
EN
510 (buffer)
511 register Lisp_Object buffer;
d0d6b7c5
JB
512{
513 register Lisp_Object buf, tail, proc;
514
4ee3e309
EN
515 if (NILP (buffer)) return Qnil;
516 buf = Fget_buffer (buffer);
d0d6b7c5
JB
517 if (NILP (buf)) return Qnil;
518
519 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
520 {
521 proc = Fcdr (Fcar (tail));
bcd69aea 522 if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
d0d6b7c5
JB
523 return proc;
524 }
525 return Qnil;
526}
527
ebb9e16f
JB
528/* This is how commands for the user decode process arguments. It
529 accepts a process, a process name, a buffer, a buffer name, or nil.
530 Buffers denote the first process in the buffer, and nil denotes the
531 current buffer. */
d0d6b7c5 532
77b221b1 533static Lisp_Object
d0d6b7c5
JB
534get_process (name)
535 register Lisp_Object name;
536{
1619761d
KH
537 register Lisp_Object proc, obj;
538 if (STRINGP (name))
539 {
540 obj = Fget_process (name);
541 if (NILP (obj))
542 obj = Fget_buffer (name);
543 if (NILP (obj))
544 error ("Process %s does not exist", XSTRING (name)->data);
545 }
546 else if (NILP (name))
547 obj = Fcurrent_buffer ();
d0d6b7c5 548 else
1619761d
KH
549 obj = name;
550
551 /* Now obj should be either a buffer object or a process object.
552 */
553 if (BUFFERP (obj))
d0d6b7c5 554 {
1619761d 555 proc = Fget_buffer_process (obj);
d0d6b7c5 556 if (NILP (proc))
1619761d 557 error ("Buffer %s has no process", XSTRING (XBUFFER (obj)->name)->data);
d0d6b7c5 558 }
d0d6b7c5 559 else
1619761d
KH
560 {
561 CHECK_PROCESS (obj, 0);
562 proc = obj;
563 }
564 return proc;
d0d6b7c5
JB
565}
566
567DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
568 "Delete PROCESS: kill it and forget about it immediately.\n\
ebb9e16f
JB
569PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
570nil, indicating the current buffer's process.")
4ee3e309
EN
571 (process)
572 register Lisp_Object process;
d0d6b7c5 573{
4ee3e309
EN
574 process = get_process (process);
575 XPROCESS (process)->raw_status_low = Qnil;
576 XPROCESS (process)->raw_status_high = Qnil;
577 if (NETCONN_P (process))
d0d6b7c5 578 {
4ee3e309
EN
579 XPROCESS (process)->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
580 XSETINT (XPROCESS (process)->tick, ++process_tick);
d0d6b7c5 581 }
4ee3e309 582 else if (XINT (XPROCESS (process)->infd) >= 0)
d0d6b7c5 583 {
4ee3e309 584 Fkill_process (process, Qnil);
d0d6b7c5 585 /* Do this now, since remove_process will make sigchld_handler do nothing. */
4ee3e309 586 XPROCESS (process)->status
d0d6b7c5 587 = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
4ee3e309 588 XSETINT (XPROCESS (process)->tick, ++process_tick);
d0d6b7c5
JB
589 status_notify ();
590 }
4ee3e309 591 remove_process (process);
d0d6b7c5
JB
592 return Qnil;
593}
594\f
595DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
7744ca33
KH
596 "Return the status of PROCESS.\n\
597The returned value is one of the following symbols:\n\
d0d6b7c5
JB
598run -- for a process that is running.\n\
599stop -- for a process stopped but continuable.\n\
600exit -- for a process that has exited.\n\
601signal -- for a process that has got a fatal signal.\n\
602open -- for a network stream connection that is open.\n\
603closed -- for a network stream connection that is closed.\n\
ebb9e16f 604nil -- if arg is a process name and no such process exists.\n\
31cd7d00 605PROCESS may be a process, a buffer, the name of a process, or\n\
ebb9e16f 606nil, indicating the current buffer's process.")
4ee3e309
EN
607 (process)
608 register Lisp_Object process;
d0d6b7c5
JB
609{
610 register struct Lisp_Process *p;
611 register Lisp_Object status;
343f4114 612
4ee3e309
EN
613 if (STRINGP (process))
614 process = Fget_process (process);
343f4114 615 else
4ee3e309 616 process = get_process (process);
343f4114 617
4ee3e309
EN
618 if (NILP (process))
619 return process;
343f4114 620
4ee3e309 621 p = XPROCESS (process);
d0d6b7c5
JB
622 if (!NILP (p->raw_status_low))
623 update_status (p);
624 status = p->status;
bcd69aea 625 if (CONSP (status))
70949dac 626 status = XCAR (status);
4ee3e309 627 if (NETCONN_P (process))
d0d6b7c5
JB
628 {
629 if (EQ (status, Qrun))
630 status = Qopen;
631 else if (EQ (status, Qexit))
632 status = Qclosed;
633 }
634 return status;
635}
636
637DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
638 1, 1, 0,
639 "Return the exit status of PROCESS or the signal number that killed it.\n\
640If PROCESS has not yet exited or died, return 0.")
4ee3e309
EN
641 (process)
642 register Lisp_Object process;
d0d6b7c5 643{
4ee3e309
EN
644 CHECK_PROCESS (process, 0);
645 if (!NILP (XPROCESS (process)->raw_status_low))
646 update_status (XPROCESS (process));
647 if (CONSP (XPROCESS (process)->status))
70949dac 648 return XCAR (XCDR (XPROCESS (process)->status));
d0d6b7c5
JB
649 return make_number (0);
650}
651
652DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
653 "Return the process id of PROCESS.\n\
654This is the pid of the Unix process which PROCESS uses or talks to.\n\
655For a network connection, this value is nil.")
4ee3e309
EN
656 (process)
657 register Lisp_Object process;
d0d6b7c5 658{
4ee3e309
EN
659 CHECK_PROCESS (process, 0);
660 return XPROCESS (process)->pid;
d0d6b7c5
JB
661}
662
663DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
664 "Return the name of PROCESS, as a string.\n\
665This is the name of the program invoked in PROCESS,\n\
666possibly modified to make it unique among process names.")
4ee3e309
EN
667 (process)
668 register Lisp_Object process;
d0d6b7c5 669{
4ee3e309
EN
670 CHECK_PROCESS (process, 0);
671 return XPROCESS (process)->name;
d0d6b7c5
JB
672}
673
674DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
675 "Return the command that was executed to start PROCESS.\n\
676This is a list of strings, the first string being the program executed\n\
677and the rest of the strings being the arguments given to it.\n\
678For a non-child channel, this is nil.")
4ee3e309
EN
679 (process)
680 register Lisp_Object process;
d0d6b7c5 681{
4ee3e309
EN
682 CHECK_PROCESS (process, 0);
683 return XPROCESS (process)->command;
d0d6b7c5
JB
684}
685
3b9a3dfa
RS
686DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
687 "Return the name of the terminal PROCESS uses, or nil if none.\n\
688This is the terminal that the process itself reads and writes on,\n\
689not the name of the pty that Emacs uses to talk with that terminal.")
4ee3e309
EN
690 (process)
691 register Lisp_Object process;
3b9a3dfa 692{
4ee3e309
EN
693 CHECK_PROCESS (process, 0);
694 return XPROCESS (process)->tty_name;
3b9a3dfa
RS
695}
696
d0d6b7c5
JB
697DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
698 2, 2, 0,
699 "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
4ee3e309
EN
700 (process, buffer)
701 register Lisp_Object process, buffer;
d0d6b7c5 702{
4ee3e309 703 CHECK_PROCESS (process, 0);
d0d6b7c5
JB
704 if (!NILP (buffer))
705 CHECK_BUFFER (buffer, 1);
4ee3e309 706 XPROCESS (process)->buffer = buffer;
d0d6b7c5
JB
707 return buffer;
708}
709
710DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
711 1, 1, 0,
712 "Return the buffer PROCESS is associated with.\n\
7744ca33 713Output from PROCESS is inserted in this buffer unless PROCESS has a filter.")
4ee3e309
EN
714 (process)
715 register Lisp_Object process;
d0d6b7c5 716{
4ee3e309
EN
717 CHECK_PROCESS (process, 0);
718 return XPROCESS (process)->buffer;
d0d6b7c5
JB
719}
720
721DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
722 1, 1, 0,
723 "Return the marker for the end of the last output from PROCESS.")
4ee3e309
EN
724 (process)
725 register Lisp_Object process;
d0d6b7c5 726{
4ee3e309
EN
727 CHECK_PROCESS (process, 0);
728 return XPROCESS (process)->mark;
d0d6b7c5
JB
729}
730
731DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
732 2, 2, 0,
733 "Give PROCESS the filter function FILTER; nil means no filter.\n\
20ddfff7 734t means stop accepting output from the process.\n\
d0d6b7c5
JB
735When a process has a filter, each time it does output\n\
736the entire string of output is passed to the filter.\n\
737The filter gets two arguments: the process and the string of output.\n\
738If the process has a filter, its buffer is not used for output.")
4ee3e309
EN
739 (process, filter)
740 register Lisp_Object process, filter;
d0d6b7c5 741{
4ee3e309 742 CHECK_PROCESS (process, 0);
20ddfff7 743 if (EQ (filter, Qt))
a69281ff 744 {
4ee3e309
EN
745 FD_CLR (XINT (XPROCESS (process)->infd), &input_wait_mask);
746 FD_CLR (XINT (XPROCESS (process)->infd), &non_keyboard_wait_mask);
a69281ff 747 }
4ee3e309 748 else if (EQ (XPROCESS (process)->filter, Qt))
a69281ff 749 {
4ee3e309
EN
750 FD_SET (XINT (XPROCESS (process)->infd), &input_wait_mask);
751 FD_SET (XINT (XPROCESS (process)->infd), &non_keyboard_wait_mask);
a69281ff 752 }
4ee3e309 753 XPROCESS (process)->filter = filter;
d0d6b7c5
JB
754 return filter;
755}
756
757DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
758 1, 1, 0,
759 "Returns the filter function of PROCESS; nil if none.\n\
760See `set-process-filter' for more info on filter functions.")
4ee3e309
EN
761 (process)
762 register Lisp_Object process;
d0d6b7c5 763{
4ee3e309
EN
764 CHECK_PROCESS (process, 0);
765 return XPROCESS (process)->filter;
d0d6b7c5
JB
766}
767
768DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
769 2, 2, 0,
770 "Give PROCESS the sentinel SENTINEL; nil for none.\n\
771The sentinel is called as a function when the process changes state.\n\
772It gets two arguments: the process, and a string describing the change.")
4ee3e309
EN
773 (process, sentinel)
774 register Lisp_Object process, sentinel;
d0d6b7c5 775{
4ee3e309
EN
776 CHECK_PROCESS (process, 0);
777 XPROCESS (process)->sentinel = sentinel;
d0d6b7c5
JB
778 return sentinel;
779}
780
781DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
782 1, 1, 0,
783 "Return the sentinel of PROCESS; nil if none.\n\
784See `set-process-sentinel' for more info on sentinels.")
4ee3e309
EN
785 (process)
786 register Lisp_Object process;
d0d6b7c5 787{
4ee3e309
EN
788 CHECK_PROCESS (process, 0);
789 return XPROCESS (process)->sentinel;
d0d6b7c5
JB
790}
791
396df322
RS
792DEFUN ("set-process-window-size", Fset_process_window_size,
793 Sset_process_window_size, 3, 3, 0,
794 "Tell PROCESS that it has logical window size HEIGHT and WIDTH.")
4ee3e309
EN
795 (process, height, width)
796 register Lisp_Object process, height, width;
396df322 797{
4ee3e309 798 CHECK_PROCESS (process, 0);
396df322
RS
799 CHECK_NATNUM (height, 0);
800 CHECK_NATNUM (width, 0);
4ee3e309 801 if (set_window_size (XINT (XPROCESS (process)->infd),
a319f7c1 802 XINT (height), XINT (width)) <= 0)
396df322
RS
803 return Qnil;
804 else
805 return Qt;
806}
807
52a1b894
EZ
808DEFUN ("set-process-inherit-coding-system-flag",
809 Fset_process_inherit_coding_system_flag,
810 Sset_process_inherit_coding_system_flag, 2, 2, 0,
811 "Determine whether buffer of PROCESS will inherit coding-system.\n\
812If the second argument FLAG is non-nil, then the variable\n\
813`buffer-file-coding-system' of the buffer associated with PROCESS\n\
814will be bound to the value of the coding system used to decode\n\
815the process output.\n\
816\n\
817This is useful when the coding system specified for the process buffer\n\
818leaves either the character code conversion or the end-of-line conversion\n\
819unspecified, or if the coding system used to decode the process output\n\
820is more appropriate for saving the process buffer.\n\
821\n\
822Binding the variable `inherit-process-coding-system' to non-nil before\n\
823starting the process is an alternative way of setting the inherit flag\n\
824for the process which will run.")
825 (process, flag)
826 register Lisp_Object process, flag;
827{
828 CHECK_PROCESS (process, 0);
aa91317a 829 XPROCESS (process)->inherit_coding_system_flag = flag;
52a1b894
EZ
830 return flag;
831}
832
833DEFUN ("process-inherit-coding-system-flag",
834 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
835 1, 1, 0,
836 "Return the value of inherit-coding-system flag for PROCESS.\n\
837If this flag is t, `buffer-file-coding-system' of the buffer\n\
838associated with PROCESS will inherit the coding system used to decode\n\
839the process output.")
840 (process)
841 register Lisp_Object process;
842{
843 CHECK_PROCESS (process, 0);
aa91317a 844 return XPROCESS (process)->inherit_coding_system_flag;
52a1b894
EZ
845}
846
d0d6b7c5
JB
847DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
848 Sprocess_kill_without_query, 1, 2, 0,
849 "Say no query needed if PROCESS is running when Emacs is exited.\n\
f2d2dbfe 850Optional second argument if non-nil says to require a query.\n\
d0d6b7c5 851Value is t if a query was formerly required.")
4ee3e309
EN
852 (process, value)
853 register Lisp_Object process, value;
d0d6b7c5
JB
854{
855 Lisp_Object tem;
856
4ee3e309
EN
857 CHECK_PROCESS (process, 0);
858 tem = XPROCESS (process)->kill_without_query;
859 XPROCESS (process)->kill_without_query = Fnull (value);
d0d6b7c5
JB
860
861 return Fnull (tem);
862}
312c9964 863
de282a05
RS
864DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
865 1, 1, 0,
866 "Return the contact info of PROCESS; t for a real child.\n\
867For a net connection, the value is a cons cell of the form (HOST SERVICE).")
868 (process)
869 register Lisp_Object process;
870{
871 CHECK_PROCESS (process, 0);
872 return XPROCESS (process)->childp;
873}
874
312c9964
RS
875#if 0 /* Turned off because we don't currently record this info
876 in the process. Perhaps add it. */
877DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
7744ca33
KH
878 "Return the connection type of PROCESS.\n\
879The value is nil for a pipe, t or `pty' for a pty, or `stream' for\n\
880a socket connection.")
312c9964
RS
881 (process)
882 Lisp_Object process;
883{
884 return XPROCESS (process)->type;
885}
886#endif
d0d6b7c5
JB
887\f
888Lisp_Object
889list_processes_1 ()
890{
891 register Lisp_Object tail, tem;
892 Lisp_Object proc, minspace, tem1;
d0d6b7c5 893 register struct Lisp_Process *p;
d0d6b7c5
JB
894 char tembuf[80];
895
22719df2 896 XSETFASTINT (minspace, 1);
d0d6b7c5
JB
897
898 set_buffer_internal (XBUFFER (Vstandard_output));
899 Fbuffer_disable_undo (Vstandard_output);
900
901 current_buffer->truncate_lines = Qt;
902
903 write_string ("\
a9fde32e
KH
904Proc Status Buffer Tty Command\n\
905---- ------ ------ --- -------\n", -1);
d0d6b7c5
JB
906
907 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
908 {
909 Lisp_Object symbol;
910
911 proc = Fcdr (Fcar (tail));
912 p = XPROCESS (proc);
913 if (NILP (p->childp))
914 continue;
915
916 Finsert (1, &p->name);
917 Findent_to (make_number (13), minspace);
918
919 if (!NILP (p->raw_status_low))
920 update_status (p);
921 symbol = p->status;
bcd69aea 922 if (CONSP (p->status))
70949dac 923 symbol = XCAR (p->status);
d0d6b7c5
JB
924
925
926 if (EQ (symbol, Qsignal))
927 {
928 Lisp_Object tem;
929 tem = Fcar (Fcdr (p->status));
930#ifdef VMS
931 if (XINT (tem) < NSIG)
b0310da4 932 write_string (sys_errlist [XINT (tem)], -1);
d0d6b7c5
JB
933 else
934#endif
935 Fprinc (symbol, Qnil);
936 }
937 else if (NETCONN_P (proc))
938 {
939 if (EQ (symbol, Qrun))
940 write_string ("open", -1);
941 else if (EQ (symbol, Qexit))
942 write_string ("closed", -1);
943 else
944 Fprinc (symbol, Qnil);
945 }
946 else
947 Fprinc (symbol, Qnil);
948
949 if (EQ (symbol, Qexit))
950 {
951 Lisp_Object tem;
952 tem = Fcar (Fcdr (p->status));
953 if (XFASTINT (tem))
954 {
3162bafa 955 sprintf (tembuf, " %d", (int) XFASTINT (tem));
d0d6b7c5
JB
956 write_string (tembuf, -1);
957 }
958 }
959
960 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
961 remove_process (proc);
962
963 Findent_to (make_number (22), minspace);
964 if (NILP (p->buffer))
965 insert_string ("(none)");
966 else if (NILP (XBUFFER (p->buffer)->name))
967 insert_string ("(Killed)");
968 else
969 Finsert (1, &XBUFFER (p->buffer)->name);
970
971 Findent_to (make_number (37), minspace);
972
a9fde32e
KH
973 if (STRINGP (p->tty_name))
974 Finsert (1, &p->tty_name);
975 else
976 insert_string ("(none)");
977
978 Findent_to (make_number (49), minspace);
979
d0d6b7c5
JB
980 if (NETCONN_P (proc))
981 {
982 sprintf (tembuf, "(network stream connection to %s)\n",
70949dac 983 XSTRING (XCAR (p->childp))->data);
d0d6b7c5
JB
984 insert_string (tembuf);
985 }
986 else
987 {
988 tem = p->command;
989 while (1)
990 {
991 tem1 = Fcar (tem);
992 Finsert (1, &tem1);
993 tem = Fcdr (tem);
994 if (NILP (tem))
995 break;
996 insert_string (" ");
997 }
998 insert_string ("\n");
999 }
1000 }
1001 return Qnil;
1002}
1003
1004DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
1005 "Display a list of all processes.\n\
7744ca33
KH
1006Any process listed as exited or signaled is actually eliminated\n\
1007after the listing is made.")
d0d6b7c5
JB
1008 ()
1009{
1010 internal_with_output_to_temp_buffer ("*Process List*",
1011 list_processes_1, Qnil);
1012 return Qnil;
1013}
1014
1015DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
1016 "Return a list of all processes.")
1017 ()
1018{
1019 return Fmapcar (Qcdr, Vprocess_alist);
1020}
1021\f
b0310da4
JB
1022/* Starting asynchronous inferior processes. */
1023
1024static Lisp_Object start_process_unwind ();
1025
d0d6b7c5
JB
1026DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
1027 "Start a program in a subprocess. Return the process object for it.\n\
d0d6b7c5
JB
1028NAME is name for process. It is modified if necessary to make it unique.\n\
1029BUFFER is the buffer or (buffer-name) to associate with the process.\n\
1030 Process output goes at end of that buffer, unless you specify\n\
1031 an output stream or filter function to handle the output.\n\
1032 BUFFER may be also nil, meaning that this process is not associated\n\
0fa1789e 1033 with any buffer.\n\
8f1ecd05 1034Third arg is program file name. It is searched for in PATH.\n\
d0d6b7c5
JB
1035Remaining arguments are strings to give program as arguments.")
1036 (nargs, args)
1037 int nargs;
1038 register Lisp_Object *args;
1039{
1e30af70 1040 Lisp_Object buffer, name, program, proc, current_dir, tem;
d0d6b7c5
JB
1041#ifdef VMS
1042 register unsigned char *new_argv;
1043 int len;
1044#else
1045 register unsigned char **new_argv;
1046#endif
1047 register int i;
b0310da4 1048 int count = specpdl_ptr - specpdl;
d0d6b7c5
JB
1049
1050 buffer = args[1];
1051 if (!NILP (buffer))
1052 buffer = Fget_buffer_create (buffer);
1053
1e30af70
JB
1054 /* Make sure that the child will be able to chdir to the current
1055 buffer's current directory, or its unhandled equivalent. We
1056 can't just have the child check for an error when it does the
1057 chdir, since it's in a vfork.
1058
1059 We have to GCPRO around this because Fexpand_file_name and
1060 Funhandled_file_name_directory might call a file name handling
1061 function. The argument list is protected by the caller, so all
1062 we really have to worry about is buffer. */
1063 {
1064 struct gcpro gcpro1, gcpro2;
1065
1066 current_dir = current_buffer->directory;
1067
1068 GCPRO2 (buffer, current_dir);
1069
7af71e17
RS
1070 current_dir
1071 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
1072 Qnil);
1e30af70
JB
1073 if (NILP (Ffile_accessible_directory_p (current_dir)))
1074 report_file_error ("Setting current directory",
1075 Fcons (current_buffer->directory, Qnil));
1076
1077 UNGCPRO;
1078 }
1079
d0d6b7c5
JB
1080 name = args[0];
1081 CHECK_STRING (name, 0);
1082
1083 program = args[2];
1084
1085 CHECK_STRING (program, 2);
1086
d0d6b7c5 1087 proc = make_process (name);
b0310da4
JB
1088 /* If an error occurs and we can't start the process, we want to
1089 remove it from the process list. This means that each error
1090 check in create_process doesn't need to call remove_process
1091 itself; it's all taken care of here. */
1092 record_unwind_protect (start_process_unwind, proc);
d0d6b7c5
JB
1093
1094 XPROCESS (proc)->childp = Qt;
1095 XPROCESS (proc)->command_channel_p = Qnil;
1096 XPROCESS (proc)->buffer = buffer;
1097 XPROCESS (proc)->sentinel = Qnil;
1098 XPROCESS (proc)->filter = Qnil;
1099 XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
1100
7af71e17
RS
1101 /* Make the process marker point into the process buffer (if any). */
1102 if (!NILP (buffer))
d8a2934e
RS
1103 set_marker_both (XPROCESS (proc)->mark, buffer,
1104 BUF_ZV (XBUFFER (buffer)),
1105 BUF_ZV_BYTE (XBUFFER (buffer)));
7af71e17 1106
67918941 1107 {
d5d4ae71
KH
1108 /* Decide coding systems for communicating with the process. Here
1109 we don't setup the structure coding_system nor pay attention to
1110 unibyte mode. They are done in create_process. */
1111
67918941
RS
1112 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1113 Lisp_Object coding_systems = Qt;
1114 Lisp_Object val, *args2;
a4a37e65 1115 struct gcpro gcpro1, gcpro2;
67918941 1116
d5d4ae71
KH
1117 val = Vcoding_system_for_read;
1118 if (NILP (val))
67918941
RS
1119 {
1120 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
1121 args2[0] = Qstart_process;
1122 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
a4a37e65 1123 GCPRO2 (proc, current_dir);
67918941
RS
1124 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1125 UNGCPRO;
1126 if (CONSP (coding_systems))
70949dac 1127 val = XCAR (coding_systems);
67918941 1128 else if (CONSP (Vdefault_process_coding_system))
70949dac 1129 val = XCAR (Vdefault_process_coding_system);
67918941
RS
1130 }
1131 XPROCESS (proc)->decode_coding_system = val;
1132
d5d4ae71
KH
1133 val = Vcoding_system_for_write;
1134 if (NILP (val))
67918941
RS
1135 {
1136 if (EQ (coding_systems, Qt))
1137 {
1138 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof args2);
1139 args2[0] = Qstart_process;
1140 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
a4a37e65 1141 GCPRO2 (proc, current_dir);
67918941
RS
1142 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1143 UNGCPRO;
1144 }
1145 if (CONSP (coding_systems))
70949dac 1146 val = XCDR (coding_systems);
67918941 1147 else if (CONSP (Vdefault_process_coding_system))
70949dac 1148 val = XCDR (Vdefault_process_coding_system);
67918941
RS
1149 }
1150 XPROCESS (proc)->encode_coding_system = val;
1151 }
0fa1789e 1152
a4a37e65
KH
1153#ifdef VMS
1154 /* Make a one member argv with all args concatenated
1155 together separated by a blank. */
1156 len = STRING_BYTES (XSTRING (program)) + 2;
1157 for (i = 3; i < nargs; i++)
1158 {
1159 tem = args[i];
1160 CHECK_STRING (tem, i);
1161 len += STRING_BYTES (XSTRING (tem)) + 1; /* count the blank */
1162 }
1163 new_argv = (unsigned char *) alloca (len);
1164 strcpy (new_argv, XSTRING (program)->data);
1165 for (i = 3; i < nargs; i++)
1166 {
1167 tem = args[i];
1168 CHECK_STRING (tem, i);
1169 strcat (new_argv, " ");
1170 strcat (new_argv, XSTRING (tem)->data);
1171 }
1172 /* Need to add code here to check for program existence on VMS */
1173
1174#else /* not VMS */
1175 new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
1176
1177 /* If program file name is not absolute, search our path for it */
1178 if (!IS_DIRECTORY_SEP (XSTRING (program)->data[0])
1179 && !(XSTRING (program)->size > 1
1180 && IS_DEVICE_SEP (XSTRING (program)->data[1])))
1181 {
1182 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1183
1184 tem = Qnil;
1185 GCPRO4 (name, program, buffer, current_dir);
1186 openp (Vexec_path, program, EXEC_SUFFIXES, &tem, 1);
1187 UNGCPRO;
1188 if (NILP (tem))
1189 report_file_error ("Searching for program", Fcons (program, Qnil));
1190 tem = Fexpand_file_name (tem, Qnil);
1191 tem = ENCODE_FILE (tem);
1192 new_argv[0] = XSTRING (tem)->data;
1193 }
1194 else
1195 {
1196 if (!NILP (Ffile_directory_p (program)))
1197 error ("Specified program for new process is a directory");
1198
1199 tem = ENCODE_FILE (program);
1200 new_argv[0] = XSTRING (tem)->data;
1201 }
1202
1203 /* Here we encode arguments by the coding system used for sending
1204 data to the process. We don't support using different coding
1205 systems for encoding arguments and for encoding data sent to the
1206 process. */
1207
1208 for (i = 3; i < nargs; i++)
1209 {
1210 tem = args[i];
1211 CHECK_STRING (tem, i);
1212 if (STRING_MULTIBYTE (tem))
1213 tem = (code_convert_string_norecord
1214 (tem, XPROCESS (proc)->encode_coding_system, 1));
1215 new_argv[i - 2] = XSTRING (tem)->data;
1216 }
1217 new_argv[i - 2] = 0;
1218#endif /* not VMS */
1219
0fa1789e 1220 XPROCESS (proc)->decoding_buf = make_uninit_string (0);
e7fbaa65 1221 XPROCESS (proc)->decoding_carryover = make_number (0);
0fa1789e 1222 XPROCESS (proc)->encoding_buf = make_uninit_string (0);
e7fbaa65 1223 XPROCESS (proc)->encoding_carryover = make_number (0);
0fa1789e 1224
52a1b894 1225 XPROCESS (proc)->inherit_coding_system_flag
aa91317a
RS
1226 = (NILP (buffer) || !inherit_process_coding_system
1227 ? Qnil : Qt);
52a1b894 1228
6b53bb85 1229 create_process (proc, (char **) new_argv, current_dir);
d0d6b7c5 1230
b0310da4 1231 return unbind_to (count, proc);
d0d6b7c5
JB
1232}
1233
b0310da4 1234/* This function is the unwind_protect form for Fstart_process. If
8e6208c5 1235 PROC doesn't have its pid set, then we know someone has signaled
b0310da4
JB
1236 an error and the process wasn't started successfully, so we should
1237 remove it from the process list. */
1238static Lisp_Object
1239start_process_unwind (proc)
1240 Lisp_Object proc;
1241{
bcd69aea 1242 if (!PROCESSP (proc))
b0310da4
JB
1243 abort ();
1244
1245 /* Was PROC started successfully? */
188d6c4e 1246 if (XINT (XPROCESS (proc)->pid) <= 0)
b0310da4
JB
1247 remove_process (proc);
1248
1249 return Qnil;
1250}
1251
30904ab7
GM
1252void
1253create_process_1 (timer)
1254 struct atimer *timer;
d0d6b7c5 1255{
30904ab7 1256 /* Nothing to do. */
d0d6b7c5
JB
1257}
1258
30904ab7 1259
d0d6b7c5
JB
1260#if 0 /* This doesn't work; see the note before sigchld_handler. */
1261#ifdef USG
1262#ifdef SIGCHLD
1263/* Mimic blocking of signals on system V, which doesn't really have it. */
1264
1265/* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1266int sigchld_deferred;
1267
1268SIGTYPE
1269create_process_sigchld ()
1270{
1271 signal (SIGCHLD, create_process_sigchld);
1272
1273 sigchld_deferred = 1;
1274}
1275#endif
1276#endif
1277#endif
1278
1279#ifndef VMS /* VMS version of this function is in vmsproc.c. */
6b53bb85 1280void
1e30af70 1281create_process (process, new_argv, current_dir)
d0d6b7c5
JB
1282 Lisp_Object process;
1283 char **new_argv;
1e30af70 1284 Lisp_Object current_dir;
d0d6b7c5 1285{
ecd1f654 1286 int pid, inchannel, outchannel;
d0d6b7c5 1287 int sv[2];
0dc70c33
KH
1288#ifdef POSIX_SIGNALS
1289 sigset_t procmask;
1290 sigset_t blocked;
1291 struct sigaction sigint_action;
1292 struct sigaction sigquit_action;
1293#ifdef AIX
1294 struct sigaction sighup_action;
1295#endif
1296#else /* !POSIX_SIGNALS */
41d03b9a 1297#if 0
d0d6b7c5
JB
1298#ifdef SIGCHLD
1299 SIGTYPE (*sigchld)();
1300#endif
41d03b9a 1301#endif /* 0 */
0dc70c33 1302#endif /* !POSIX_SIGNALS */
ecd1f654
KH
1303 /* Use volatile to protect variables from being clobbered by longjmp. */
1304 volatile int forkin, forkout;
1305 volatile int pty_flag = 0;
3ec68006 1306#ifndef USE_CRT_DLL
d0d6b7c5 1307 extern char **environ;
3ec68006 1308#endif
d5d4ae71 1309 Lisp_Object buffer = XPROCESS (process)->buffer;
d0d6b7c5 1310
d0d6b7c5
JB
1311 inchannel = outchannel = -1;
1312
1313#ifdef HAVE_PTYS
fe45da4e 1314 if (!NILP (Vprocess_connection_type))
d0d6b7c5
JB
1315 outchannel = inchannel = allocate_pty ();
1316
d0d6b7c5
JB
1317 if (inchannel >= 0)
1318 {
1319#ifndef USG
1320 /* On USG systems it does not work to open the pty's tty here
1321 and then close and reopen it in the child. */
1322#ifdef O_NOCTTY
1323 /* Don't let this terminal become our controlling terminal
1324 (in case we don't have one). */
68c45bf0 1325 forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
d0d6b7c5 1326#else
68c45bf0 1327 forkout = forkin = emacs_open (pty_name, O_RDWR, 0);
d0d6b7c5
JB
1328#endif
1329 if (forkin < 0)
1330 report_file_error ("Opening pty", Qnil);
1331#else
1332 forkin = forkout = -1;
1333#endif /* not USG */
1334 pty_flag = 1;
1335 }
1336 else
1337#endif /* HAVE_PTYS */
1338#ifdef SKTPAIR
1339 {
1340 if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
1341 report_file_error ("Opening socketpair", Qnil);
1342 outchannel = inchannel = sv[0];
1343 forkout = forkin = sv[1];
1344 }
1345#else /* not SKTPAIR */
1346 {
fc14013c
KH
1347 int tem;
1348 tem = pipe (sv);
1349 if (tem < 0)
1350 report_file_error ("Creating pipe", Qnil);
d0d6b7c5
JB
1351 inchannel = sv[0];
1352 forkout = sv[1];
fc14013c
KH
1353 tem = pipe (sv);
1354 if (tem < 0)
1355 {
68c45bf0
PE
1356 emacs_close (inchannel);
1357 emacs_close (forkout);
fc14013c
KH
1358 report_file_error ("Creating pipe", Qnil);
1359 }
d0d6b7c5
JB
1360 outchannel = sv[1];
1361 forkin = sv[0];
1362 }
1363#endif /* not SKTPAIR */
1364
1365#if 0
1366 /* Replaced by close_process_descs */
1367 set_exclusive_use (inchannel);
1368 set_exclusive_use (outchannel);
1369#endif
1370
1371/* Stride people say it's a mystery why this is needed
1372 as well as the O_NDELAY, but that it fails without this. */
1373#if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1374 {
1375 int one = 1;
1376 ioctl (inchannel, FIONBIO, &one);
1377 }
1378#endif
1379
1380#ifdef O_NONBLOCK
1381 fcntl (inchannel, F_SETFL, O_NONBLOCK);
03832893 1382 fcntl (outchannel, F_SETFL, O_NONBLOCK);
d0d6b7c5
JB
1383#else
1384#ifdef O_NDELAY
1385 fcntl (inchannel, F_SETFL, O_NDELAY);
03832893 1386 fcntl (outchannel, F_SETFL, O_NDELAY);
d0d6b7c5
JB
1387#endif
1388#endif
1389
1390 /* Record this as an active process, with its channels.
1391 As a result, child_setup will close Emacs's side of the pipes. */
1392 chan_process[inchannel] = process;
1d056e64
KH
1393 XSETINT (XPROCESS (process)->infd, inchannel);
1394 XSETINT (XPROCESS (process)->outfd, outchannel);
d0d6b7c5
JB
1395 /* Record the tty descriptor used in the subprocess. */
1396 if (forkin < 0)
1397 XPROCESS (process)->subtty = Qnil;
1398 else
22719df2 1399 XSETFASTINT (XPROCESS (process)->subtty, forkin);
d0d6b7c5
JB
1400 XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
1401 XPROCESS (process)->status = Qrun;
c7580538
KH
1402 if (!proc_decode_coding_system[inchannel])
1403 proc_decode_coding_system[inchannel]
1404 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
0fa1789e 1405 setup_coding_system (XPROCESS (process)->decode_coding_system,
c7580538
KH
1406 proc_decode_coding_system[inchannel]);
1407 if (!proc_encode_coding_system[outchannel])
929a6726
RS
1408 proc_encode_coding_system[outchannel]
1409 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
0fa1789e 1410 setup_coding_system (XPROCESS (process)->encode_coding_system,
c7580538 1411 proc_encode_coding_system[outchannel]);
d0d6b7c5
JB
1412
1413 /* Delay interrupts until we have a chance to store
1414 the new fork's pid in its process structure */
0dc70c33
KH
1415#ifdef POSIX_SIGNALS
1416 sigemptyset (&blocked);
1417#ifdef SIGCHLD
1418 sigaddset (&blocked, SIGCHLD);
1419#endif
1420#ifdef HAVE_VFORK
1421 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1422 this sets the parent's signal handlers as well as the child's.
1423 So delay all interrupts whose handlers the child might munge,
1424 and record the current handlers so they can be restored later. */
1425 sigaddset (&blocked, SIGINT ); sigaction (SIGINT , 0, &sigint_action );
1426 sigaddset (&blocked, SIGQUIT); sigaction (SIGQUIT, 0, &sigquit_action);
1427#ifdef AIX
1428 sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action );
1429#endif
1430#endif /* HAVE_VFORK */
1431 sigprocmask (SIG_BLOCK, &blocked, &procmask);
1432#else /* !POSIX_SIGNALS */
d0d6b7c5
JB
1433#ifdef SIGCHLD
1434#ifdef BSD4_1
1435 sighold (SIGCHLD);
1436#else /* not BSD4_1 */
6df54671 1437#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
d0d6b7c5
JB
1438 sigsetmask (sigmask (SIGCHLD));
1439#else /* ordinary USG */
1440#if 0
1441 sigchld_deferred = 0;
1442 sigchld = signal (SIGCHLD, create_process_sigchld);
1443#endif
1444#endif /* ordinary USG */
1445#endif /* not BSD4_1 */
1446#endif /* SIGCHLD */
0dc70c33 1447#endif /* !POSIX_SIGNALS */
d0d6b7c5 1448
3081bf8d 1449 FD_SET (inchannel, &input_wait_mask);
a69281ff 1450 FD_SET (inchannel, &non_keyboard_wait_mask);
3081bf8d
KH
1451 if (inchannel > max_process_desc)
1452 max_process_desc = inchannel;
1453
d0d6b7c5
JB
1454 /* Until we store the proper pid, enable sigchld_handler
1455 to recognize an unknown pid as standing for this process.
1456 It is very important not to let this `marker' value stay
1457 in the table after this function has returned; if it does
1458 it might cause call-process to hang and subsequent asynchronous
1459 processes to get their return values scrambled. */
1460 XSETINT (XPROCESS (process)->pid, -1);
1461
ececcbec
RS
1462 BLOCK_INPUT;
1463
d0d6b7c5
JB
1464 {
1465 /* child_setup must clobber environ on systems with true vfork.
1466 Protect it from permanent change. */
1467 char **save_environ = environ;
1468
14dc6093 1469 current_dir = ENCODE_FILE (current_dir);
a932f187 1470
e98d950b 1471#ifndef WINDOWSNT
d0d6b7c5
JB
1472 pid = vfork ();
1473 if (pid == 0)
e98d950b 1474#endif /* not WINDOWSNT */
d0d6b7c5
JB
1475 {
1476 int xforkin = forkin;
1477 int xforkout = forkout;
1478
1479#if 0 /* This was probably a mistake--it duplicates code later on,
1480 but fails to handle all the cases. */
1481 /* Make sure SIGCHLD is not blocked in the child. */
1482 sigsetmask (SIGEMPTYMASK);
1483#endif
1484
1485 /* Make the pty be the controlling terminal of the process. */
1486#ifdef HAVE_PTYS
1487 /* First, disconnect its current controlling terminal. */
1488#ifdef HAVE_SETSID
7ce48618
RS
1489 /* We tried doing setsid only if pty_flag, but it caused
1490 process_set_signal to fail on SGI when using a pipe. */
1491 setsid ();
ce4c9c90 1492 /* Make the pty's terminal the controlling terminal. */
084fd64a 1493 if (pty_flag)
39e9ebcd 1494 {
39e9ebcd
RS
1495#ifdef TIOCSCTTY
1496 /* We ignore the return value
1497 because faith@cs.unc.edu says that is necessary on Linux. */
1498 ioctl (xforkin, TIOCSCTTY, 0);
ce4c9c90 1499#endif
39e9ebcd 1500 }
d0d6b7c5 1501#else /* not HAVE_SETSID */
c14e53a4 1502#ifdef USG
000ab717 1503 /* It's very important to call setpgrp here and no time
d0d6b7c5
JB
1504 afterwards. Otherwise, we lose our controlling tty which
1505 is set when we open the pty. */
1506 setpgrp ();
1507#endif /* USG */
1508#endif /* not HAVE_SETSID */
9bcf8ec6
KH
1509#if defined (HAVE_TERMIOS) && defined (LDISC1)
1510 if (pty_flag && xforkin >= 0)
1511 {
1512 struct termios t;
1513 tcgetattr (xforkin, &t);
1514 t.c_lflag = LDISC1;
1515 if (tcsetattr (xforkin, TCSANOW, &t) < 0)
68c45bf0 1516 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
9bcf8ec6
KH
1517 }
1518#else
aafadd9f 1519#if defined (NTTYDISC) && defined (TIOCSETD)
ff773a4e 1520 if (pty_flag && xforkin >= 0)
afc549fd
RS
1521 {
1522 /* Use new line discipline. */
1523 int ldisc = NTTYDISC;
4458f555 1524 ioctl (xforkin, TIOCSETD, &ldisc);
afc549fd 1525 }
000ab717 1526#endif
9bcf8ec6 1527#endif
d0d6b7c5
JB
1528#ifdef TIOCNOTTY
1529 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1530 can do TIOCSPGRP only to the process's controlling tty. */
1531 if (pty_flag)
1532 {
1533 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1534 I can't test it since I don't have 4.3. */
68c45bf0 1535 int j = emacs_open ("/dev/tty", O_RDWR, 0);
d0d6b7c5 1536 ioctl (j, TIOCNOTTY, 0);
68c45bf0 1537 emacs_close (j);
5a570e37 1538#ifndef USG
d0d6b7c5
JB
1539 /* In order to get a controlling terminal on some versions
1540 of BSD, it is necessary to put the process in pgrp 0
1541 before it opens the terminal. */
99c1aeca 1542#ifdef HAVE_SETPGID
3ea1d291
RS
1543 setpgid (0, 0);
1544#else
d0d6b7c5 1545 setpgrp (0, 0);
3ea1d291 1546#endif
d0d6b7c5
JB
1547#endif
1548 }
1549#endif /* TIOCNOTTY */
1550
99153b9e 1551#if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
d0d6b7c5 1552/*** There is a suggestion that this ought to be a
99153b9e
RS
1553 conditional on TIOCSPGRP,
1554 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1555 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1556 that system does seem to need this code, even though
1557 both HAVE_SETSID and TIOCSCTTY are defined. */
d0d6b7c5
JB
1558 /* Now close the pty (if we had it open) and reopen it.
1559 This makes the pty the controlling terminal of the subprocess. */
1560 if (pty_flag)
1561 {
99e3d726
RS
1562#ifdef SET_CHILD_PTY_PGRP
1563 int pgrp = getpid ();
1564#endif
1565
68c45bf0
PE
1566 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1567 would work? */
d0d6b7c5 1568 if (xforkin >= 0)
68c45bf0
PE
1569 emacs_close (xforkin);
1570 xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0);
d0d6b7c5 1571
4aa54ba8
RS
1572 if (xforkin < 0)
1573 {
68c45bf0
PE
1574 emacs_write (1, "Couldn't open the pty terminal ", 31);
1575 emacs_write (1, pty_name, strlen (pty_name));
1576 emacs_write (1, "\n", 1);
4aa54ba8
RS
1577 _exit (1);
1578 }
1579
99e3d726
RS
1580#ifdef SET_CHILD_PTY_PGRP
1581 ioctl (xforkin, TIOCSPGRP, &pgrp);
1582 ioctl (xforkout, TIOCSPGRP, &pgrp);
1583#endif
d0d6b7c5 1584 }
99153b9e 1585#endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
e9bf058b 1586
d0d6b7c5 1587#ifdef SETUP_SLAVE_PTY
13a72104
RS
1588 if (pty_flag)
1589 {
1590 SETUP_SLAVE_PTY;
1591 }
d0d6b7c5
JB
1592#endif /* SETUP_SLAVE_PTY */
1593#ifdef AIX
1594 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1595 Now reenable it in the child, so it will die when we want it to. */
1596 if (pty_flag)
1597 signal (SIGHUP, SIG_DFL);
1598#endif
1599#endif /* HAVE_PTYS */
1600
0dc70c33
KH
1601 signal (SIGINT, SIG_DFL);
1602 signal (SIGQUIT, SIG_DFL);
1603
1604 /* Stop blocking signals in the child. */
1605#ifdef POSIX_SIGNALS
1606 sigprocmask (SIG_SETMASK, &procmask, 0);
1607#else /* !POSIX_SIGNALS */
d0d6b7c5
JB
1608#ifdef SIGCHLD
1609#ifdef BSD4_1
1610 sigrelse (SIGCHLD);
1611#else /* not BSD4_1 */
6df54671 1612#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
d0d6b7c5
JB
1613 sigsetmask (SIGEMPTYMASK);
1614#else /* ordinary USG */
63528b78 1615#if 0
d0d6b7c5 1616 signal (SIGCHLD, sigchld);
63528b78 1617#endif
d0d6b7c5
JB
1618#endif /* ordinary USG */
1619#endif /* not BSD4_1 */
1620#endif /* SIGCHLD */
0dc70c33 1621#endif /* !POSIX_SIGNALS */
5e7e1da2 1622
ab01d0a8
RS
1623 if (pty_flag)
1624 child_setup_tty (xforkout);
e98d950b
RS
1625#ifdef WINDOWSNT
1626 pid = child_setup (xforkin, xforkout, xforkout,
1627 new_argv, 1, current_dir);
1628#else /* not WINDOWSNT */
d0d6b7c5 1629 child_setup (xforkin, xforkout, xforkout,
e065a56e 1630 new_argv, 1, current_dir);
e98d950b 1631#endif /* not WINDOWSNT */
d0d6b7c5
JB
1632 }
1633 environ = save_environ;
1634 }
1635
ececcbec
RS
1636 UNBLOCK_INPUT;
1637
4a127b3b 1638 /* This runs in the Emacs process. */
d0d6b7c5 1639 if (pid < 0)
6311cf58
RS
1640 {
1641 if (forkin >= 0)
68c45bf0 1642 emacs_close (forkin);
6311cf58 1643 if (forkin != forkout && forkout >= 0)
68c45bf0 1644 emacs_close (forkout);
6311cf58 1645 }
4a127b3b
KH
1646 else
1647 {
1648 /* vfork succeeded. */
1649 XSETFASTINT (XPROCESS (process)->pid, pid);
d0d6b7c5 1650
e98d950b 1651#ifdef WINDOWSNT
4a127b3b 1652 register_child (pid, inchannel);
e98d950b
RS
1653#endif /* WINDOWSNT */
1654
4a127b3b
KH
1655 /* If the subfork execv fails, and it exits,
1656 this close hangs. I don't know why.
1657 So have an interrupt jar it loose. */
30904ab7
GM
1658 {
1659 struct atimer *timer;
1660 EMACS_TIME offset;
1661
1662 stop_polling ();
1663 EMACS_SET_SECS_USECS (offset, 1, 0);
1664 timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
1665
1666 XPROCESS (process)->subtty = Qnil;
1667 if (forkin >= 0)
1668 emacs_close (forkin);
1669
1670 cancel_atimer (timer);
1671 start_polling ();
1672 }
1673
4a127b3b 1674 if (forkin != forkout && forkout >= 0)
68c45bf0 1675 emacs_close (forkout);
d0d6b7c5 1676
875e6b94 1677#ifdef HAVE_PTYS
4a127b3b
KH
1678 if (pty_flag)
1679 XPROCESS (process)->tty_name = build_string (pty_name);
1680 else
875e6b94 1681#endif
4a127b3b
KH
1682 XPROCESS (process)->tty_name = Qnil;
1683 }
3b9a3dfa 1684
4a127b3b
KH
1685 /* Restore the signal state whether vfork succeeded or not.
1686 (We will signal an error, below, if it failed.) */
0dc70c33
KH
1687#ifdef POSIX_SIGNALS
1688#ifdef HAVE_VFORK
1689 /* Restore the parent's signal handlers. */
1690 sigaction (SIGINT, &sigint_action, 0);
1691 sigaction (SIGQUIT, &sigquit_action, 0);
1692#ifdef AIX
1693 sigaction (SIGHUP, &sighup_action, 0);
1694#endif
1695#endif /* HAVE_VFORK */
1696 /* Stop blocking signals in the parent. */
1697 sigprocmask (SIG_SETMASK, &procmask, 0);
1698#else /* !POSIX_SIGNALS */
d0d6b7c5
JB
1699#ifdef SIGCHLD
1700#ifdef BSD4_1
1701 sigrelse (SIGCHLD);
1702#else /* not BSD4_1 */
6df54671 1703#if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
d0d6b7c5
JB
1704 sigsetmask (SIGEMPTYMASK);
1705#else /* ordinary USG */
1706#if 0
1707 signal (SIGCHLD, sigchld);
1708 /* Now really handle any of these signals
1709 that came in during this function. */
1710 if (sigchld_deferred)
1711 kill (getpid (), SIGCHLD);
1712#endif
1713#endif /* ordinary USG */
1714#endif /* not BSD4_1 */
1715#endif /* SIGCHLD */
0dc70c33 1716#endif /* !POSIX_SIGNALS */
4a127b3b
KH
1717
1718 /* Now generate the error if vfork failed. */
1719 if (pid < 0)
1720 report_file_error ("Doing vfork", Qnil);
d0d6b7c5
JB
1721}
1722#endif /* not VMS */
1723
1724#ifdef HAVE_SOCKETS
1725
1726/* open a TCP network connection to a given HOST/SERVICE. Treated
1727 exactly like a normal process when reading and writing. Only
1728 differences are in status display and process deletion. A network
1729 connection has no PID; you cannot signal it. All you can do is
1730 deactivate and close it via delete-process */
1731
1732DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
1733 4, 4, 0,
1734 "Open a TCP connection for a service to a host.\n\
1735Returns a subprocess-object to represent the connection.\n\
1736Input and output work as for subprocesses; `delete-process' closes it.\n\
1737Args are NAME BUFFER HOST SERVICE.\n\
1738NAME is name for process. It is modified if necessary to make it unique.\n\
1739BUFFER is the buffer (or buffer-name) to associate with the process.\n\
1740 Process output goes at end of that buffer, unless you specify\n\
1741 an output stream or filter function to handle the output.\n\
1742 BUFFER may be also nil, meaning that this process is not associated\n\
1743 with any buffer\n\
1744Third arg is name of the host to connect to, or its IP address.\n\
1745Fourth arg SERVICE is name of the service desired, or an integer\n\
1746 specifying a port number to connect to.")
1747 (name, buffer, host, service)
1748 Lisp_Object name, buffer, host, service;
1749{
1750 Lisp_Object proc;
70dbdb36
GM
1751#ifdef HAVE_GETADDRINFO
1752 struct addrinfo hints, *res, *lres;
1753 int ret = 0;
1754 int xerrno = 0;
1755 char *portstring, portbuf[128];
1756#else /* HAVE_GETADDRINFO */
d0d6b7c5
JB
1757 struct sockaddr_in address;
1758 struct servent *svc_info;
1759 struct hostent *host_info_ptr, host_info;
1760 char *(addr_list[2]);
79967d5e 1761 IN_ADDR numeric_addr;
a319f7c1 1762 int port;
418b48fd
KH
1763#endif /* HAVE_GETADDRINFO */
1764 int s = -1, outch, inch;
d0d6b7c5 1765 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
e333e864 1766 int retry = 0;
44ade2e9 1767 int count = specpdl_ptr - specpdl;
5684cd6e 1768 int count1;
d0d6b7c5 1769
bff3ed0a
RS
1770#ifdef WINDOWSNT
1771 /* Ensure socket support is loaded if available. */
1772 init_winsock (TRUE);
1773#endif
1774
d0d6b7c5
JB
1775 GCPRO4 (name, buffer, host, service);
1776 CHECK_STRING (name, 0);
1777 CHECK_STRING (host, 0);
a319f7c1
KH
1778
1779#ifdef HAVE_GETADDRINFO
70dbdb36
GM
1780 /* SERVICE can either be a string or int.
1781 Convert to a C string for later use by getaddrinfo. */
a319f7c1
KH
1782 if (INTEGERP (service))
1783 {
70dbdb36 1784 sprintf (portbuf, "%ld", (long) XINT (service));
a319f7c1
KH
1785 portstring = portbuf;
1786 }
1787 else
1788 {
1789 CHECK_STRING (service, 0);
1790 portstring = XSTRING (service)->data;
1791 }
70dbdb36 1792#else /* HAVE_GETADDRINFO */
bcd69aea 1793 if (INTEGERP (service))
d0d6b7c5
JB
1794 port = htons ((unsigned short) XINT (service));
1795 else
1796 {
1797 CHECK_STRING (service, 0);
1798 svc_info = getservbyname (XSTRING (service)->data, "tcp");
1799 if (svc_info == 0)
1800 error ("Unknown service \"%s\"", XSTRING (service)->data);
1801 port = svc_info->s_port;
1802 }
70dbdb36 1803#endif /* HAVE_GETADDRINFO */
a319f7c1 1804
d0d6b7c5 1805
798b64bb
KH
1806 /* Slow down polling to every ten seconds.
1807 Some kernels have a bug which causes retrying connect to fail
1808 after a connect. Polling can interfere with gethostbyname too. */
1809#ifdef POLL_FOR_INPUT
4cf3fa08 1810 record_unwind_protect (unwind_stop_other_atimers, Qnil);
798b64bb
KH
1811 bind_polling_period (10);
1812#endif
1813
1d2c16fa 1814#ifndef TERM
a319f7c1 1815#ifdef HAVE_GETADDRINFO
70dbdb36
GM
1816 immediate_quit = 1;
1817 QUIT;
1818 memset (&hints, 0, sizeof (hints));
1819 hints.ai_flags = 0;
1820 hints.ai_family = AF_UNSPEC;
1821 hints.ai_socktype = SOCK_STREAM;
1822 hints.ai_protocol = 0;
1823 ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
1824 if (ret)
f6270f62 1825#ifdef HAVE_GAI_STRERROR
70dbdb36 1826 error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret));
f6270f62
DL
1827#else
1828 error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring,
1829 ret);
1830#endif
70dbdb36 1831 immediate_quit = 0;
a319f7c1 1832
70dbdb36 1833 /* Do this in case we never enter the for-loop below. */
5684cd6e 1834 count1 = specpdl_ptr - specpdl;
70dbdb36 1835 s = -1;
5684cd6e 1836
418b48fd 1837 for (lres = res; lres; lres = lres->ai_next)
a319f7c1
KH
1838 {
1839 s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
70dbdb36
GM
1840 if (s < 0)
1841 {
1842 xerrno = errno;
1843 continue;
1844 }
a319f7c1
KH
1845
1846 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1847 when connect is interrupted. So let's not let it get interrupted.
1848 Note we do not turn off polling, because polling is only used
1849 when not interrupt_input, and thus not normally used on the systems
1850 which have this bug. On systems which use polling, there's no way
1851 to quit if polling is turned off. */
1852 if (interrupt_input)
1853 unrequest_sigio ();
1854
70dbdb36
GM
1855 /* Make us close S if quit. */
1856 count1 = specpdl_ptr - specpdl;
1857 record_unwind_protect (close_file_unwind, make_number (s));
1858
1859 loop:
1860
a319f7c1
KH
1861 immediate_quit = 1;
1862 QUIT;
1863
b8c24556
KR
1864 /* This turns off all alarm-based interrupts; the
1865 bind_polling_period call above doesn't always turn all the
1866 short-interval ones off, especially if interrupt_input is
1867 set.
1868
1869 It'd be nice to be able to control the connect timeout
1870 though. Would non-blocking connect calls be portable? */
1871 turn_on_atimers (0);
a319f7c1 1872 ret = connect (s, lres->ai_addr, lres->ai_addrlen);
70dbdb36 1873 xerrno = errno;
b8c24556 1874 turn_on_atimers (1);
70dbdb36
GM
1875
1876 if (ret == 0 || xerrno == EISCONN)
1877 /* The unwind-protect will be discarded afterwards.
1878 Likewise for immediate_quit. */
a319f7c1 1879 break;
70dbdb36
GM
1880
1881 immediate_quit = 0;
1882
1883 if (xerrno == EINTR)
1884 goto loop;
1885 if (xerrno == EADDRINUSE && retry < 20)
1886 {
1887 /* A delay here is needed on some FreeBSD systems,
1888 and it is harmless, since this retrying takes time anyway
1889 and should be infrequent. */
1890 Fsleep_for (make_number (1), Qnil);
1891 retry++;
1892 goto loop;
1893 }
1894
1895 /* Discard the unwind protect closing S. */
1896 specpdl_ptr = specpdl + count1;
1897 count1 = specpdl_ptr - specpdl;
1898
68c45bf0 1899 emacs_close (s);
33161606 1900 s = -1;
418b48fd
KH
1901 }
1902
a319f7c1 1903 freeaddrinfo (res);
418b48fd 1904 if (s < 0)
a319f7c1
KH
1905 {
1906 if (interrupt_input)
1907 request_sigio ();
1908
1909 errno = xerrno;
1910 report_file_error ("connection failed",
1911 Fcons (host, Fcons (name, Qnil)));
1912 }
70dbdb36
GM
1913
1914#else /* not HAVE_GETADDRINFO */
a319f7c1 1915
616da37c
RS
1916 while (1)
1917 {
45f93416 1918#if 0
5f0929a7
RS
1919#ifdef TRY_AGAIN
1920 h_errno = 0;
45f93416 1921#endif
5f0929a7 1922#endif
5d6c2aa3
RS
1923 immediate_quit = 1;
1924 QUIT;
616da37c 1925 host_info_ptr = gethostbyname (XSTRING (host)->data);
5d6c2aa3 1926 immediate_quit = 0;
45f93416 1927#if 0
616da37c
RS
1928#ifdef TRY_AGAIN
1929 if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN))
45f93416 1930#endif
616da37c
RS
1931#endif
1932 break;
1933 Fsleep_for (make_number (1), Qnil);
1934 }
70dbdb36 1935
d0d6b7c5
JB
1936 if (host_info_ptr == 0)
1937 /* Attempt to interpret host as numeric inet address */
1938 {
393a9679 1939 numeric_addr = inet_addr ((char *) XSTRING (host)->data);
79967d5e 1940 if (NUMERIC_ADDR_ERROR)
d0d6b7c5
JB
1941 error ("Unknown host \"%s\"", XSTRING (host)->data);
1942
1943 host_info_ptr = &host_info;
1944 host_info.h_name = 0;
1945 host_info.h_aliases = 0;
1946 host_info.h_addrtype = AF_INET;
39a21be6
JB
1947#ifdef h_addr
1948 /* Older machines have only one address slot called h_addr.
1949 Newer machines have h_addr_list, but #define h_addr to
1950 be its first element. */
1951 host_info.h_addr_list = &(addr_list[0]);
1952#endif
1953 host_info.h_addr = (char*)(&numeric_addr);
d0d6b7c5 1954 addr_list[1] = 0;
8777fbe2
RS
1955 /* numeric_addr isn't null-terminated; it has fixed length. */
1956 host_info.h_length = sizeof (numeric_addr);
d0d6b7c5
JB
1957 }
1958
1959 bzero (&address, sizeof address);
1960 bcopy (host_info_ptr->h_addr, (char *) &address.sin_addr,
1961 host_info_ptr->h_length);
1962 address.sin_family = host_info_ptr->h_addrtype;
1963 address.sin_port = port;
1964
1965 s = socket (host_info_ptr->h_addrtype, SOCK_STREAM, 0);
1966 if (s < 0)
1967 report_file_error ("error creating socket", Fcons (name, Qnil));
1968
5684cd6e
AS
1969 count1 = specpdl_ptr - specpdl;
1970 record_unwind_protect (close_file_unwind, make_number (s));
1971
457a9bee
RS
1972 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1973 when connect is interrupted. So let's not let it get interrupted.
1974 Note we do not turn off polling, because polling is only used
1975 when not interrupt_input, and thus not normally used on the systems
1976 which have this bug. On systems which use polling, there's no way
1977 to quit if polling is turned off. */
1978 if (interrupt_input)
1979 unrequest_sigio ();
1980
d0d6b7c5 1981 loop:
0f2ee0c1
RS
1982
1983 immediate_quit = 1;
1984 QUIT;
1985
e333e864
RS
1986 if (connect (s, (struct sockaddr *) &address, sizeof address) == -1
1987 && errno != EISCONN)
d0d6b7c5
JB
1988 {
1989 int xerrno = errno;
e333e864 1990
0f2ee0c1
RS
1991 immediate_quit = 0;
1992
d0d6b7c5
JB
1993 if (errno == EINTR)
1994 goto loop;
e333e864
RS
1995 if (errno == EADDRINUSE && retry < 20)
1996 {
4590788a
RS
1997 /* A delay here is needed on some FreeBSD systems,
1998 and it is harmless, since this retrying takes time anyway
1999 and should be infrequent. */
2000 Fsleep_for (make_number (1), Qnil);
e333e864
RS
2001 retry++;
2002 goto loop;
2003 }
2004
5684cd6e
AS
2005 /* Discard the unwind protect. */
2006 specpdl_ptr = specpdl + count1;
2007
68c45bf0 2008 emacs_close (s);
457a9bee
RS
2009
2010 if (interrupt_input)
2011 request_sigio ();
2012
d0d6b7c5
JB
2013 errno = xerrno;
2014 report_file_error ("connection failed",
2015 Fcons (host, Fcons (name, Qnil)));
2016 }
70dbdb36
GM
2017
2018#endif /* not HAVE_GETADDRINFO */
457a9bee 2019
0f2ee0c1
RS
2020 immediate_quit = 0;
2021
70dbdb36 2022 /* Discard the unwind protect, if any. */
5684cd6e
AS
2023 specpdl_ptr = specpdl + count1;
2024
44ade2e9
RS
2025#ifdef POLL_FOR_INPUT
2026 unbind_to (count, Qnil);
2027#endif
2028
457a9bee
RS
2029 if (interrupt_input)
2030 request_sigio ();
2031
1d2c16fa
RS
2032#else /* TERM */
2033 s = connect_server (0);
2034 if (s < 0)
2035 report_file_error ("error creating socket", Fcons (name, Qnil));
2036 send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port));
2037 send_command (s, C_DUMB, 1, 0);
2038#endif /* TERM */
d0d6b7c5
JB
2039
2040 inch = s;
59f23005 2041 outch = s;
d0d6b7c5
JB
2042
2043 if (!NILP (buffer))
2044 buffer = Fget_buffer_create (buffer);
2045 proc = make_process (name);
2046
2047 chan_process[inch] = proc;
2048
2049#ifdef O_NONBLOCK
2050 fcntl (inch, F_SETFL, O_NONBLOCK);
2051#else
2052#ifdef O_NDELAY
2053 fcntl (inch, F_SETFL, O_NDELAY);
2054#endif
2055#endif
2056
de282a05 2057 XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));
d0d6b7c5
JB
2058 XPROCESS (proc)->command_channel_p = Qnil;
2059 XPROCESS (proc)->buffer = buffer;
2060 XPROCESS (proc)->sentinel = Qnil;
2061 XPROCESS (proc)->filter = Qnil;
2062 XPROCESS (proc)->command = Qnil;
2063 XPROCESS (proc)->pid = Qnil;
7795ff9b 2064 XSETINT (XPROCESS (proc)->infd, inch);
1d056e64 2065 XSETINT (XPROCESS (proc)->outfd, outch);
d0d6b7c5
JB
2066 XPROCESS (proc)->status = Qrun;
2067 FD_SET (inch, &input_wait_mask);
a69281ff 2068 FD_SET (inch, &non_keyboard_wait_mask);
7d0e672e
RS
2069 if (inch > max_process_desc)
2070 max_process_desc = inch;
d0d6b7c5 2071
67918941
RS
2072 {
2073 /* Setup coding systems for communicating with the network stream. */
2074 struct gcpro gcpro1;
2075 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2076 Lisp_Object coding_systems = Qt;
2077 Lisp_Object args[5], val;
2078
2079 if (!NILP (Vcoding_system_for_read))
2080 val = Vcoding_system_for_read;
41d03b9a
GM
2081 else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
2082 || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
67918941
RS
2083 /* We dare not decode end-of-line format by setting VAL to
2084 Qraw_text, because the existing Emacs Lisp libraries
2085 assume that they receive bare code including a sequene of
2086 CR LF. */
2087 val = Qnil;
2088 else
2089 {
2090 args[0] = Qopen_network_stream, args[1] = name,
2091 args[2] = buffer, args[3] = host, args[4] = service;
2092 GCPRO1 (proc);
2093 coding_systems = Ffind_operation_coding_system (5, args);
2094 UNGCPRO;
2095 if (CONSP (coding_systems))
70949dac 2096 val = XCAR (coding_systems);
67918941 2097 else if (CONSP (Vdefault_process_coding_system))
70949dac 2098 val = XCAR (Vdefault_process_coding_system);
67918941
RS
2099 else
2100 val = Qnil;
2101 }
2102 XPROCESS (proc)->decode_coding_system = val;
0fa1789e 2103
67918941
RS
2104 if (!NILP (Vcoding_system_for_write))
2105 val = Vcoding_system_for_write;
2106 else if (NILP (current_buffer->enable_multibyte_characters))
2107 val = Qnil;
2108 else
2109 {
2110 if (EQ (coding_systems, Qt))
2111 {
2112 args[0] = Qopen_network_stream, args[1] = name,
2113 args[2] = buffer, args[3] = host, args[4] = service;
2114 GCPRO1 (proc);
2115 coding_systems = Ffind_operation_coding_system (5, args);
2116 UNGCPRO;
2117 }
2118 if (CONSP (coding_systems))
70949dac 2119 val = XCDR (coding_systems);
67918941 2120 else if (CONSP (Vdefault_process_coding_system))
70949dac 2121 val = XCDR (Vdefault_process_coding_system);
67918941
RS
2122 else
2123 val = Qnil;
2124 }
2125 XPROCESS (proc)->encode_coding_system = val;
2126 }
0fa1789e 2127
c7580538
KH
2128 if (!proc_decode_coding_system[inch])
2129 proc_decode_coding_system[inch]
2130 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
0fa1789e 2131 setup_coding_system (XPROCESS (proc)->decode_coding_system,
c7580538
KH
2132 proc_decode_coding_system[inch]);
2133 if (!proc_encode_coding_system[outch])
2134 proc_encode_coding_system[outch]
2135 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
0fa1789e 2136 setup_coding_system (XPROCESS (proc)->encode_coding_system,
c7580538 2137 proc_encode_coding_system[outch]);
0fa1789e
KH
2138
2139 XPROCESS (proc)->decoding_buf = make_uninit_string (0);
e7fbaa65 2140 XPROCESS (proc)->decoding_carryover = make_number (0);
0fa1789e 2141 XPROCESS (proc)->encoding_buf = make_uninit_string (0);
e7fbaa65 2142 XPROCESS (proc)->encoding_carryover = make_number (0);
0fa1789e 2143
aa91317a
RS
2144 XPROCESS (proc)->inherit_coding_system_flag
2145 = (NILP (buffer) || !inherit_process_coding_system
2146 ? Qnil : Qt);
52a1b894 2147
d0d6b7c5
JB
2148 UNGCPRO;
2149 return proc;
2150}
2151#endif /* HAVE_SOCKETS */
2152
6b53bb85 2153void
d0d6b7c5
JB
2154deactivate_process (proc)
2155 Lisp_Object proc;
2156{
2157 register int inchannel, outchannel;
2158 register struct Lisp_Process *p = XPROCESS (proc);
2159
a9f2c884
RS
2160 inchannel = XINT (p->infd);
2161 outchannel = XINT (p->outfd);
d0d6b7c5 2162
a9f2c884 2163 if (inchannel >= 0)
d0d6b7c5
JB
2164 {
2165 /* Beware SIGCHLD hereabouts. */
2166 flush_pending_output (inchannel);
2167#ifdef VMS
2168 {
2169 VMS_PROC_STUFF *get_vms_process_pointer (), *vs;
2170 sys$dassgn (outchannel);
c6c6865d 2171 vs = get_vms_process_pointer (p->pid);
d0d6b7c5
JB
2172 if (vs)
2173 give_back_vms_process_stuff (vs);
2174 }
2175#else
68c45bf0 2176 emacs_close (inchannel);
a9f2c884 2177 if (outchannel >= 0 && outchannel != inchannel)
68c45bf0 2178 emacs_close (outchannel);
d0d6b7c5
JB
2179#endif
2180
1d056e64
KH
2181 XSETINT (p->infd, -1);
2182 XSETINT (p->outfd, -1);
d0d6b7c5
JB
2183 chan_process[inchannel] = Qnil;
2184 FD_CLR (inchannel, &input_wait_mask);
a69281ff 2185 FD_CLR (inchannel, &non_keyboard_wait_mask);
7d0e672e
RS
2186 if (inchannel == max_process_desc)
2187 {
2188 int i;
2189 /* We just closed the highest-numbered process input descriptor,
2190 so recompute the highest-numbered one now. */
2191 max_process_desc = 0;
2192 for (i = 0; i < MAXDESC; i++)
2193 if (!NILP (chan_process[i]))
2194 max_process_desc = i;
2195 }
d0d6b7c5
JB
2196 }
2197}
2198
2199/* Close all descriptors currently in use for communication
2200 with subprocess. This is used in a newly-forked subprocess
2201 to get rid of irrelevant descriptors. */
2202
6b53bb85 2203void
d0d6b7c5
JB
2204close_process_descs ()
2205{
e98d950b 2206#ifndef WINDOWSNT
d0d6b7c5
JB
2207 int i;
2208 for (i = 0; i < MAXDESC; i++)
2209 {
2210 Lisp_Object process;
2211 process = chan_process[i];
2212 if (!NILP (process))
2213 {
a9f2c884
RS
2214 int in = XINT (XPROCESS (process)->infd);
2215 int out = XINT (XPROCESS (process)->outfd);
2216 if (in >= 0)
68c45bf0 2217 emacs_close (in);
a9f2c884 2218 if (out >= 0 && in != out)
68c45bf0 2219 emacs_close (out);
d0d6b7c5
JB
2220 }
2221 }
e98d950b 2222#endif
d0d6b7c5
JB
2223}
2224\f
2225DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
2226 0, 3, 0,
2227 "Allow any pending output from subprocesses to be read by Emacs.\n\
2228It is read into the process' buffers or given to their filter functions.\n\
2229Non-nil arg PROCESS means do not return until some output has been received\n\
2230from PROCESS.\n\
2231Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\
2232seconds and microseconds to wait; return after that much time whether\n\
2233or not there is input.\n\
2234Return non-nil iff we received any output before the timeout expired.")
4ee3e309
EN
2235 (process, timeout, timeout_msecs)
2236 register Lisp_Object process, timeout, timeout_msecs;
d0d6b7c5
JB
2237{
2238 int seconds;
2239 int useconds;
2240
0748d150
RS
2241 if (! NILP (process))
2242 CHECK_PROCESS (process, 0);
2243
d0d6b7c5
JB
2244 if (! NILP (timeout_msecs))
2245 {
2246 CHECK_NUMBER (timeout_msecs, 2);
2247 useconds = XINT (timeout_msecs);
bcd69aea 2248 if (!INTEGERP (timeout))
1d056e64 2249 XSETINT (timeout, 0);
d0d6b7c5
JB
2250
2251 {
2252 int carry = useconds / 1000000;
2253
2254 XSETINT (timeout, XINT (timeout) + carry);
2255 useconds -= carry * 1000000;
2256
2257 /* I think this clause is necessary because C doesn't
2258 guarantee a particular rounding direction for negative
2259 integers. */
2260 if (useconds < 0)
2261 {
2262 XSETINT (timeout, XINT (timeout) - 1);
2263 useconds += 1000000;
2264 }
2265 }
2266 }
de946e5a
RS
2267 else
2268 useconds = 0;
d0d6b7c5
JB
2269
2270 if (! NILP (timeout))
2271 {
2272 CHECK_NUMBER (timeout, 1);
2273 seconds = XINT (timeout);
ada9a4fd 2274 if (seconds < 0 || (seconds == 0 && useconds == 0))
d0d6b7c5
JB
2275 seconds = -1;
2276 }
2277 else
2278 {
4ee3e309 2279 if (NILP (process))
d0d6b7c5
JB
2280 seconds = -1;
2281 else
2282 seconds = 0;
2283 }
2284
4ee3e309
EN
2285 if (NILP (process))
2286 XSETFASTINT (process, 0);
f76475ad 2287
d0d6b7c5 2288 return
4ee3e309 2289 (wait_reading_process_input (seconds, useconds, process, 0)
d0d6b7c5
JB
2290 ? Qt : Qnil);
2291}
2292
2293/* This variable is different from waiting_for_input in keyboard.c.
2294 It is used to communicate to a lisp process-filter/sentinel (via the
2295 function Fwaiting_for_user_input_p below) whether emacs was waiting
2296 for user-input when that process-filter was called.
2297 waiting_for_input cannot be used as that is by definition 0 when
d430ee71
RS
2298 lisp code is being evalled.
2299 This is also used in record_asynch_buffer_change.
2300 For that purpose, this must be 0
2301 when not inside wait_reading_process_input. */
d0d6b7c5
JB
2302static int waiting_for_user_input_p;
2303
c573ae8e 2304/* This is here so breakpoints can be put on it. */
dfcf069d 2305static void
c573ae8e
RS
2306wait_reading_process_input_1 ()
2307{
2308}
2309
d0d6b7c5
JB
2310/* Read and dispose of subprocess output while waiting for timeout to
2311 elapse and/or keyboard input to be available.
2312
de6fd4b9 2313 TIME_LIMIT is:
d0d6b7c5
JB
2314 timeout in seconds, or
2315 zero for no limit, or
2316 -1 means gobble data immediately available but don't wait for any.
2317
de6fd4b9
RS
2318 MICROSECS is:
2319 an additional duration to wait, measured in microseconds.
2320 If this is nonzero and time_limit is 0, then the timeout
2321 consists of MICROSECS only.
6e4f3667 2322
de6fd4b9 2323 READ_KBD is a lisp value:
d0d6b7c5
JB
2324 0 to ignore keyboard input, or
2325 1 to return when input is available, or
84aa3ace 2326 -1 meaning caller will actually read the input, so don't throw to
d0d6b7c5 2327 the quit handler, or
e6194ffc 2328 a cons cell, meaning wait until its car is non-nil
de6fd4b9 2329 (and gobble terminal input into the buffer if any arrives), or
f76475ad
JB
2330 a process object, meaning wait until something arrives from that
2331 process. The return value is true iff we read some input from
2332 that process.
d0d6b7c5 2333
de6fd4b9 2334 DO_DISPLAY != 0 means redisplay should be done to show subprocess
d0d6b7c5
JB
2335 output that arrives.
2336
de6fd4b9 2337 If READ_KBD is a pointer to a struct Lisp_Process, then the
d0d6b7c5
JB
2338 function returns true iff we received input from that process
2339 before the timeout elapsed.
eb8c3be9 2340 Otherwise, return true iff we received input from any process. */
d0d6b7c5 2341
dfcf069d 2342int
d0d6b7c5 2343wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
f76475ad
JB
2344 int time_limit, microsecs;
2345 Lisp_Object read_kbd;
2346 int do_display;
d0d6b7c5 2347{
41d03b9a 2348 register int channel, nfds;
d0d6b7c5
JB
2349 static SELECT_TYPE Available;
2350 int xerrno;
2351 Lisp_Object proc;
41d03b9a 2352 EMACS_TIME timeout, end_time;
d0d6b7c5 2353 SELECT_TYPE Atemp;
a9f2c884 2354 int wait_channel = -1;
d0d6b7c5
JB
2355 struct Lisp_Process *wait_proc = 0;
2356 int got_some_input = 0;
84aa3ace 2357 Lisp_Object *wait_for_cell = 0;
d0d6b7c5
JB
2358
2359 FD_ZERO (&Available);
2360
f76475ad
JB
2361 /* If read_kbd is a process to watch, set wait_proc and wait_channel
2362 accordingly. */
bcd69aea 2363 if (PROCESSP (read_kbd))
d0d6b7c5 2364 {
f76475ad 2365 wait_proc = XPROCESS (read_kbd);
a9f2c884 2366 wait_channel = XINT (wait_proc->infd);
22719df2 2367 XSETFASTINT (read_kbd, 0);
d0d6b7c5
JB
2368 }
2369
84aa3ace 2370 /* If waiting for non-nil in a cell, record where. */
bcd69aea 2371 if (CONSP (read_kbd))
84aa3ace 2372 {
70949dac 2373 wait_for_cell = &XCAR (read_kbd);
22719df2 2374 XSETFASTINT (read_kbd, 0);
84aa3ace
RS
2375 }
2376
f76475ad 2377 waiting_for_user_input_p = XINT (read_kbd);
d0d6b7c5
JB
2378
2379 /* Since we may need to wait several times,
2380 compute the absolute time to return at. */
2381 if (time_limit || microsecs)
2382 {
2383 EMACS_GET_TIME (end_time);
2384 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
2385 EMACS_ADD_TIME (end_time, end_time, timeout);
2386 }
e07d5449
KH
2387#ifdef hpux
2388 /* AlainF 5-Jul-1996
2389 HP-UX 10.10 seem to have problems with signals coming in
2390 Causes "poll: interrupted system call" messages when Emacs is run
2391 in an X window
2392 Turn off periodic alarms (in case they are in use) */
30904ab7 2393 turn_on_atimers (0);
e07d5449 2394#endif
d0d6b7c5 2395
d0d6b7c5
JB
2396 while (1)
2397 {
c0239a0b
RS
2398 int timeout_reduced_for_timers = 0;
2399
d0d6b7c5
JB
2400 /* If calling from keyboard input, do not quit
2401 since we want to return C-g as an input character.
2402 Otherwise, do pending quit if requested. */
f76475ad 2403 if (XINT (read_kbd) >= 0)
d0d6b7c5
JB
2404 QUIT;
2405
889255b4
RS
2406 /* Exit now if the cell we're waiting for became non-nil. */
2407 if (wait_for_cell && ! NILP (*wait_for_cell))
2408 break;
2409
d0d6b7c5
JB
2410 /* Compute time from now till when time limit is up */
2411 /* Exit if already run out */
2412 if (time_limit == -1)
2413 {
2414 /* -1 specified for timeout means
2415 gobble output available now
2416 but don't wait at all. */
2417
2418 EMACS_SET_SECS_USECS (timeout, 0, 0);
2419 }
2420 else if (time_limit || microsecs)
2421 {
2422 EMACS_GET_TIME (timeout);
2423 EMACS_SUB_TIME (timeout, end_time, timeout);
2424 if (EMACS_TIME_NEG_P (timeout))
2425 break;
2426 }
2427 else
2428 {
2429 EMACS_SET_SECS_USECS (timeout, 100000, 0);
2430 }
2431
f854a00b
RS
2432 /* Normally we run timers here.
2433 But not if wait_for_cell; in those cases,
2434 the wait is supposed to be short,
2435 and those callers cannot handle running arbitrary Lisp code here. */
2436 if (! wait_for_cell)
fb4c3627 2437 {
c0239a0b 2438 EMACS_TIME timer_delay;
c573ae8e 2439
9baacf76 2440 do
c573ae8e 2441 {
9baacf76
GM
2442 int old_timers_run = timers_run;
2443 timer_delay = timer_check (1);
2444 if (timers_run != old_timers_run && do_display)
2445 /* We must retry, since a timer may have requeued itself
2446 and that could alter the time_delay. */
3007ebfb 2447 redisplay_preserve_echo_area (9);
9baacf76
GM
2448 else
2449 break;
c573ae8e 2450 }
9baacf76 2451 while (!detect_input_pending ());
c573ae8e 2452
69645afc
RS
2453 /* If there is unread keyboard input, also return. */
2454 if (XINT (read_kbd) != 0
2455 && requeued_events_pending_p ())
2456 break;
2457
c0239a0b 2458 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
fb4c3627
RS
2459 {
2460 EMACS_TIME difference;
2461 EMACS_SUB_TIME (difference, timer_delay, timeout);
2462 if (EMACS_TIME_NEG_P (difference))
c0239a0b
RS
2463 {
2464 timeout = timer_delay;
2465 timeout_reduced_for_timers = 1;
2466 }
fb4c3627 2467 }
4abca5e7
RS
2468 /* If time_limit is -1, we are not going to wait at all. */
2469 else if (time_limit != -1)
c573ae8e
RS
2470 {
2471 /* This is so a breakpoint can be put here. */
2472 wait_reading_process_input_1 ();
2473 }
fb4c3627
RS
2474 }
2475
90ab1a81
JB
2476 /* Cause C-g and alarm signals to take immediate action,
2477 and cause input available signals to zero out timeout.
2478
2479 It is important that we do this before checking for process
2480 activity. If we get a SIGCHLD after the explicit checks for
2481 process activity, timeout is the only way we will know. */
2482 if (XINT (read_kbd) < 0)
2483 set_waiting_for_input (&timeout);
2484
6be429b1
JB
2485 /* If status of something has changed, and no input is
2486 available, notify the user of the change right away. After
2487 this explicit check, we'll let the SIGCHLD handler zap
2488 timeout to get our attention. */
2489 if (update_tick != process_tick && do_display)
2490 {
2491 Atemp = input_wait_mask;
2492 EMACS_SET_SECS_USECS (timeout, 0, 0);
0c9960e9
RS
2493 if ((select (max (max_process_desc, max_keyboard_desc) + 1,
2494 &Atemp, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
ecd1f654
KH
2495 &timeout)
2496 <= 0))
90ab1a81
JB
2497 {
2498 /* It's okay for us to do this and then continue with
a0e4d3f3 2499 the loop, since timeout has already been zeroed out. */
90ab1a81
JB
2500 clear_waiting_for_input ();
2501 status_notify ();
2502 }
6be429b1
JB
2503 }
2504
2505 /* Don't wait for output from a non-running process. */
2506 if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
2507 update_status (wait_proc);
2508 if (wait_proc != 0
2509 && ! EQ (wait_proc->status, Qrun))
9aa2a7f4 2510 {
215b45e9 2511 int nread, total_nread = 0;
7ce63188 2512
9aa2a7f4 2513 clear_waiting_for_input ();
7ce63188
RS
2514 XSETPROCESS (proc, wait_proc);
2515
2516 /* Read data from the process, until we exhaust it. */
e1b37c34 2517 while (XINT (wait_proc->infd) >= 0)
215b45e9 2518 {
e1b37c34
GM
2519 nread = read_process_output (proc, XINT (wait_proc->infd));
2520
2521 if (nread == 0)
2522 break;
2523
215b45e9
RS
2524 if (0 < nread)
2525 total_nread += nread;
2526#ifdef EIO
2527 else if (nread == -1 && EIO == errno)
2528 break;
e1b37c34
GM
2529#endif
2530#ifdef EAGAIN
2531 else if (nread == -1 && EAGAIN == errno)
2532 break;
2533#endif
2534#ifdef EWOULDBLOCK
2535 else if (nread == -1 && EWOULDBLOCK == errno)
2536 break;
215b45e9
RS
2537#endif
2538 }
7ce63188 2539 if (total_nread > 0 && do_display)
3007ebfb 2540 redisplay_preserve_echo_area (10);
7ce63188 2541
9aa2a7f4
JB
2542 break;
2543 }
6be429b1 2544
d0d6b7c5
JB
2545 /* Wait till there is something to do */
2546
b5dc1c83
RS
2547 if (wait_for_cell)
2548 Available = non_process_wait_mask;
2549 else if (! XINT (read_kbd))
a69281ff
RS
2550 Available = non_keyboard_wait_mask;
2551 else
2552 Available = input_wait_mask;
d0d6b7c5 2553
ff11dfa1 2554 /* If frame size has changed or the window is newly mapped,
ffd56f97
JB
2555 redisplay now, before we start to wait. There is a race
2556 condition here; if a SIGIO arrives between now and the select
016899c0
JB
2557 and indicates that a frame is trashed, the select may block
2558 displaying a trashed screen. */
5164ee8e 2559 if (frame_garbaged && do_display)
7286affd
RS
2560 {
2561 clear_waiting_for_input ();
3007ebfb 2562 redisplay_preserve_echo_area (11);
7286affd 2563 if (XINT (read_kbd) < 0)
7efe788e 2564 set_waiting_for_input (&timeout);
7286affd 2565 }
ffd56f97 2566
0a65b032
RS
2567 if (XINT (read_kbd) && detect_input_pending ())
2568 {
2569 nfds = 0;
2570 FD_ZERO (&Available);
2571 }
2572 else
0c9960e9
RS
2573 nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
2574 &Available, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
0a65b032 2575 &timeout);
6720a7fb 2576
d0d6b7c5
JB
2577 xerrno = errno;
2578
2579 /* Make C-g and alarm signals set flags again */
2580 clear_waiting_for_input ();
2581
2582 /* If we woke up due to SIGWINCH, actually change size now. */
2b653806 2583 do_pending_window_change (0);
d0d6b7c5 2584
c0239a0b
RS
2585 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
2586 /* We wanted the full specified time, so return now. */
d0d6b7c5
JB
2587 break;
2588 if (nfds < 0)
2589 {
2590 if (xerrno == EINTR)
2591 FD_ZERO (&Available);
b0310da4
JB
2592#ifdef ultrix
2593 /* Ultrix select seems to return ENOMEM when it is
2594 interrupted. Treat it just like EINTR. Bleah. Note
2595 that we want to test for the "ultrix" CPP symbol, not
2596 "__ultrix__"; the latter is only defined under GCC, but
2597 not by DEC's bundled CC. -JimB */
8058415c
JB
2598 else if (xerrno == ENOMEM)
2599 FD_ZERO (&Available);
2600#endif
d0d6b7c5
JB
2601#ifdef ALLIANT
2602 /* This happens for no known reason on ALLIANT.
2603 I am guessing that this is the right response. -- RMS. */
2604 else if (xerrno == EFAULT)
2605 FD_ZERO (&Available);
2606#endif
2607 else if (xerrno == EBADF)
2608 {
2609#ifdef AIX
2610 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
2611 the child's closure of the pts gives the parent a SIGHUP, and
2612 the ptc file descriptor is automatically closed,
2613 yielding EBADF here or at select() call above.
2614 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
a0e4d3f3 2615 in m/ibmrt-aix.h), and here we just ignore the select error.
d0d6b7c5 2616 Cleanup occurs c/o status_notify after SIGCLD. */
ffd56f97 2617 FD_ZERO (&Available); /* Cannot depend on values returned */
d0d6b7c5
JB
2618#else
2619 abort ();
2620#endif
2621 }
2622 else
68c45bf0 2623 error ("select error: %s", emacs_strerror (xerrno));
d0d6b7c5 2624 }
26ec91de 2625#if defined(sun) && !defined(USG5_4)
a69281ff 2626 else if (nfds > 0 && keyboard_bit_set (&Available)
dd2281ae 2627 && interrupt_input)
e0109153
JB
2628 /* System sometimes fails to deliver SIGIO.
2629
2630 David J. Mackenzie says that Emacs doesn't compile under
2631 Solaris if this code is enabled, thus the USG5_4 in the CPP
2632 conditional. "I haven't noticed any ill effects so far.
2633 If you find a Solaris expert somewhere, they might know
2634 better." */
d0d6b7c5
JB
2635 kill (getpid (), SIGIO);
2636#endif
2637
5d5beb62
RS
2638#if 0 /* When polling is used, interrupt_input is 0,
2639 so get_input_pending should read the input.
2640 So this should not be needed. */
2641 /* If we are using polling for input,
2642 and we see input available, make it get read now.
2643 Otherwise it might not actually get read for a second.
2644 And on hpux, since we turn off polling in wait_reading_process_input,
2645 it might never get read at all if we don't spend much time
2646 outside of wait_reading_process_input. */
2647 if (XINT (read_kbd) && interrupt_input
2648 && keyboard_bit_set (&Available)
2649 && input_polling_used ())
2650 kill (getpid (), SIGALRM);
2651#endif
2652
d0d6b7c5
JB
2653 /* Check for keyboard input */
2654 /* If there is any, return immediately
2655 to give it higher priority than subprocesses */
2656
77e1b3d4 2657 if (XINT (read_kbd) != 0
5d6c2aa3 2658 && detect_input_pending_run_timers (do_display))
6ed6233b
KH
2659 {
2660 swallow_events (do_display);
5d6c2aa3 2661 if (detect_input_pending_run_timers (do_display))
6ed6233b
KH
2662 break;
2663 }
2664
69645afc
RS
2665 /* If there is unread keyboard input, also return. */
2666 if (XINT (read_kbd) != 0
2667 && requeued_events_pending_p ())
2668 break;
2669
77e1b3d4
RS
2670 /* If we are not checking for keyboard input now,
2671 do process events (but don't run any timers).
2672 This is so that X events will be processed.
0c9960e9 2673 Otherwise they may have to wait until polling takes place.
77e1b3d4
RS
2674 That would causes delays in pasting selections, for example.
2675
2676 (We used to do this only if wait_for_cell.) */
2677 if (XINT (read_kbd) == 0 && detect_input_pending ())
f854a00b
RS
2678 {
2679 swallow_events (do_display);
0c9960e9 2680#if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
f854a00b
RS
2681 if (detect_input_pending ())
2682 break;
5d5beb62 2683#endif
0c9960e9 2684 }
f854a00b 2685
84aa3ace
RS
2686 /* Exit now if the cell we're waiting for became non-nil. */
2687 if (wait_for_cell && ! NILP (*wait_for_cell))
2688 break;
2689
4746118a 2690#ifdef SIGIO
5d5beb62 2691 /* If we think we have keyboard input waiting, but didn't get SIGIO,
d0d6b7c5
JB
2692 go read it. This can happen with X on BSD after logging out.
2693 In that case, there really is no input and no SIGIO,
2694 but select says there is input. */
2695
dd2281ae 2696 if (XINT (read_kbd) && interrupt_input
5d5beb62 2697 && keyboard_bit_set (&Available))
e643c5be 2698 kill (getpid (), SIGIO);
4746118a 2699#endif
d0d6b7c5 2700
d0d6b7c5
JB
2701 if (! wait_proc)
2702 got_some_input |= nfds > 0;
2703
32676c08
JB
2704 /* If checking input just got us a size-change event from X,
2705 obey it now if we should. */
97f3b3d6 2706 if (XINT (read_kbd) || wait_for_cell)
2b653806 2707 do_pending_window_change (0);
32676c08 2708
a9f2c884
RS
2709 /* Check for data from a process. */
2710 /* Really FIRST_PROC_DESC should be 0 on Unix,
2711 but this is safer in the short run. */
a69281ff 2712 for (channel = 0; channel <= max_process_desc; channel++)
d0d6b7c5 2713 {
a69281ff
RS
2714 if (FD_ISSET (channel, &Available)
2715 && FD_ISSET (channel, &non_keyboard_wait_mask))
d0d6b7c5
JB
2716 {
2717 int nread;
2718
2719 /* If waiting for this channel, arrange to return as
2720 soon as no more input to be processed. No more
2721 waiting. */
2722 if (wait_channel == channel)
2723 {
a9f2c884 2724 wait_channel = -1;
d0d6b7c5
JB
2725 time_limit = -1;
2726 got_some_input = 1;
2727 }
2728 proc = chan_process[channel];
2729 if (NILP (proc))
2730 continue;
2731
d0d6b7c5
JB
2732 /* Read data from the process, starting with our
2733 buffered-ahead character if we have one. */
2734
2735 nread = read_process_output (proc, channel);
2736 if (nread > 0)
2737 {
2738 /* Since read_process_output can run a filter,
2739 which can call accept-process-output,
2740 don't try to read from any other processes
2741 before doing the select again. */
2742 FD_ZERO (&Available);
2743
2744 if (do_display)
3007ebfb 2745 redisplay_preserve_echo_area (12);
d0d6b7c5
JB
2746 }
2747#ifdef EWOULDBLOCK
2748 else if (nread == -1 && errno == EWOULDBLOCK)
2749 ;
0b75e9a4 2750#endif
89d7280d
RS
2751 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
2752 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
d0d6b7c5
JB
2753#ifdef O_NONBLOCK
2754 else if (nread == -1 && errno == EAGAIN)
2755 ;
2756#else
2757#ifdef O_NDELAY
2758 else if (nread == -1 && errno == EAGAIN)
2759 ;
2760 /* Note that we cannot distinguish between no input
2761 available now and a closed pipe.
2762 With luck, a closed pipe will be accompanied by
2763 subprocess termination and SIGCHLD. */
2764 else if (nread == 0 && !NETCONN_P (proc))
2765 ;
ffd56f97
JB
2766#endif /* O_NDELAY */
2767#endif /* O_NONBLOCK */
d0d6b7c5
JB
2768#ifdef HAVE_PTYS
2769 /* On some OSs with ptys, when the process on one end of
2770 a pty exits, the other end gets an error reading with
2771 errno = EIO instead of getting an EOF (0 bytes read).
2772 Therefore, if we get an error reading and errno =
2773 EIO, just continue, because the child process has
2774 exited and should clean itself up soon (e.g. when we
5651af6d
RS
2775 get a SIGCHLD).
2776
2777 However, it has been known to happen that the SIGCHLD
2778 got lost. So raise the signl again just in case.
2779 It can't hurt. */
d0d6b7c5 2780 else if (nread == -1 && errno == EIO)
5651af6d 2781 kill (getpid (), SIGCHLD);
ffd56f97
JB
2782#endif /* HAVE_PTYS */
2783 /* If we can detect process termination, don't consider the process
2784 gone just because its pipe is closed. */
d0d6b7c5
JB
2785#ifdef SIGCHLD
2786 else if (nread == 0 && !NETCONN_P (proc))
2787 ;
2788#endif
2789 else
2790 {
2791 /* Preserve status of processes already terminated. */
2792 XSETINT (XPROCESS (proc)->tick, ++process_tick);
2793 deactivate_process (proc);
2794 if (!NILP (XPROCESS (proc)->raw_status_low))
2795 update_status (XPROCESS (proc));
2796 if (EQ (XPROCESS (proc)->status, Qrun))
2797 XPROCESS (proc)->status
2798 = Fcons (Qexit, Fcons (make_number (256), Qnil));
2799 }
2800 }
ffd56f97
JB
2801 } /* end for each file descriptor */
2802 } /* end while exit conditions not met */
d0d6b7c5 2803
d430ee71
RS
2804 waiting_for_user_input_p = 0;
2805
ffd56f97
JB
2806 /* If calling from keyboard input, do not quit
2807 since we want to return C-g as an input character.
2808 Otherwise, do pending quit if requested. */
f76475ad 2809 if (XINT (read_kbd) >= 0)
ffd56f97
JB
2810 {
2811 /* Prevent input_pending from remaining set if we quit. */
2812 clear_input_pending ();
2813 QUIT;
2814 }
e07d5449
KH
2815#ifdef hpux
2816 /* AlainF 5-Jul-1996
2817 HP-UX 10.10 seems to have problems with signals coming in
2818 Causes "poll: interrupted system call" messages when Emacs is run
2819 in an X window
2820 Turn periodic alarms back on */
5d5beb62 2821 start_polling ();
e07d5449 2822#endif
efa2a55c 2823
d0d6b7c5
JB
2824 return got_some_input;
2825}
2826\f
3b9a3dfa
RS
2827/* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
2828
2829static Lisp_Object
2830read_process_output_call (fun_and_args)
2831 Lisp_Object fun_and_args;
2832{
70949dac 2833 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
3b9a3dfa
RS
2834}
2835
2836static Lisp_Object
2837read_process_output_error_handler (error)
2838 Lisp_Object error;
2839{
2840 cmd_error_internal (error, "error in process filter: ");
2841 Vinhibit_quit = Qt;
2842 update_echo_area ();
833ba342 2843 Fsleep_for (make_number (2), Qnil);
8c983bf2 2844 return Qt;
3b9a3dfa
RS
2845}
2846
d0d6b7c5
JB
2847/* Read pending output from the process channel,
2848 starting with our buffered-ahead character if we have one.
0fa1789e 2849 Yield number of decoded characters read.
d0d6b7c5
JB
2850
2851 This function reads at most 1024 characters.
2852 If you want to read all available subprocess output,
0fa1789e
KH
2853 you must call it repeatedly until it returns zero.
2854
2855 The characters read are decoded according to PROC's coding-system
2856 for decoding. */
d0d6b7c5 2857
dfcf069d 2858int
d0d6b7c5
JB
2859read_process_output (proc, channel)
2860 Lisp_Object proc;
2861 register int channel;
2862{
1d2fc612 2863 register int nchars, nbytes;
d0d6b7c5 2864 char *chars;
d0d6b7c5
JB
2865 register Lisp_Object outstream;
2866 register struct buffer *old = current_buffer;
2867 register struct Lisp_Process *p = XPROCESS (proc);
2868 register int opoint;
c7580538 2869 struct coding_system *coding = proc_decode_coding_system[channel];
e7fbaa65 2870 int carryover = XINT (p->decoding_carryover);
d0d6b7c5
JB
2871
2872#ifdef VMS
2873 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
2874
2875 vs = get_vms_process_pointer (p->pid);
2876 if (vs)
2877 {
2878 if (!vs->iosb[0])
a319f7c1 2879 return (0); /* Really weird if it does this */
d0d6b7c5
JB
2880 if (!(vs->iosb[0] & 1))
2881 return -1; /* I/O error */
2882 }
2883 else
2884 error ("Could not get VMS process pointer");
2885 chars = vs->inputBuffer;
1d2fc612
RS
2886 nbytes = clean_vms_buffer (chars, vs->iosb[1]);
2887 if (nbytes <= 0)
d0d6b7c5
JB
2888 {
2889 start_vms_process_read (vs); /* Crank up the next read on the process */
2890 return 1; /* Nothing worth printing, say we got 1 */
2891 }
e7fbaa65 2892 if (carryover > 0)
0fa1789e 2893 {
e7fbaa65
KH
2894 /* The data carried over in the previous decoding (which are at
2895 the tail of decoding buffer) should be prepended to the new
2896 data read to decode all together. */
ed7a4b2d
KH
2897 chars = (char *) alloca (nbytes + carryover);
2898 bcopy (XSTRING (p->decoding_buf)->data, buf, carryover);
2899 bcopy (vs->inputBuffer, chars + carryover, nbytes);
0fa1789e 2900 }
d0d6b7c5 2901#else /* not VMS */
ed7a4b2d 2902 chars = (char *) alloca (carryover + 1024);
e7fbaa65
KH
2903 if (carryover)
2904 /* See the comment above. */
ed7a4b2d 2905 bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
0fa1789e 2906
d0d6b7c5 2907 if (proc_buffered_char[channel] < 0)
ed7a4b2d 2908 nbytes = emacs_read (channel, chars + carryover, 1024 - carryover);
d0d6b7c5
JB
2909 else
2910 {
ed7a4b2d 2911 chars[carryover] = proc_buffered_char[channel];
d0d6b7c5 2912 proc_buffered_char[channel] = -1;
ed7a4b2d 2913 nbytes = emacs_read (channel, chars + carryover + 1, 1023 - carryover);
1d2fc612
RS
2914 if (nbytes < 0)
2915 nbytes = 1;
d0d6b7c5 2916 else
1d2fc612 2917 nbytes = nbytes + 1;
d0d6b7c5
JB
2918 }
2919#endif /* not VMS */
2920
ca65341e
KH
2921 XSETINT (p->decoding_carryover, 0);
2922
ed7a4b2d 2923 /* At this point, NBYTES holds number of bytes just received
0fa1789e 2924 (including the one in proc_buffered_char[channel]). */
de7fbd09
KH
2925 if (nbytes <= 0)
2926 {
2927 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
2928 return nbytes;
2929 coding->mode |= CODING_MODE_LAST_BLOCK;
2930 }
d0d6b7c5 2931
1d2fc612 2932 /* Now set NBYTES how many bytes we must decode. */
e7fbaa65 2933 nbytes += carryover;
0fa1789e 2934
1d2fc612 2935 /* Read and dispose of the process output. */
d0d6b7c5
JB
2936 outstream = p->filter;
2937 if (!NILP (outstream))
2938 {
2939 /* We inhibit quit here instead of just catching it so that
2940 hitting ^G when a filter happens to be running won't screw
2941 it up. */
2942 int count = specpdl_ptr - specpdl;
30c78175 2943 Lisp_Object odeactivate;
dfc21838 2944 Lisp_Object obuffer, okeymap;
1d2fc612 2945 Lisp_Object text;
4da2f5be 2946 int outer_running_asynch_code = running_asynch_code;
bbce7d72 2947 int waiting = waiting_for_user_input_p;
30c78175 2948
dfc21838
RS
2949 /* No need to gcpro these, because all we do with them later
2950 is test them for EQness, and none of them should be a string. */
30c78175 2951 odeactivate = Vdeactivate_mark;
dfc21838
RS
2952 XSETBUFFER (obuffer, current_buffer);
2953 okeymap = current_buffer->keymap;
30c78175 2954
d0d6b7c5 2955 specbind (Qinhibit_quit, Qt);
6545aada 2956 specbind (Qlast_nonmenu_event, Qt);
3b9a3dfa 2957
4da2f5be
RS
2958 /* In case we get recursively called,
2959 and we already saved the match data nonrecursively,
2960 save the same match data in safely recursive fashion. */
2961 if (outer_running_asynch_code)
2962 {
2963 Lisp_Object tem;
2964 /* Don't clobber the CURRENT match data, either! */
dd130227 2965 tem = Fmatch_data (Qnil, Qnil);
4da2f5be 2966 restore_match_data ();
8f1ecd05
RS
2967 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
2968 Fset_match_data (tem);
4da2f5be
RS
2969 }
2970
2971 /* For speed, if a search happens within this code,
2972 save the match data in a special nonrecursive fashion. */
7074fde6 2973 running_asynch_code = 1;
4da2f5be 2974
ed7a4b2d
KH
2975 text = decode_coding_string (make_unibyte_string (chars, nbytes),
2976 coding, 0);
278bfdd6
KH
2977 if (NILP (buffer_defaults.enable_multibyte_characters))
2978 /* We had better return unibyte string. */
2979 text = string_make_unibyte (text);
2980
082a1df2 2981 Vlast_coding_system_used = coding->symbol;
ed7a4b2d
KH
2982 /* A new coding system might be found. */
2983 if (!EQ (p->decode_coding_system, coding->symbol))
2984 {
2985 p->decode_coding_system = coding->symbol;
2986
2987 /* Don't call setup_coding_system for
2988 proc_decode_coding_system[channel] here. It is done in
2989 detect_coding called via decode_coding above. */
2990
2991 /* If a coding system for encoding is not yet decided, we set
2992 it as the same as coding-system for decoding.
2993
2994 But, before doing that we must check if
2995 proc_encode_coding_system[p->outfd] surely points to a
2996 valid memory because p->outfd will be changed once EOF is
2997 sent to the process. */
2998 if (NILP (p->encode_coding_system)
2999 && proc_encode_coding_system[XINT (p->outfd)])
3000 {
3001 p->encode_coding_system = coding->symbol;
3002 setup_coding_system (coding->symbol,
3003 proc_encode_coding_system[XINT (p->outfd)]);
3004 }
3005 }
51c6067d 3006
ed7a4b2d
KH
3007 carryover = nbytes - coding->consumed;
3008 bcopy (chars + coding->consumed, XSTRING (p->decoding_buf)->data,
3009 carryover);
3010 XSETINT (p->decoding_carryover, carryover);
3011 nbytes = STRING_BYTES (XSTRING (text));
3012 nchars = XSTRING (text)->size;
dd97db06
KH
3013 if (nbytes > 0)
3014 internal_condition_case_1 (read_process_output_call,
3015 Fcons (outstream,
3016 Fcons (proc, Fcons (text, Qnil))),
3017 !NILP (Vdebug_on_error) ? Qnil : Qerror,
3018 read_process_output_error_handler);
4da2f5be
RS
3019
3020 /* If we saved the match data nonrecursively, restore it now. */
7074fde6 3021 restore_match_data ();
4da2f5be 3022 running_asynch_code = outer_running_asynch_code;
d0d6b7c5 3023
592ce97f 3024 /* Handling the process output should not deactivate the mark. */
30c78175
RS
3025 Vdeactivate_mark = odeactivate;
3026
bbce7d72
RS
3027 /* Restore waiting_for_user_input_p as it was
3028 when we were called, in case the filter clobbered it. */
3029 waiting_for_user_input_p = waiting;
3030
7973cfa8
RS
3031#if 0 /* Call record_asynch_buffer_change unconditionally,
3032 because we might have changed minor modes or other things
3033 that affect key bindings. */
dfc21838
RS
3034 if (! EQ (Fcurrent_buffer (), obuffer)
3035 || ! EQ (current_buffer->keymap, okeymap))
7973cfa8 3036#endif
927e08be
RS
3037 /* But do it only if the caller is actually going to read events.
3038 Otherwise there's no need to make him wake up, and it could
3039 cause trouble (for example it would make Fsit_for return). */
3040 if (waiting_for_user_input_p == -1)
3041 record_asynch_buffer_change ();
d72534ba 3042
d0d6b7c5
JB
3043#ifdef VMS
3044 start_vms_process_read (vs);
3045#endif
2ea6d561 3046 unbind_to (count, Qnil);
d0d6b7c5
JB
3047 return nchars;
3048 }
3049
3050 /* If no filter, write into buffer if it isn't dead. */
3051 if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
3052 {
b0310da4 3053 Lisp_Object old_read_only;
12ca5cdf 3054 int old_begv, old_zv;
d8a2934e 3055 int old_begv_byte, old_zv_byte;
30c78175 3056 Lisp_Object odeactivate;
d8a2934e
RS
3057 int before, before_byte;
3058 int opoint_byte;
ed7a4b2d 3059 Lisp_Object text;
926b7e5e 3060 struct buffer *b;
30c78175
RS
3061
3062 odeactivate = Vdeactivate_mark;
d0d6b7c5
JB
3063
3064 Fset_buffer (p->buffer);
6ec8bbd2 3065 opoint = PT;
d8a2934e 3066 opoint_byte = PT_BYTE;
b0310da4 3067 old_read_only = current_buffer->read_only;
12ca5cdf
RS
3068 old_begv = BEGV;
3069 old_zv = ZV;
d8a2934e
RS
3070 old_begv_byte = BEGV_BYTE;
3071 old_zv_byte = ZV_BYTE;
b0310da4
JB
3072
3073 current_buffer->read_only = Qnil;
d0d6b7c5
JB
3074
3075 /* Insert new output into buffer
3076 at the current end-of-output marker,
3077 thus preserving logical ordering of input and output. */
3078 if (XMARKER (p->mark)->buffer)
d8a2934e
RS
3079 SET_PT_BOTH (clip_to_bounds (BEGV, marker_position (p->mark), ZV),
3080 clip_to_bounds (BEGV_BYTE, marker_byte_position (p->mark),
3081 ZV_BYTE));
d0d6b7c5 3082 else
d8a2934e 3083 SET_PT_BOTH (ZV, ZV_BYTE);
12ca5cdf 3084 before = PT;
d8a2934e 3085 before_byte = PT_BYTE;
b0310da4
JB
3086
3087 /* If the output marker is outside of the visible region, save
3088 the restriction and widen. */
6ec8bbd2 3089 if (! (BEGV <= PT && PT <= ZV))
b0310da4
JB
3090 Fwiden ();
3091
ed7a4b2d
KH
3092 text = decode_coding_string (make_unibyte_string (chars, nbytes),
3093 coding, 0);
082a1df2 3094 Vlast_coding_system_used = coding->symbol;
ed7a4b2d
KH
3095 /* A new coding system might be found. See the comment in the
3096 similar code in the previous `if' block. */
3097 if (!EQ (p->decode_coding_system, coding->symbol))
3098 {
3099 p->decode_coding_system = coding->symbol;
3100 if (NILP (p->encode_coding_system)
3101 && proc_encode_coding_system[XINT (p->outfd)])
3102 {
3103 p->encode_coding_system = coding->symbol;
3104 setup_coding_system (coding->symbol,
3105 proc_encode_coding_system[XINT (p->outfd)]);
3106 }
3107 }
3108 carryover = nbytes - coding->consumed;
3109 bcopy (chars + coding->consumed, XSTRING (p->decoding_buf)->data,
3110 carryover);
3111 XSETINT (p->decoding_carryover, carryover);
d69864bf
KH
3112 /* Adjust the multibyteness of TEXT to that of the buffer. */
3113 if (NILP (current_buffer->enable_multibyte_characters)
3114 != ! STRING_MULTIBYTE (text))
3115 text = (STRING_MULTIBYTE (text)
57bb5c37
KH
3116 ? Fstring_as_unibyte (text)
3117 : Fstring_as_multibyte (text));
ed7a4b2d
KH
3118 nbytes = STRING_BYTES (XSTRING (text));
3119 nchars = XSTRING (text)->size;
57bb5c37
KH
3120 /* Insert before markers in case we are inserting where
3121 the buffer's mark is, and the user's next command is Meta-y. */
ed7a4b2d 3122 insert_from_string_before_markers (text, 0, 0, nchars, nbytes, 0);
a4a37e65
KH
3123 signal_after_change (before, 0, PT - before);
3124 update_compositions (before, PT, CHECK_BORDER);
0d023da1 3125
926b7e5e
GM
3126 /* Make sure the process marker's position is valid when the
3127 process buffer is changed in the signal_after_change above.
3128 W3 is known to do that. */
3129 if (BUFFERP (p->buffer)
3130 && (b = XBUFFER (p->buffer), b != current_buffer))
3131 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
3132 else
3133 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
b0310da4 3134
d0d6b7c5
JB
3135 update_mode_lines++;
3136
12ca5cdf
RS
3137 /* Make sure opoint and the old restrictions
3138 float ahead of any new text just as point would. */
3139 if (opoint >= before)
d8a2934e
RS
3140 {
3141 opoint += PT - before;
3142 opoint_byte += PT_BYTE - before_byte;
3143 }
12ca5cdf 3144 if (old_begv > before)
d8a2934e
RS
3145 {
3146 old_begv += PT - before;
3147 old_begv_byte += PT_BYTE - before_byte;
3148 }
12ca5cdf 3149 if (old_zv >= before)
d8a2934e
RS
3150 {
3151 old_zv += PT - before;
3152 old_zv_byte += PT_BYTE - before_byte;
3153 }
12ca5cdf 3154
b0310da4 3155 /* If the restriction isn't what it should be, set it. */
12ca5cdf
RS
3156 if (old_begv != BEGV || old_zv != ZV)
3157 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
b0310da4 3158
592ce97f 3159 /* Handling the process output should not deactivate the mark. */
30c78175
RS
3160 Vdeactivate_mark = odeactivate;
3161
b0310da4 3162 current_buffer->read_only = old_read_only;
d8a2934e 3163 SET_PT_BOTH (opoint, opoint_byte);
d0d6b7c5
JB
3164 set_buffer_internal (old);
3165 }
3166#ifdef VMS
3167 start_vms_process_read (vs);
3168#endif
1d2fc612 3169 return nbytes;
d0d6b7c5
JB
3170}
3171
3172DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
3173 0, 0, 0,
8b4d685f 3174 "Returns non-nil if emacs is waiting for input from the user.\n\
d0d6b7c5
JB
3175This is intended for use by asynchronous process output filters and sentinels.")
3176 ()
3177{
8b4d685f 3178 return (waiting_for_user_input_p ? Qt : Qnil);
d0d6b7c5
JB
3179}
3180\f
3181/* Sending data to subprocess */
3182
3183jmp_buf send_process_frame;
0daad115 3184Lisp_Object process_sent_to;
d0d6b7c5
JB
3185
3186SIGTYPE
3187send_process_trap ()
3188{
3189#ifdef BSD4_1
3190 sigrelse (SIGPIPE);
3191 sigrelse (SIGALRM);
3192#endif /* BSD4_1 */
3193 longjmp (send_process_frame, 1);
3194}
3195
4556b700
RS
3196/* Send some data to process PROC.
3197 BUF is the beginning of the data; LEN is the number of characters.
a92e4183
KH
3198 OBJECT is the Lisp object that the data comes from. If OBJECT is
3199 nil or t, it means that the data comes from C string.
0fa1789e 3200
a92e4183
KH
3201 If OBJECT is not nil, the data is encoded by PROC's coding-system
3202 for encoding before it is sent.
1fb0098c
GM
3203
3204 This function can evaluate Lisp code and can garbage collect. */
4556b700 3205
dfcf069d 3206void
4556b700 3207send_process (proc, buf, len, object)
ecd1f654 3208 volatile Lisp_Object proc;
0daad115
GM
3209 unsigned char *volatile buf;
3210 volatile int len;
3211 volatile Lisp_Object object;
d0d6b7c5 3212{
ecd1f654 3213 /* Use volatile to protect variables from being clobbered by longjmp. */
d0d6b7c5 3214 int rv;
0fa1789e 3215 struct coding_system *coding;
6044e593
RS
3216 struct gcpro gcpro1;
3217
3218 GCPRO1 (object);
d0d6b7c5 3219
d0d6b7c5
JB
3220#ifdef VMS
3221 struct Lisp_Process *p = XPROCESS (proc);
3222 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
3223#endif /* VMS */
3224
3225 if (! NILP (XPROCESS (proc)->raw_status_low))
3226 update_status (XPROCESS (proc));
3227 if (! EQ (XPROCESS (proc)->status, Qrun))
4dd8a783
GM
3228 error ("Process %s not running",
3229 XSTRING (XPROCESS (proc)->name)->data);
0fa1789e 3230 if (XINT (XPROCESS (proc)->outfd) < 0)
4dd8a783
GM
3231 error ("Output file descriptor of %s is closed",
3232 XSTRING (XPROCESS (proc)->name)->data);
0fa1789e 3233
c7580538 3234 coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
486b111b
KH
3235 Vlast_coding_system_used = coding->symbol;
3236
ed7a4b2d
KH
3237 if ((STRINGP (object) && STRING_MULTIBYTE (object))
3238 || (BUFFERP (object)
a92e4183
KH
3239 && !NILP (XBUFFER (object)->enable_multibyte_characters))
3240 || EQ (object, Qt))
278bfdd6
KH
3241 {
3242 coding->src_multibyte = 1;
3243 if (!EQ (coding->symbol, XPROCESS (proc)->encode_coding_system))
3244 /* The coding system for encoding was changed to raw-text
3245 because we sent a unibyte text previously. Now we are
3246 sending a multibyte text, thus we must encode it by the
3247 original coding system specified for the current
3248 process. */
3249 setup_coding_system (XPROCESS (proc)->encode_coding_system,
3250 coding);
3251 }
3252 else
3253 {
a92e4183
KH
3254 /* For sending a unibyte text, character code conversion should
3255 not take place but EOL conversion should. So, setup raw-text
3256 or one of the subsidiary if we have not yet done it. */
3257 if (coding->type != coding_type_raw_text)
3258 {
3259 if (CODING_REQUIRE_FLUSHING (coding))
3260 {
3261 /* But, before changing the coding, we must flush out data. */
3262 coding->mode |= CODING_MODE_LAST_BLOCK;
3263 send_process (proc, "", 0, Qt);
3264 }
3265 coding->src_multibyte = 0;
3266 setup_raw_text_coding_system (coding);
3267 }
278bfdd6 3268 }
a4a37e65
KH
3269 coding->dst_multibyte = 0;
3270
ed7a4b2d 3271 if (CODING_REQUIRE_ENCODING (coding))
0fa1789e
KH
3272 {
3273 int require = encoding_buffer_size (coding, len);
0daad115 3274 int from_byte = -1, from = -1, to = -1;
b684d043 3275 unsigned char *temp_buf = NULL;
0fa1789e 3276
ed7a4b2d 3277 if (BUFFERP (object))
0fa1789e 3278 {
ed7a4b2d
KH
3279 from_byte = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
3280 from = buf_bytepos_to_charpos (XBUFFER (object), from_byte);
3281 to = buf_bytepos_to_charpos (XBUFFER (object), from_byte + len);
3282 }
3283 else if (STRINGP (object))
3284 {
3285 from_byte = buf - XSTRING (object)->data;
3286 from = string_byte_to_char (object, from_byte);
3287 to = string_byte_to_char (object, from_byte + len);
0fa1789e
KH
3288 }
3289
ed7a4b2d
KH
3290 if (from_byte >= 0 && coding->composing != COMPOSITION_DISABLED)
3291 coding_save_composition (coding, from, to, object);
3292
fc932ac6 3293 if (STRING_BYTES (XSTRING (XPROCESS (proc)->encoding_buf)) < require)
ed7a4b2d
KH
3294 XPROCESS (proc)->encoding_buf = make_uninit_string (require);
3295
3296 if (from_byte >= 0)
3297 buf = (BUFFERP (object)
3298 ? BUF_BYTE_ADDRESS (XBUFFER (object), from_byte)
3299 : XSTRING (object)->data + from_byte);
0fa1789e 3300
0fa1789e 3301 object = XPROCESS (proc)->encoding_buf;
0daad115 3302 encode_coding (coding, (char *) buf, XSTRING (object)->data,
fc932ac6 3303 len, STRING_BYTES (XSTRING (object)));
e7fbaa65 3304 len = coding->produced;
0fa1789e
KH
3305 buf = XSTRING (object)->data;
3306 if (temp_buf)
3307 xfree (temp_buf);
3308 }
d0d6b7c5
JB
3309
3310#ifdef VMS
3311 vs = get_vms_process_pointer (p->pid);
3312 if (vs == 0)
3313 error ("Could not find this process: %x", p->pid);
3314 else if (write_to_vms_process (vs, buf, len))
3315 ;
0daad115 3316#else /* not VMS */
4556b700
RS
3317
3318 if (pty_max_bytes == 0)
3319 {
3320#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
3321 pty_max_bytes = fpathconf (XFASTINT (XPROCESS (proc)->outfd),
3322 _PC_MAX_CANON);
3323 if (pty_max_bytes < 0)
3324 pty_max_bytes = 250;
3325#else
3326 pty_max_bytes = 250;
3327#endif
3328 /* Deduct one, to leave space for the eof. */
3329 pty_max_bytes--;
3330 }
3331
0daad115
GM
3332 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
3333 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
3334 when returning with longjmp despite being declared volatile. */
d0d6b7c5 3335 if (!setjmp (send_process_frame))
0daad115
GM
3336 {
3337 process_sent_to = proc;
3338 while (len > 0)
3339 {
3340 int this = len;
3341 SIGTYPE (*old_sigpipe)();
93b4f699 3342
0daad115
GM
3343 /* Decide how much data we can send in one batch.
3344 Long lines need to be split into multiple batches. */
3345 if (!NILP (XPROCESS (proc)->pty_flag))
3346 {
3347 /* Starting this at zero is always correct when not the first iteration
3348 because the previous iteration ended by sending C-d.
3349 It may not be correct for the first iteration
3350 if a partial line was sent in a separate send_process call.
3351 If that proves worth handling, we need to save linepos
3352 in the process object. */
3353 int linepos = 0;
3354 unsigned char *ptr = (unsigned char *) buf;
3355 unsigned char *end = (unsigned char *) buf + len;
3356
3357 /* Scan through this text for a line that is too long. */
3358 while (ptr != end && linepos < pty_max_bytes)
3359 {
3360 if (*ptr == '\n')
3361 linepos = 0;
3362 else
3363 linepos++;
3364 ptr++;
3365 }
3366 /* If we found one, break the line there
3367 and put in a C-d to force the buffer through. */
3368 this = ptr - buf;
3369 }
93b4f699 3370
0daad115
GM
3371 /* Send this batch, using one or more write calls. */
3372 while (this > 0)
3373 {
3374 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
3375 rv = emacs_write (XINT (XPROCESS (proc)->outfd),
3376 (char *) buf, this);
3377 signal (SIGPIPE, old_sigpipe);
4556b700 3378
0daad115
GM
3379 if (rv < 0)
3380 {
3381 if (0
d0d6b7c5 3382#ifdef EWOULDBLOCK
0daad115 3383 || errno == EWOULDBLOCK
d0d6b7c5
JB
3384#endif
3385#ifdef EAGAIN
0daad115 3386 || errno == EAGAIN
d0d6b7c5 3387#endif
0daad115
GM
3388 )
3389 /* Buffer is full. Wait, accepting input;
3390 that may allow the program
3391 to finish doing output and read more. */
3392 {
3393 Lisp_Object zero;
3394 int offset = 0;
4556b700 3395
3433b6bd 3396#ifdef BROKEN_PTY_READ_AFTER_EAGAIN
0daad115
GM
3397 /* A gross hack to work around a bug in FreeBSD.
3398 In the following sequence, read(2) returns
3399 bogus data:
3400
3401 write(2) 1022 bytes
3402 write(2) 954 bytes, get EAGAIN
3403 read(2) 1024 bytes in process_read_output
3404 read(2) 11 bytes in process_read_output
3405
3406 That is, read(2) returns more bytes than have
3407 ever been written successfully. The 1033 bytes
3408 read are the 1022 bytes written successfully
3409 after processing (for example with CRs added if
3410 the terminal is set up that way which it is
3411 here). The same bytes will be seen again in a
3412 later read(2), without the CRs. */
3433b6bd 3413
0daad115
GM
3414 if (errno == EAGAIN)
3415 {
3416 int flags = FWRITE;
3417 ioctl (XINT (XPROCESS (proc)->outfd), TIOCFLUSH,
3418 &flags);
3419 }
3433b6bd
GM
3420#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
3421
0daad115
GM
3422 /* Running filters might relocate buffers or strings.
3423 Arrange to relocate BUF. */
3424 if (BUFFERP (object))
3425 offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
3426 else if (STRINGP (object))
3427 offset = buf - XSTRING (object)->data;
3428
3429 XSETFASTINT (zero, 0);
f3e6605c 3430#ifdef EMACS_HAS_USECS
0daad115 3431 wait_reading_process_input (0, 20000, zero, 0);
f3e6605c 3432#else
0daad115 3433 wait_reading_process_input (1, 0, zero, 0);
f3e6605c 3434#endif
4556b700 3435
0daad115
GM
3436 if (BUFFERP (object))
3437 buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
3438 else if (STRINGP (object))
3439 buf = offset + XSTRING (object)->data;
4556b700 3440
0daad115
GM
3441 rv = 0;
3442 }
3443 else
3444 /* This is a real error. */
3445 report_file_error ("writing to process", Fcons (proc, Qnil));
3446 }
3447 buf += rv;
3448 len -= rv;
3449 this -= rv;
3450 }
f76475ad 3451
0daad115
GM
3452 /* If we sent just part of the string, put in an EOF
3453 to force it through, before we send the rest. */
3454 if (len > 0)
3455 Fprocess_send_eof (proc);
3456 }
3457 }
3458#endif /* not VMS */
d0d6b7c5
JB
3459 else
3460 {
0daad115
GM
3461#ifndef VMS
3462 proc = process_sent_to;
3463#endif
d0d6b7c5
JB
3464 XPROCESS (proc)->raw_status_low = Qnil;
3465 XPROCESS (proc)->raw_status_high = Qnil;
3466 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
3467 XSETINT (XPROCESS (proc)->tick, ++process_tick);
3468 deactivate_process (proc);
3469#ifdef VMS
4dd8a783
GM
3470 error ("Error writing to process %s; closed it",
3471 XSTRING (XPROCESS (proc)->name)->data);
d0d6b7c5 3472#else
4dd8a783
GM
3473 error ("SIGPIPE raised on process %s; closed it",
3474 XSTRING (XPROCESS (proc)->name)->data);
d0d6b7c5
JB
3475#endif
3476 }
6044e593
RS
3477
3478 UNGCPRO;
d0d6b7c5
JB
3479}
3480
3481DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
3482 3, 3, 0,
3483 "Send current contents of region as input to PROCESS.\n\
ebb9e16f
JB
3484PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
3485nil, indicating the current buffer's process.\n\
d0d6b7c5
JB
3486Called from program, takes three arguments, PROCESS, START and END.\n\
3487If the region is more than 500 characters long,\n\
3488it is sent in several bunches. This may happen even for shorter regions.\n\
3489Output from processes can arrive in between bunches.")
3490 (process, start, end)
3491 Lisp_Object process, start, end;
3492{
3493 Lisp_Object proc;
d8a2934e 3494 int start1, end1;
d0d6b7c5
JB
3495
3496 proc = get_process (process);
3497 validate_region (&start, &end);
3498
3499 if (XINT (start) < GPT && XINT (end) > GPT)
4da6dec8 3500 move_gap (XINT (start));
d0d6b7c5 3501
d8a2934e
RS
3502 start1 = CHAR_TO_BYTE (XINT (start));
3503 end1 = CHAR_TO_BYTE (XINT (end));
3504 send_process (proc, BYTE_POS_ADDR (start1), end1 - start1,
4556b700 3505 Fcurrent_buffer ());
d0d6b7c5
JB
3506
3507 return Qnil;
3508}
3509
3510DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
3511 2, 2, 0,
3512 "Send PROCESS the contents of STRING as input.\n\
ebb9e16f
JB
3513PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
3514nil, indicating the current buffer's process.\n\
d0d6b7c5
JB
3515If STRING is more than 500 characters long,\n\
3516it is sent in several bunches. This may happen even for shorter strings.\n\
3517Output from processes can arrive in between bunches.")
3518 (process, string)
3519 Lisp_Object process, string;
3520{
3521 Lisp_Object proc;
3522 CHECK_STRING (string, 1);
3523 proc = get_process (process);
1d2fc612 3524 send_process (proc, XSTRING (string)->data,
fc932ac6 3525 STRING_BYTES (XSTRING (string)), string);
d0d6b7c5
JB
3526 return Qnil;
3527}
3528\f
b81ea5ef
RS
3529DEFUN ("process-running-child-p", Fprocess_running_child_p,
3530 Sprocess_running_child_p, 0, 1, 0,
3531 "Return t if PROCESS has given the terminal to a child.\n\
3532If the operating system does not make it possible to find out,\n\
3533return t unconditionally.")
3534 (process)
3535 Lisp_Object process;
3536{
3537 /* Initialize in case ioctl doesn't exist or gives an error,
3538 in a way that will cause returning t. */
3539 int gid = 0;
3540 Lisp_Object proc;
3541 struct Lisp_Process *p;
3542
3543 proc = get_process (process);
3544 p = XPROCESS (proc);
3545
3546 if (!EQ (p->childp, Qt))
3547 error ("Process %s is not a subprocess",
3548 XSTRING (p->name)->data);
3549 if (XINT (p->infd) < 0)
3550 error ("Process %s is not active",
3551 XSTRING (p->name)->data);
3552
3553#ifdef TIOCGPGRP
3554 if (!NILP (p->subtty))
3555 ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
3556 else
3557 ioctl (XINT (p->infd), TIOCGPGRP, &gid);
3558#endif /* defined (TIOCGPGRP ) */
3559
3560 if (gid == XFASTINT (p->pid))
3561 return Qnil;
3562 return Qt;
3563}
3564\f
d0d6b7c5 3565/* send a signal number SIGNO to PROCESS.
b81ea5ef
RS
3566 If CURRENT_GROUP is t, that means send to the process group
3567 that currently owns the terminal being used to communicate with PROCESS.
d0d6b7c5 3568 This is used for various commands in shell mode.
b81ea5ef
RS
3569 If CURRENT_GROUP is lambda, that means send to the process group
3570 that currently owns the terminal, but only if it is NOT the shell itself.
3571
d0d6b7c5 3572 If NOMSG is zero, insert signal-announcements into process's buffers
b0310da4
JB
3573 right away.
3574
3575 If we can, we try to signal PROCESS by sending control characters
e333e864 3576 down the pty. This allows us to signal inferiors who have changed
b0310da4 3577 their uid, for which killpg would return an EPERM error. */
d0d6b7c5 3578
f9738840 3579static void
d0d6b7c5
JB
3580process_send_signal (process, signo, current_group, nomsg)
3581 Lisp_Object process;
3582 int signo;
3583 Lisp_Object current_group;
3584 int nomsg;
3585{
3586 Lisp_Object proc;
3587 register struct Lisp_Process *p;
3588 int gid;
3589 int no_pgrp = 0;
3590
3591 proc = get_process (process);
3592 p = XPROCESS (proc);
3593
3594 if (!EQ (p->childp, Qt))
3595 error ("Process %s is not a subprocess",
3596 XSTRING (p->name)->data);
a9f2c884 3597 if (XINT (p->infd) < 0)
d0d6b7c5
JB
3598 error ("Process %s is not active",
3599 XSTRING (p->name)->data);
3600
3601 if (NILP (p->pty_flag))
3602 current_group = Qnil;
3603
d0d6b7c5
JB
3604 /* If we are using pgrps, get a pgrp number and make it negative. */
3605 if (!NILP (current_group))
3606 {
b0310da4 3607#ifdef SIGNALS_VIA_CHARACTERS
d0d6b7c5
JB
3608 /* If possible, send signals to the entire pgrp
3609 by sending an input character to it. */
b0310da4 3610
6be429b1
JB
3611 /* TERMIOS is the latest and bestest, and seems most likely to
3612 work. If the system has it, use it. */
3613#ifdef HAVE_TERMIOS
3614 struct termios t;
3615
3616 switch (signo)
3617 {
3618 case SIGINT:
a9f2c884 3619 tcgetattr (XINT (p->infd), &t);
4556b700 3620 send_process (proc, &t.c_cc[VINTR], 1, Qnil);
a87b802f 3621 return;
6be429b1
JB
3622
3623 case SIGQUIT:
a9f2c884 3624 tcgetattr (XINT (p->infd), &t);
4556b700 3625 send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
a87b802f 3626 return;
6be429b1
JB
3627
3628 case SIGTSTP:
a9f2c884 3629 tcgetattr (XINT (p->infd), &t);
d0adf46f 3630#if defined (VSWTCH) && !defined (PREFER_VSUSP)
4556b700 3631 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
6be429b1 3632#else
4556b700 3633 send_process (proc, &t.c_cc[VSUSP], 1, Qnil);
6be429b1 3634#endif
a87b802f 3635 return;
6be429b1
JB
3636 }
3637
3638#else /* ! HAVE_TERMIOS */
3639
b0310da4
JB
3640 /* On Berkeley descendants, the following IOCTL's retrieve the
3641 current control characters. */
d0d6b7c5 3642#if defined (TIOCGLTC) && defined (TIOCGETC)
b0310da4 3643
d0d6b7c5
JB
3644 struct tchars c;
3645 struct ltchars lc;
3646
3647 switch (signo)
3648 {
3649 case SIGINT:
a9f2c884 3650 ioctl (XINT (p->infd), TIOCGETC, &c);
4556b700 3651 send_process (proc, &c.t_intrc, 1, Qnil);
f9738840 3652 return;
d0d6b7c5 3653 case SIGQUIT:
a9f2c884 3654 ioctl (XINT (p->infd), TIOCGETC, &c);
4556b700 3655 send_process (proc, &c.t_quitc, 1, Qnil);
f9738840 3656 return;
0ad77c54 3657#ifdef SIGTSTP
d0d6b7c5 3658 case SIGTSTP:
a9f2c884 3659 ioctl (XINT (p->infd), TIOCGLTC, &lc);
4556b700 3660 send_process (proc, &lc.t_suspc, 1, Qnil);
f9738840 3661 return;
b0310da4 3662#endif /* ! defined (SIGTSTP) */
d0d6b7c5 3663 }
b0310da4
JB
3664
3665#else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
3666
3667 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
3668 characters. */
3669#ifdef TCGETA
d0d6b7c5
JB
3670 struct termio t;
3671 switch (signo)
3672 {
3673 case SIGINT:
a9f2c884 3674 ioctl (XINT (p->infd), TCGETA, &t);
4556b700 3675 send_process (proc, &t.c_cc[VINTR], 1, Qnil);
f9738840 3676 return;
d0d6b7c5 3677 case SIGQUIT:
a9f2c884 3678 ioctl (XINT (p->infd), TCGETA, &t);
4556b700 3679 send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
f9738840 3680 return;
7d79e3b4 3681#ifdef SIGTSTP
d0d6b7c5 3682 case SIGTSTP:
a9f2c884 3683 ioctl (XINT (p->infd), TCGETA, &t);
4556b700 3684 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
f9738840 3685 return;
b0310da4 3686#endif /* ! defined (SIGTSTP) */
d0d6b7c5 3687 }
b0310da4
JB
3688#else /* ! defined (TCGETA) */
3689 Your configuration files are messed up.
3690 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
3691 you'd better be using one of the alternatives above! */
3692#endif /* ! defined (TCGETA) */
3693#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
6be429b1 3694#endif /* ! defined HAVE_TERMIOS */
b0310da4 3695#endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
d0d6b7c5 3696
301c3fe4 3697#ifdef TIOCGPGRP
d0d6b7c5
JB
3698 /* Get the pgrp using the tty itself, if we have that.
3699 Otherwise, use the pty to get the pgrp.
3700 On pfa systems, saka@pfu.fujitsu.co.JP writes:
b0310da4
JB
3701 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
3702 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
d0d6b7c5
JB
3703 His patch indicates that if TIOCGPGRP returns an error, then
3704 we should just assume that p->pid is also the process group id. */
3705 {
3706 int err;
3707
3708 if (!NILP (p->subtty))
3709 err = ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
3710 else
a9f2c884 3711 err = ioctl (XINT (p->infd), TIOCGPGRP, &gid);
d0d6b7c5
JB
3712
3713#ifdef pfa
3714 if (err == -1)
3715 gid = - XFASTINT (p->pid);
301c3fe4 3716#endif /* ! defined (pfa) */
d0d6b7c5
JB
3717 }
3718 if (gid == -1)
3719 no_pgrp = 1;
3720 else
3721 gid = - gid;
b0310da4 3722#else /* ! defined (TIOCGPGRP ) */
301c3fe4
JB
3723 /* Can't select pgrps on this system, so we know that
3724 the child itself heads the pgrp. */
3725 gid = - XFASTINT (p->pid);
3726#endif /* ! defined (TIOCGPGRP ) */
b81ea5ef
RS
3727
3728 /* If current_group is lambda, and the shell owns the terminal,
3729 don't send any signal. */
3730 if (EQ (current_group, Qlambda) && gid == - XFASTINT (p->pid))
3731 return;
d0d6b7c5
JB
3732 }
3733 else
3734 gid = - XFASTINT (p->pid);
d0d6b7c5
JB
3735
3736 switch (signo)
3737 {
3738#ifdef SIGCONT
3739 case SIGCONT:
3740 p->raw_status_low = Qnil;
3741 p->raw_status_high = Qnil;
3742 p->status = Qrun;
3743 XSETINT (p->tick, ++process_tick);
3744 if (!nomsg)
3745 status_notify ();
3746 break;
301c3fe4 3747#endif /* ! defined (SIGCONT) */
d0d6b7c5
JB
3748 case SIGINT:
3749#ifdef VMS
4556b700 3750 send_process (proc, "\003", 1, Qnil); /* ^C */
d0d6b7c5
JB
3751 goto whoosh;
3752#endif
3753 case SIGQUIT:
3754#ifdef VMS
4556b700 3755 send_process (proc, "\031", 1, Qnil); /* ^Y */
d0d6b7c5
JB
3756 goto whoosh;
3757#endif
3758 case SIGKILL:
3759#ifdef VMS
3760 sys$forcex (&(XFASTINT (p->pid)), 0, 1);
3761 whoosh:
3762#endif
a9f2c884 3763 flush_pending_output (XINT (p->infd));
d0d6b7c5
JB
3764 break;
3765 }
3766
3767 /* If we don't have process groups, send the signal to the immediate
3768 subprocess. That isn't really right, but it's better than any
3769 obvious alternative. */
3770 if (no_pgrp)
3771 {
3772 kill (XFASTINT (p->pid), signo);
3773 return;
3774 }
3775
3776 /* gid may be a pid, or minus a pgrp's number */
3777#ifdef TIOCSIGSEND
3778 if (!NILP (current_group))
a9f2c884 3779 ioctl (XINT (p->infd), TIOCSIGSEND, signo);
d0d6b7c5
JB
3780 else
3781 {
3782 gid = - XFASTINT (p->pid);
3783 kill (gid, signo);
3784 }
301c3fe4 3785#else /* ! defined (TIOCSIGSEND) */
d0d6b7c5 3786 EMACS_KILLPG (-gid, signo);
301c3fe4 3787#endif /* ! defined (TIOCSIGSEND) */
d0d6b7c5
JB
3788}
3789
3790DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
7744ca33 3791 "Interrupt process PROCESS.\n\
ebb9e16f 3792PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
e333e864 3793nil or no arg means current buffer's process.\n\
d0d6b7c5
JB
3794Second arg CURRENT-GROUP non-nil means send signal to\n\
3795the current process-group of the process's controlling terminal\n\
3796rather than to the process's own process group.\n\
3797If the process is a shell, this means interrupt current subjob\n\
b81ea5ef
RS
3798rather than the shell.\n\
3799\n\
3800If CURRENT-GROUP is `lambda', and if the shell owns the terminal,\n\
3801don't send the signal.")
d0d6b7c5
JB
3802 (process, current_group)
3803 Lisp_Object process, current_group;
3804{
3805 process_send_signal (process, SIGINT, current_group, 0);
3806 return process;
3807}
3808
3809DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
3810 "Kill process PROCESS. May be process or name of one.\n\
3811See function `interrupt-process' for more details on usage.")
3812 (process, current_group)
3813 Lisp_Object process, current_group;
3814{
3815 process_send_signal (process, SIGKILL, current_group, 0);
3816 return process;
3817}
3818
3819DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
3820 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
3821See function `interrupt-process' for more details on usage.")
3822 (process, current_group)
3823 Lisp_Object process, current_group;
3824{
3825 process_send_signal (process, SIGQUIT, current_group, 0);
3826 return process;
3827}
3828
3829DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
3830 "Stop process PROCESS. May be process or name of one.\n\
3831See function `interrupt-process' for more details on usage.")
3832 (process, current_group)
3833 Lisp_Object process, current_group;
3834{
3835#ifndef SIGTSTP
3836 error ("no SIGTSTP support");
3837#else
3838 process_send_signal (process, SIGTSTP, current_group, 0);
3839#endif
3840 return process;
3841}
3842
3843DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
3844 "Continue process PROCESS. May be process or name of one.\n\
3845See function `interrupt-process' for more details on usage.")
3846 (process, current_group)
3847 Lisp_Object process, current_group;
3848{
3849#ifdef SIGCONT
3850 process_send_signal (process, SIGCONT, current_group, 0);
3851#else
3852 error ("no SIGCONT support");
3853#endif
3854 return process;
3855}
3856
3857DEFUN ("signal-process", Fsignal_process, Ssignal_process,
3858 2, 2, "nProcess number: \nnSignal code: ",
4766242d
RS
3859 "Send the process with process id PID the signal with code SIGCODE.\n\
3860PID must be an integer. The process need not be a child of this Emacs.\n\
3861SIGCODE may be an integer, or a symbol whose name is a signal name.")
3862 (pid, sigcode)
3863 Lisp_Object pid, sigcode;
d0d6b7c5
JB
3864{
3865 CHECK_NUMBER (pid, 0);
4766242d
RS
3866
3867#define handle_signal(NAME, VALUE) \
3868 else if (!strcmp (name, NAME)) \
3869 XSETINT (sigcode, VALUE)
3870
3871 if (INTEGERP (sigcode))
3872 ;
3873 else
3874 {
3875 unsigned char *name;
3876
3877 CHECK_SYMBOL (sigcode, 1);
3878 name = XSYMBOL (sigcode)->name->data;
3879
3880 if (0)
3881 ;
3882#ifdef SIGHUP
3883 handle_signal ("SIGHUP", SIGHUP);
3884#endif
3885#ifdef SIGINT
3886 handle_signal ("SIGINT", SIGINT);
3887#endif
3888#ifdef SIGQUIT
3889 handle_signal ("SIGQUIT", SIGQUIT);
3890#endif
3891#ifdef SIGILL
3892 handle_signal ("SIGILL", SIGILL);
3893#endif
3894#ifdef SIGABRT
3895 handle_signal ("SIGABRT", SIGABRT);
3896#endif
3897#ifdef SIGEMT
3898 handle_signal ("SIGEMT", SIGEMT);
3899#endif
3900#ifdef SIGKILL
3901 handle_signal ("SIGKILL", SIGKILL);
3902#endif
3903#ifdef SIGFPE
3904 handle_signal ("SIGFPE", SIGFPE);
3905#endif
3906#ifdef SIGBUS
3907 handle_signal ("SIGBUS", SIGBUS);
3908#endif
3909#ifdef SIGSEGV
3910 handle_signal ("SIGSEGV", SIGSEGV);
3911#endif
3912#ifdef SIGSYS
3913 handle_signal ("SIGSYS", SIGSYS);
3914#endif
3915#ifdef SIGPIPE
3916 handle_signal ("SIGPIPE", SIGPIPE);
3917#endif
3918#ifdef SIGALRM
3919 handle_signal ("SIGALRM", SIGALRM);
3920#endif
3921#ifdef SIGTERM
3922 handle_signal ("SIGTERM", SIGTERM);
3923#endif
3924#ifdef SIGURG
3925 handle_signal ("SIGURG", SIGURG);
3926#endif
3927#ifdef SIGSTOP
3928 handle_signal ("SIGSTOP", SIGSTOP);
3929#endif
3930#ifdef SIGTSTP
3931 handle_signal ("SIGTSTP", SIGTSTP);
3932#endif
3933#ifdef SIGCONT
3934 handle_signal ("SIGCONT", SIGCONT);
3935#endif
3936#ifdef SIGCHLD
3937 handle_signal ("SIGCHLD", SIGCHLD);
3938#endif
3939#ifdef SIGTTIN
3940 handle_signal ("SIGTTIN", SIGTTIN);
3941#endif
3942#ifdef SIGTTOU
3943 handle_signal ("SIGTTOU", SIGTTOU);
3944#endif
3945#ifdef SIGIO
3946 handle_signal ("SIGIO", SIGIO);
3947#endif
3948#ifdef SIGXCPU
3949 handle_signal ("SIGXCPU", SIGXCPU);
3950#endif
3951#ifdef SIGXFSZ
3952 handle_signal ("SIGXFSZ", SIGXFSZ);
3953#endif
3954#ifdef SIGVTALRM
3955 handle_signal ("SIGVTALRM", SIGVTALRM);
3956#endif
3957#ifdef SIGPROF
3958 handle_signal ("SIGPROF", SIGPROF);
3959#endif
3960#ifdef SIGWINCH
3961 handle_signal ("SIGWINCH", SIGWINCH);
3962#endif
3963#ifdef SIGINFO
3964 handle_signal ("SIGINFO", SIGINFO);
3965#endif
3966#ifdef SIGUSR1
3967 handle_signal ("SIGUSR1", SIGUSR1);
3968#endif
3969#ifdef SIGUSR2
3970 handle_signal ("SIGUSR2", SIGUSR2);
3971#endif
3972 else
9fa195a2 3973 error ("Undefined signal name %s", name);
4766242d
RS
3974 }
3975
3976#undef handle_signal
3977
4766242d 3978 return make_number (kill (XINT (pid), XINT (sigcode)));
d0d6b7c5
JB
3979}
3980
3981DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
3982 "Make PROCESS see end-of-file in its input.\n\
7744ca33 3983EOF comes after any text already sent to it.\n\
ebb9e16f 3984PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
d33a00f2
RS
3985nil, indicating the current buffer's process.\n\
3986If PROCESS is a network connection, or is a process communicating\n\
3987through a pipe (as opposed to a pty), then you cannot send any more\n\
3988text to PROCESS after you call this function.")
d0d6b7c5
JB
3989 (process)
3990 Lisp_Object process;
3991{
3992 Lisp_Object proc;
de7fbd09 3993 struct coding_system *coding;
d0d6b7c5
JB
3994
3995 proc = get_process (process);
de7fbd09 3996 coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
577d03d5
RS
3997
3998 /* Make sure the process is really alive. */
3999 if (! NILP (XPROCESS (proc)->raw_status_low))
4000 update_status (XPROCESS (proc));
4001 if (! EQ (XPROCESS (proc)->status, Qrun))
dcf970e6 4002 error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
577d03d5 4003
de7fbd09
KH
4004 if (CODING_REQUIRE_FLUSHING (coding))
4005 {
4006 coding->mode |= CODING_MODE_LAST_BLOCK;
4007 send_process (proc, "", 0, Qnil);
4008 }
4009
d0d6b7c5 4010#ifdef VMS
4556b700 4011 send_process (proc, "\032", 1, Qnil); /* ^z */
d0d6b7c5
JB
4012#else
4013 if (!NILP (XPROCESS (proc)->pty_flag))
4556b700 4014 send_process (proc, "\004", 1, Qnil);
d0d6b7c5
JB
4015 else
4016 {
4525f571
RS
4017 int old_outfd, new_outfd;
4018
93853f3d 4019#ifdef HAVE_SHUTDOWN
02f55c4b
RS
4020 /* If this is a network connection, or socketpair is used
4021 for communication with the subprocess, call shutdown to cause EOF.
4022 (In some old system, shutdown to socketpair doesn't work.
4023 Then we just can't win.) */
4024 if (NILP (XPROCESS (proc)->pid)
4025 || XINT (XPROCESS (proc)->outfd) == XINT (XPROCESS (proc)->infd))
4026 shutdown (XINT (XPROCESS (proc)->outfd), 1);
4027 /* In case of socketpair, outfd == infd, so don't close it. */
4028 if (XINT (XPROCESS (proc)->outfd) != XINT (XPROCESS (proc)->infd))
68c45bf0 4029 emacs_close (XINT (XPROCESS (proc)->outfd));
93853f3d 4030#else /* not HAVE_SHUTDOWN */
68c45bf0 4031 emacs_close (XINT (XPROCESS (proc)->outfd));
93853f3d 4032#endif /* not HAVE_SHUTDOWN */
68c45bf0 4033 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
4525f571
RS
4034 old_outfd = XINT (XPROCESS (proc)->outfd);
4035
4036 if (!proc_encode_coding_system[new_outfd])
4037 proc_encode_coding_system[new_outfd]
4038 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
4039 bcopy (proc_encode_coding_system[old_outfd],
4040 proc_encode_coding_system[new_outfd],
4041 sizeof (struct coding_system));
4042 bzero (proc_encode_coding_system[old_outfd],
4043 sizeof (struct coding_system));
4044
4045 XSETINT (XPROCESS (proc)->outfd, new_outfd);
d0d6b7c5
JB
4046 }
4047#endif /* VMS */
d0d6b7c5
JB
4048 return process;
4049}
4050
4051/* Kill all processes associated with `buffer'.
4052 If `buffer' is nil, kill all processes */
4053
6b53bb85 4054void
d0d6b7c5
JB
4055kill_buffer_processes (buffer)
4056 Lisp_Object buffer;
4057{
4058 Lisp_Object tail, proc;
4059
70949dac 4060 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
d0d6b7c5 4061 {
70949dac 4062 proc = XCDR (XCAR (tail));
b5b502d6 4063 if (GC_PROCESSP (proc)
d0d6b7c5
JB
4064 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
4065 {
4066 if (NETCONN_P (proc))
e1ab4959 4067 Fdelete_process (proc);
a9f2c884 4068 else if (XINT (XPROCESS (proc)->infd) >= 0)
d0d6b7c5
JB
4069 process_send_signal (proc, SIGHUP, Qnil, 1);
4070 }
4071 }
4072}
4073\f
4074/* On receipt of a signal that a child status has changed,
4075 loop asking about children with changed statuses until
4076 the system says there are no more.
4077 All we do is change the status;
4078 we do not run sentinels or print notifications.
4079 That is saved for the next time keyboard input is done,
4080 in order to avoid timing errors. */
4081
4082/** WARNING: this can be called during garbage collection.
4083 Therefore, it must not be fooled by the presence of mark bits in
4084 Lisp objects. */
4085
4086/** USG WARNING: Although it is not obvious from the documentation
4087 in signal(2), on a USG system the SIGCLD handler MUST NOT call
4088 signal() before executing at least one wait(), otherwise the handler
4089 will be called again, resulting in an infinite loop. The relevant
4090 portion of the documentation reads "SIGCLD signals will be queued
4091 and the signal-catching function will be continually reentered until
4092 the queue is empty". Invoking signal() causes the kernel to reexamine
4093 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
4094
4095SIGTYPE
4096sigchld_handler (signo)
4097 int signo;
4098{
4099 int old_errno = errno;
4100 Lisp_Object proc;
4101 register struct Lisp_Process *p;
6be429b1 4102 extern EMACS_TIME *input_available_clear_time;
d0d6b7c5
JB
4103
4104#ifdef BSD4_1
4105 extern int sigheld;
4106 sigheld |= sigbit (SIGCHLD);
4107#endif
4108
4109 while (1)
4110 {
4111 register int pid;
4112 WAITTYPE w;
4113 Lisp_Object tail;
4114
4115#ifdef WNOHANG
4116#ifndef WUNTRACED
4117#define WUNTRACED 0
4118#endif /* no WUNTRACED */
4119 /* Keep trying to get a status until we get a definitive result. */
4120 do
4121 {
4122 errno = 0;
4123 pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
4124 }
4125 while (pid <= 0 && errno == EINTR);
4126
4127 if (pid <= 0)
4128 {
4129 /* A real failure. We have done all our job, so return. */
4130
4131 /* USG systems forget handlers when they are used;
4132 must reestablish each time */
3c0ee47b 4133#if defined (USG) && !defined (POSIX_SIGNALS)
d0d6b7c5
JB
4134 signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
4135#endif
4136#ifdef BSD4_1
4137 sigheld &= ~sigbit (SIGCHLD);
4138 sigrelse (SIGCHLD);
4139#endif
4140 errno = old_errno;
4141 return;
4142 }
4143#else
4144 pid = wait (&w);
4145#endif /* no WNOHANG */
4146
4147 /* Find the process that signaled us, and record its status. */
4148
4149 p = 0;
70949dac 4150 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
d0d6b7c5 4151 {
70949dac 4152 proc = XCDR (XCAR (tail));
d0d6b7c5
JB
4153 p = XPROCESS (proc);
4154 if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
4155 break;
4156 p = 0;
4157 }
4158
4159 /* Look for an asynchronous process whose pid hasn't been filled
4160 in yet. */
4161 if (p == 0)
70949dac 4162 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
d0d6b7c5 4163 {
70949dac 4164 proc = XCDR (XCAR (tail));
d0d6b7c5 4165 p = XPROCESS (proc);
bcd69aea 4166 if (INTEGERP (p->pid) && XINT (p->pid) == -1)
d0d6b7c5
JB
4167 break;
4168 p = 0;
4169 }
4170
4171 /* Change the status of the process that was found. */
4172 if (p != 0)
4173 {
4174 union { int i; WAITTYPE wt; } u;
e98d950b 4175 int clear_desc_flag = 0;
d0d6b7c5
JB
4176
4177 XSETINT (p->tick, ++process_tick);
4178 u.wt = w;
5fc0154c
RS
4179 XSETINT (p->raw_status_low, u.i & 0xffff);
4180 XSETINT (p->raw_status_high, u.i >> 16);
d0d6b7c5
JB
4181
4182 /* If process has terminated, stop waiting for its output. */
e98d950b
RS
4183 if ((WIFSIGNALED (w) || WIFEXITED (w))
4184 && XINT (p->infd) >= 0)
4185 clear_desc_flag = 1;
4186
4187 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
4188 if (clear_desc_flag)
4189 {
4190 FD_CLR (XINT (p->infd), &input_wait_mask);
4191 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
4192 }
6be429b1
JB
4193
4194 /* Tell wait_reading_process_input that it needs to wake up and
4195 look around. */
4196 if (input_available_clear_time)
4197 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
d0d6b7c5
JB
4198 }
4199
4200 /* There was no asynchronous process found for that id. Check
4201 if we have a synchronous process. */
4202 else
4203 {
4204 synch_process_alive = 0;
4205
4206 /* Report the status of the synchronous process. */
4207 if (WIFEXITED (w))
4208 synch_process_retcode = WRETCODE (w);
4209 else if (WIFSIGNALED (w))
b97ad9ea
RS
4210 {
4211 int code = WTERMSIG (w);
68c45bf0
PE
4212 char *signame;
4213
ca9c0567 4214 synchronize_system_messages_locale ();
68c45bf0 4215 signame = strsignal (code);
b97ad9ea 4216
b97ad9ea
RS
4217 if (signame == 0)
4218 signame = "unknown";
4219
4220 synch_process_death = signame;
4221 }
6be429b1
JB
4222
4223 /* Tell wait_reading_process_input that it needs to wake up and
4224 look around. */
4225 if (input_available_clear_time)
4226 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
d0d6b7c5
JB
4227 }
4228
4229 /* On some systems, we must return right away.
4230 If any more processes want to signal us, we will
4231 get another signal.
4232 Otherwise (on systems that have WNOHANG), loop around
4233 to use up all the processes that have something to tell us. */
e98d950b 4234#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) || defined (WINDOWSNT)
3c0ee47b 4235#if defined (USG) && ! defined (POSIX_SIGNALS)
d0d6b7c5
JB
4236 signal (signo, sigchld_handler);
4237#endif
4238 errno = old_errno;
4239 return;
4240#endif /* USG, but not HPUX with WNOHANG */
4241 }
4242}
4243\f
4244
4245static Lisp_Object
4246exec_sentinel_unwind (data)
4247 Lisp_Object data;
4248{
70949dac 4249 XPROCESS (XCAR (data))->sentinel = XCDR (data);
d0d6b7c5
JB
4250 return Qnil;
4251}
4252
3b9a3dfa
RS
4253static Lisp_Object
4254exec_sentinel_error_handler (error)
4255 Lisp_Object error;
4256{
4257 cmd_error_internal (error, "error in process sentinel: ");
4258 Vinhibit_quit = Qt;
4259 update_echo_area ();
833ba342 4260 Fsleep_for (make_number (2), Qnil);
8c983bf2 4261 return Qt;
3b9a3dfa
RS
4262}
4263
d0d6b7c5
JB
4264static void
4265exec_sentinel (proc, reason)
4266 Lisp_Object proc, reason;
4267{
dfc21838 4268 Lisp_Object sentinel, obuffer, odeactivate, okeymap;
d0d6b7c5
JB
4269 register struct Lisp_Process *p = XPROCESS (proc);
4270 int count = specpdl_ptr - specpdl;
4da2f5be 4271 int outer_running_asynch_code = running_asynch_code;
bbce7d72 4272 int waiting = waiting_for_user_input_p;
d0d6b7c5 4273
dfc21838
RS
4274 /* No need to gcpro these, because all we do with them later
4275 is test them for EQness, and none of them should be a string. */
8fb3cf64 4276 odeactivate = Vdeactivate_mark;
dfc21838
RS
4277 XSETBUFFER (obuffer, current_buffer);
4278 okeymap = current_buffer->keymap;
4279
d0d6b7c5
JB
4280 sentinel = p->sentinel;
4281 if (NILP (sentinel))
4282 return;
4283
4284 /* Zilch the sentinel while it's running, to avoid recursive invocations;
4285 assure that it gets restored no matter how the sentinel exits. */
4286 p->sentinel = Qnil;
4287 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
4288 /* Inhibit quit so that random quits don't screw up a running filter. */
4289 specbind (Qinhibit_quit, Qt);
6545aada 4290 specbind (Qlast_nonmenu_event, Qt);
3b9a3dfa 4291
4da2f5be
RS
4292 /* In case we get recursively called,
4293 and we already saved the match data nonrecursively,
4294 save the same match data in safely recursive fashion. */
4295 if (outer_running_asynch_code)
4296 {
4297 Lisp_Object tem;
dd130227 4298 tem = Fmatch_data (Qnil, Qnil);
4da2f5be 4299 restore_match_data ();
8f1ecd05
RS
4300 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
4301 Fset_match_data (tem);
4da2f5be
RS
4302 }
4303
4304 /* For speed, if a search happens within this code,
4305 save the match data in a special nonrecursive fashion. */
7074fde6 4306 running_asynch_code = 1;
4da2f5be 4307
3b9a3dfa
RS
4308 internal_condition_case_1 (read_process_output_call,
4309 Fcons (sentinel,
4310 Fcons (proc, Fcons (reason, Qnil))),
4311 !NILP (Vdebug_on_error) ? Qnil : Qerror,
4312 exec_sentinel_error_handler);
4da2f5be
RS
4313
4314 /* If we saved the match data nonrecursively, restore it now. */
7074fde6 4315 restore_match_data ();
4da2f5be 4316 running_asynch_code = outer_running_asynch_code;
8fb3cf64
KH
4317
4318 Vdeactivate_mark = odeactivate;
bbce7d72
RS
4319
4320 /* Restore waiting_for_user_input_p as it was
4321 when we were called, in case the filter clobbered it. */
4322 waiting_for_user_input_p = waiting;
4323
7973cfa8 4324#if 0
dfc21838
RS
4325 if (! EQ (Fcurrent_buffer (), obuffer)
4326 || ! EQ (current_buffer->keymap, okeymap))
7973cfa8 4327#endif
927e08be
RS
4328 /* But do it only if the caller is actually going to read events.
4329 Otherwise there's no need to make him wake up, and it could
4330 cause trouble (for example it would make Fsit_for return). */
4331 if (waiting_for_user_input_p == -1)
4332 record_asynch_buffer_change ();
8fb3cf64 4333
2ea6d561 4334 unbind_to (count, Qnil);
d0d6b7c5
JB
4335}
4336
4337/* Report all recent events of a change in process status
4338 (either run the sentinel or output a message).
4339 This is done while Emacs is waiting for keyboard input. */
4340
6b53bb85 4341void
d0d6b7c5
JB
4342status_notify ()
4343{
4344 register Lisp_Object proc, buffer;
2e4149a8 4345 Lisp_Object tail, msg;
d0d6b7c5
JB
4346 struct gcpro gcpro1, gcpro2;
4347
2e4149a8
KH
4348 tail = Qnil;
4349 msg = Qnil;
d0d6b7c5
JB
4350 /* We need to gcpro tail; if read_process_output calls a filter
4351 which deletes a process and removes the cons to which tail points
4352 from Vprocess_alist, and then causes a GC, tail is an unprotected
4353 reference. */
4354 GCPRO2 (tail, msg);
4355
30623085
RS
4356 /* Set this now, so that if new processes are created by sentinels
4357 that we run, we get called again to handle their status changes. */
4358 update_tick = process_tick;
4359
4360 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
d0d6b7c5 4361 {
30623085
RS
4362 Lisp_Object symbol;
4363 register struct Lisp_Process *p;
4364
4365 proc = Fcdr (Fcar (tail));
4366 p = XPROCESS (proc);
4367
4368 if (XINT (p->tick) != XINT (p->update_tick))
d0d6b7c5 4369 {
30623085 4370 XSETINT (p->update_tick, XINT (p->tick));
d0d6b7c5 4371
30623085 4372 /* If process is still active, read any output that remains. */
4da2f5be
RS
4373 while (! EQ (p->filter, Qt)
4374 && XINT (p->infd) >= 0
4375 && read_process_output (proc, XINT (p->infd)) > 0);
d0d6b7c5 4376
30623085 4377 buffer = p->buffer;
d0d6b7c5 4378
30623085
RS
4379 /* Get the text to use for the message. */
4380 if (!NILP (p->raw_status_low))
4381 update_status (p);
4382 msg = status_message (p->status);
d0d6b7c5 4383
30623085
RS
4384 /* If process is terminated, deactivate it or delete it. */
4385 symbol = p->status;
4386 if (CONSP (p->status))
70949dac 4387 symbol = XCAR (p->status);
d0d6b7c5 4388
30623085
RS
4389 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
4390 || EQ (symbol, Qclosed))
4391 {
4392 if (delete_exited_processes)
4393 remove_process (proc);
4394 else
4395 deactivate_process (proc);
4396 }
d0d6b7c5 4397
0ad61fe7
RS
4398 /* The actions above may have further incremented p->tick.
4399 So set p->update_tick again
4400 so that an error in the sentinel will not cause
4401 this code to be run again. */
4402 XSETINT (p->update_tick, XINT (p->tick));
30623085
RS
4403 /* Now output the message suitably. */
4404 if (!NILP (p->sentinel))
4405 exec_sentinel (proc, msg);
4406 /* Don't bother with a message in the buffer
4407 when a process becomes runnable. */
4408 else if (!EQ (symbol, Qrun) && !NILP (buffer))
4409 {
4410 Lisp_Object ro, tem;
4411 struct buffer *old = current_buffer;
d8a2934e
RS
4412 int opoint, opoint_byte;
4413 int before, before_byte;
2e4149a8 4414
30623085 4415 ro = XBUFFER (buffer)->read_only;
d0d6b7c5 4416
30623085
RS
4417 /* Avoid error if buffer is deleted
4418 (probably that's why the process is dead, too) */
4419 if (NILP (XBUFFER (buffer)->name))
4420 continue;
4421 Fset_buffer (buffer);
12ca5cdf 4422
6ec8bbd2 4423 opoint = PT;
d8a2934e 4424 opoint_byte = PT_BYTE;
30623085
RS
4425 /* Insert new output into buffer
4426 at the current end-of-output marker,
4427 thus preserving logical ordering of input and output. */
4428 if (XMARKER (p->mark)->buffer)
d8a2934e 4429 Fgoto_char (p->mark);
30623085 4430 else
d8a2934e 4431 SET_PT_BOTH (ZV, ZV_BYTE);
12ca5cdf
RS
4432
4433 before = PT;
d8a2934e 4434 before_byte = PT_BYTE;
30623085
RS
4435
4436 tem = current_buffer->read_only;
4437 current_buffer->read_only = Qnil;
4438 insert_string ("\nProcess ");
4439 Finsert (1, &p->name);
4440 insert_string (" ");
4441 Finsert (1, &msg);
4442 current_buffer->read_only = tem;
d8a2934e 4443 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
30623085 4444
12ca5cdf 4445 if (opoint >= before)
d8a2934e
RS
4446 SET_PT_BOTH (opoint + (PT - before),
4447 opoint_byte + (PT_BYTE - before_byte));
12ca5cdf 4448 else
d8a2934e 4449 SET_PT_BOTH (opoint, opoint_byte);
12ca5cdf 4450
30623085 4451 set_buffer_internal (old);
d0d6b7c5 4452 }
30623085
RS
4453 }
4454 } /* end for */
d0d6b7c5
JB
4455
4456 update_mode_lines++; /* in case buffers use %s in mode-line-format */
3007ebfb 4457 redisplay_preserve_echo_area (13);
d0d6b7c5 4458
d0d6b7c5
JB
4459 UNGCPRO;
4460}
0fa1789e
KH
4461
4462\f
4463DEFUN ("set-process-coding-system", Fset_process_coding_system,
4464 Sset_process_coding_system, 1, 3, 0,
7744ca33
KH
4465 "Set coding systems of PROCESS to DECODING and ENCODING.\n\
4466DECODING will be used to decode subprocess output and ENCODING to\n\
4467encode subprocess input.")
0fa1789e
KH
4468 (proc, decoding, encoding)
4469 register Lisp_Object proc, decoding, encoding;
4470{
4471 register struct Lisp_Process *p;
4472
4473 CHECK_PROCESS (proc, 0);
4474 p = XPROCESS (proc);
4475 if (XINT (p->infd) < 0)
4476 error ("Input file descriptor of %s closed", XSTRING (p->name)->data);
4477 if (XINT (p->outfd) < 0)
4478 error ("Output file descriptor of %s closed", XSTRING (p->name)->data);
4479
4480 p->decode_coding_system = Fcheck_coding_system (decoding);
4481 p->encode_coding_system = Fcheck_coding_system (encoding);
4482 setup_coding_system (decoding,
c7580538 4483 proc_decode_coding_system[XINT (p->infd)]);
0fa1789e 4484 setup_coding_system (encoding,
c7580538 4485 proc_encode_coding_system[XINT (p->outfd)]);
0fa1789e
KH
4486
4487 return Qnil;
4488}
4489
4490DEFUN ("process-coding-system",
4491 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
a95c35f6 4492 "Return a cons of coding systems for decoding and encoding of PROCESS.")
0fa1789e
KH
4493 (proc)
4494 register Lisp_Object proc;
4495{
4496 CHECK_PROCESS (proc, 0);
4497 return Fcons (XPROCESS (proc)->decode_coding_system,
4498 XPROCESS (proc)->encode_coding_system);
4499}
d0d6b7c5 4500\f
a69281ff
RS
4501/* The first time this is called, assume keyboard input comes from DESC
4502 instead of from where we used to expect it.
4503 Subsequent calls mean assume input keyboard can come from DESC
4504 in addition to other places. */
4505
4506static int add_keyboard_wait_descriptor_called_flag;
4507
4508void
4509add_keyboard_wait_descriptor (desc)
4510 int desc;
4511{
4512 if (! add_keyboard_wait_descriptor_called_flag)
4513 FD_CLR (0, &input_wait_mask);
4514 add_keyboard_wait_descriptor_called_flag = 1;
4515 FD_SET (desc, &input_wait_mask);
b5dc1c83 4516 FD_SET (desc, &non_process_wait_mask);
a69281ff
RS
4517 if (desc > max_keyboard_desc)
4518 max_keyboard_desc = desc;
4519}
4520
4521/* From now on, do not expect DESC to give keyboard input. */
4522
4523void
4524delete_keyboard_wait_descriptor (desc)
4525 int desc;
4526{
4527 int fd;
4528 int lim = max_keyboard_desc;
4529
4530 FD_CLR (desc, &input_wait_mask);
b5dc1c83 4531 FD_CLR (desc, &non_process_wait_mask);
a69281ff
RS
4532
4533 if (desc == max_keyboard_desc)
4534 for (fd = 0; fd < lim; fd++)
4535 if (FD_ISSET (fd, &input_wait_mask)
4536 && !FD_ISSET (fd, &non_keyboard_wait_mask))
4537 max_keyboard_desc = fd;
4538}
4539
4540/* Return nonzero if *MASK has a bit set
4541 that corresponds to one of the keyboard input descriptors. */
4542
4543int
4544keyboard_bit_set (mask)
4545 SELECT_TYPE *mask;
4546{
4547 int fd;
4548
ee8e09af 4549 for (fd = 0; fd <= max_keyboard_desc; fd++)
a69281ff
RS
4550 if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask)
4551 && !FD_ISSET (fd, &non_keyboard_wait_mask))
4552 return 1;
4553
4554 return 0;
4555}
4556\f
dfcf069d 4557void
d0d6b7c5
JB
4558init_process ()
4559{
4560 register int i;
4561
4562#ifdef SIGCHLD
4563#ifndef CANNOT_DUMP
4564 if (! noninteractive || initialized)
4565#endif
4566 signal (SIGCHLD, sigchld_handler);
4567#endif
4568
4569 FD_ZERO (&input_wait_mask);
a69281ff 4570 FD_ZERO (&non_keyboard_wait_mask);
b5dc1c83 4571 FD_ZERO (&non_process_wait_mask);
7d0e672e 4572 max_process_desc = 0;
dd2281ae 4573
a69281ff 4574 FD_SET (0, &input_wait_mask);
dd2281ae 4575
d0d6b7c5
JB
4576 Vprocess_alist = Qnil;
4577 for (i = 0; i < MAXDESC; i++)
4578 {
4579 chan_process[i] = Qnil;
4580 proc_buffered_char[i] = -1;
4581 }
c7580538
KH
4582 bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
4583 bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
d0d6b7c5 4584}
312c9964 4585
dfcf069d 4586void
d0d6b7c5
JB
4587syms_of_process ()
4588{
d0d6b7c5
JB
4589 Qprocessp = intern ("processp");
4590 staticpro (&Qprocessp);
4591 Qrun = intern ("run");
4592 staticpro (&Qrun);
4593 Qstop = intern ("stop");
4594 staticpro (&Qstop);
4595 Qsignal = intern ("signal");
4596 staticpro (&Qsignal);
4597
4598 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
4599 here again.
4600
4601 Qexit = intern ("exit");
4602 staticpro (&Qexit); */
4603
4604 Qopen = intern ("open");
4605 staticpro (&Qopen);
4606 Qclosed = intern ("closed");
4607 staticpro (&Qclosed);
4608
6545aada
RS
4609 Qlast_nonmenu_event = intern ("last-nonmenu-event");
4610 staticpro (&Qlast_nonmenu_event);
4611
d0d6b7c5
JB
4612 staticpro (&Vprocess_alist);
4613
4614 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
4615 "*Non-nil means delete processes immediately when they exit.\n\
4616nil means don't delete them until `list-processes' is run.");
4617
4618 delete_exited_processes = 1;
4619
4620 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
4621 "Control type of device used to communicate with subprocesses.\n\
e333e864
RS
4622Values are nil to use a pipe, or t or `pty' to use a pty.\n\
4623The value has no effect if the system has no ptys or if all ptys are busy:\n\
4624then a pipe is used in any case.\n\
4625The value takes effect when `start-process' is called.");
d0d6b7c5
JB
4626 Vprocess_connection_type = Qt;
4627
4628 defsubr (&Sprocessp);
4629 defsubr (&Sget_process);
4630 defsubr (&Sget_buffer_process);
4631 defsubr (&Sdelete_process);
4632 defsubr (&Sprocess_status);
4633 defsubr (&Sprocess_exit_status);
4634 defsubr (&Sprocess_id);
4635 defsubr (&Sprocess_name);
3b9a3dfa 4636 defsubr (&Sprocess_tty_name);
d0d6b7c5
JB
4637 defsubr (&Sprocess_command);
4638 defsubr (&Sset_process_buffer);
4639 defsubr (&Sprocess_buffer);
4640 defsubr (&Sprocess_mark);
4641 defsubr (&Sset_process_filter);
4642 defsubr (&Sprocess_filter);
4643 defsubr (&Sset_process_sentinel);
4644 defsubr (&Sprocess_sentinel);
de282a05 4645 defsubr (&Sset_process_window_size);
52a1b894
EZ
4646 defsubr (&Sset_process_inherit_coding_system_flag);
4647 defsubr (&Sprocess_inherit_coding_system_flag);
d0d6b7c5 4648 defsubr (&Sprocess_kill_without_query);
de282a05 4649 defsubr (&Sprocess_contact);
d0d6b7c5
JB
4650 defsubr (&Slist_processes);
4651 defsubr (&Sprocess_list);
4652 defsubr (&Sstart_process);
4653#ifdef HAVE_SOCKETS
4654 defsubr (&Sopen_network_stream);
4655#endif /* HAVE_SOCKETS */
4656 defsubr (&Saccept_process_output);
4657 defsubr (&Sprocess_send_region);
4658 defsubr (&Sprocess_send_string);
4659 defsubr (&Sinterrupt_process);
4660 defsubr (&Skill_process);
4661 defsubr (&Squit_process);
4662 defsubr (&Sstop_process);
4663 defsubr (&Scontinue_process);
b81ea5ef 4664 defsubr (&Sprocess_running_child_p);
d0d6b7c5
JB
4665 defsubr (&Sprocess_send_eof);
4666 defsubr (&Ssignal_process);
4667 defsubr (&Swaiting_for_user_input_p);
4668/* defsubr (&Sprocess_connection); */
0fa1789e
KH
4669 defsubr (&Sset_process_coding_system);
4670 defsubr (&Sprocess_coding_system);
d0d6b7c5
JB
4671}
4672
6720a7fb
JB
4673\f
4674#else /* not subprocesses */
4675
4676#include <sys/types.h>
4677#include <errno.h>
4678
4679#include "lisp.h"
4680#include "systime.h"
52a1b894
EZ
4681#include "charset.h"
4682#include "coding.h"
6720a7fb 4683#include "termopts.h"
81afb6d1 4684#include "sysselect.h"
6720a7fb 4685
ff11dfa1 4686extern int frame_garbaged;
6720a7fb 4687
f694e5d2
KH
4688extern EMACS_TIME timer_check ();
4689extern int timers_run;
6720a7fb
JB
4690
4691/* As described above, except assuming that there are no subprocesses:
4692
4693 Wait for timeout to elapse and/or keyboard input to be available.
4694
4695 time_limit is:
4696 timeout in seconds, or
4697 zero for no limit, or
4698 -1 means gobble data immediately available but don't wait for any.
4699
f76475ad 4700 read_kbd is a Lisp_Object:
6720a7fb
JB
4701 0 to ignore keyboard input, or
4702 1 to return when input is available, or
4703 -1 means caller will actually read the input, so don't throw to
4704 the quit handler.
0a65b032
RS
4705 a cons cell, meaning wait until its car is non-nil
4706 (and gobble terminal input into the buffer if any arrives), or
6720a7fb
JB
4707 We know that read_kbd will never be a Lisp_Process, since
4708 `subprocesses' isn't defined.
4709
4710 do_display != 0 means redisplay should be done to show subprocess
5164ee8e 4711 output that arrives.
6720a7fb 4712
eb8c3be9 4713 Return true iff we received input from any process. */
6720a7fb
JB
4714
4715int
4716wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
f76475ad
JB
4717 int time_limit, microsecs;
4718 Lisp_Object read_kbd;
4719 int do_display;
6720a7fb 4720{
52fd88d3 4721 register int nfds;
f694e5d2 4722 EMACS_TIME end_time, timeout;
8db121c4 4723 SELECT_TYPE waitchannels;
f694e5d2 4724 int xerrno;
0a65b032
RS
4725 Lisp_Object *wait_for_cell = 0;
4726
4727 /* If waiting for non-nil in a cell, record where. */
4728 if (CONSP (read_kbd))
4729 {
70949dac 4730 wait_for_cell = &XCAR (read_kbd);
0a65b032
RS
4731 XSETFASTINT (read_kbd, 0);
4732 }
6720a7fb
JB
4733
4734 /* What does time_limit really mean? */
4735 if (time_limit || microsecs)
4736 {
6720a7fb 4737 EMACS_GET_TIME (end_time);
52fd88d3 4738 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
6720a7fb
JB
4739 EMACS_ADD_TIME (end_time, end_time, timeout);
4740 }
6720a7fb
JB
4741
4742 /* Turn off periodic alarms (in case they are in use)
4743 because the select emulator uses alarms. */
30904ab7 4744 turn_on_atimers (0);
6720a7fb 4745
52fd88d3 4746 while (1)
6720a7fb 4747 {
bae8d137 4748 int timeout_reduced_for_timers = 0;
6720a7fb 4749
6720a7fb
JB
4750 /* If calling from keyboard input, do not quit
4751 since we want to return C-g as an input character.
4752 Otherwise, do pending quit if requested. */
f76475ad 4753 if (XINT (read_kbd) >= 0)
6720a7fb
JB
4754 QUIT;
4755
0a65b032
RS
4756 /* Exit now if the cell we're waiting for became non-nil. */
4757 if (wait_for_cell && ! NILP (*wait_for_cell))
4758 break;
4759
bae8d137
RS
4760 /* Compute time from now till when time limit is up */
4761 /* Exit if already run out */
52fd88d3
EZ
4762 if (time_limit == -1)
4763 {
4764 /* -1 specified for timeout means
4765 gobble output available now
4766 but don't wait at all. */
4767
4768 EMACS_SET_SECS_USECS (timeout, 0, 0);
4769 }
4770 else if (time_limit || microsecs)
6720a7fb 4771 {
f694e5d2
KH
4772 EMACS_GET_TIME (timeout);
4773 EMACS_SUB_TIME (timeout, end_time, timeout);
4774 if (EMACS_TIME_NEG_P (timeout))
6720a7fb
JB
4775 break;
4776 }
52fd88d3
EZ
4777 else
4778 {
4779 EMACS_SET_SECS_USECS (timeout, 100000, 0);
4780 }
6720a7fb 4781
bae8d137
RS
4782 /* If our caller will not immediately handle keyboard events,
4783 run timer events directly.
4784 (Callers that will immediately read keyboard events
4785 call timer_delay on their own.) */
f854a00b 4786 if (! wait_for_cell)
bae8d137
RS
4787 {
4788 EMACS_TIME timer_delay;
0a65b032 4789
9baacf76 4790 do
0a65b032 4791 {
9baacf76
GM
4792 int old_timers_run = timers_run;
4793 timer_delay = timer_check (1);
4794 if (timers_run != old_timers_run && do_display)
4795 /* We must retry, since a timer may have requeued itself
4796 and that could alter the time delay. */
3007ebfb 4797 redisplay_preserve_echo_area (14);
9baacf76
GM
4798 else
4799 break;
0a65b032 4800 }
9baacf76 4801 while (!detect_input_pending ());
0a65b032 4802
52fd88d3
EZ
4803 /* If there is unread keyboard input, also return. */
4804 if (XINT (read_kbd) != 0
4805 && requeued_events_pending_p ())
4806 break;
4807
f694e5d2 4808 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
bae8d137
RS
4809 {
4810 EMACS_TIME difference;
f694e5d2 4811 EMACS_SUB_TIME (difference, timer_delay, timeout);
bae8d137
RS
4812 if (EMACS_TIME_NEG_P (difference))
4813 {
f694e5d2 4814 timeout = timer_delay;
bae8d137
RS
4815 timeout_reduced_for_timers = 1;
4816 }
4817 }
4818 }
4819
6720a7fb
JB
4820 /* Cause C-g and alarm signals to take immediate action,
4821 and cause input available signals to zero out timeout. */
f76475ad 4822 if (XINT (read_kbd) < 0)
6720a7fb
JB
4823 set_waiting_for_input (&timeout);
4824
0a65b032
RS
4825 /* Wait till there is something to do. */
4826
4827 if (! XINT (read_kbd) && wait_for_cell == 0)
4828 FD_ZERO (&waitchannels);
4829 else
4830 FD_SET (0, &waitchannels);
4831
ff11dfa1 4832 /* If a frame has been newly mapped and needs updating,
6720a7fb 4833 reprocess its display stuff. */
5164ee8e 4834 if (frame_garbaged && do_display)
0a65b032
RS
4835 {
4836 clear_waiting_for_input ();
3007ebfb 4837 redisplay_preserve_echo_area (15);
0a65b032
RS
4838 if (XINT (read_kbd) < 0)
4839 set_waiting_for_input (&timeout);
4840 }
6720a7fb 4841
1861b214
RS
4842 if (XINT (read_kbd) && detect_input_pending ())
4843 {
4844 nfds = 0;
4845 FD_ZERO (&waitchannels);
4846 }
4847 else
4848 nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
4849 &timeout);
f694e5d2
KH
4850
4851 xerrno = errno;
6720a7fb
JB
4852
4853 /* Make C-g and alarm signals set flags again */
4854 clear_waiting_for_input ();
4855
4856 /* If we woke up due to SIGWINCH, actually change size now. */
2b653806 4857 do_pending_window_change (0);
6720a7fb 4858
f694e5d2
KH
4859 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
4860 /* We waited the full specified time, so return now. */
4861 break;
4862
6720a7fb
JB
4863 if (nfds == -1)
4864 {
4865 /* If the system call was interrupted, then go around the
4866 loop again. */
f694e5d2 4867 if (xerrno == EINTR)
8db121c4 4868 FD_ZERO (&waitchannels);
f694e5d2 4869 else
68c45bf0 4870 error ("select error: %s", emacs_strerror (xerrno));
6720a7fb
JB
4871 }
4872#ifdef sun
4873 else if (nfds > 0 && (waitchannels & 1) && interrupt_input)
4874 /* System sometimes fails to deliver SIGIO. */
4875 kill (getpid (), SIGIO);
4876#endif
7324d660 4877#ifdef SIGIO
f76475ad 4878 if (XINT (read_kbd) && interrupt_input && (waitchannels & 1))
e643c5be 4879 kill (getpid (), SIGIO);
7324d660 4880#endif
6720a7fb 4881
f694e5d2
KH
4882 /* Check for keyboard input */
4883
f854a00b 4884 if ((XINT (read_kbd) != 0)
f694e5d2
KH
4885 && detect_input_pending_run_timers (do_display))
4886 {
4887 swallow_events (do_display);
4888 if (detect_input_pending_run_timers (do_display))
4889 break;
4890 }
0a65b032 4891
52fd88d3
EZ
4892 /* If there is unread keyboard input, also return. */
4893 if (XINT (read_kbd) != 0
4894 && requeued_events_pending_p ())
4895 break;
4896
f854a00b
RS
4897 /* If wait_for_cell. check for keyboard input
4898 but don't run any timers.
4899 ??? (It seems wrong to me to check for keyboard
4900 input at all when wait_for_cell, but the code
4901 has been this way since July 1994.
4902 Try changing this after version 19.31.) */
4903 if (wait_for_cell
4904 && detect_input_pending ())
4905 {
4906 swallow_events (do_display);
4907 if (detect_input_pending ())
4908 break;
4909 }
4910
0a65b032
RS
4911 /* Exit now if the cell we're waiting for became non-nil. */
4912 if (wait_for_cell && ! NILP (*wait_for_cell))
4913 break;
6720a7fb
JB
4914 }
4915
a87b802f
JB
4916 start_polling ();
4917
6720a7fb
JB
4918 return 0;
4919}
4920
4921
4922DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
51ab806a 4923 /* Don't confuse make-docfile by having two doc strings for this function.
312c9964
RS
4924 make-docfile does not pay attention to #if, for good reason! */
4925 0)
6720a7fb
JB
4926 (name)
4927 register Lisp_Object name;
4928{
4929 return Qnil;
4930}
4931
52a1b894
EZ
4932DEFUN ("process-inherit-coding-system-flag",
4933 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
4934 1, 1, 0,
4935 /* Don't confuse make-docfile by having two doc strings for this function.
4936 make-docfile does not pay attention to #if, for good reason! */
4937 0)
4938 (process)
4939 register Lisp_Object process;
4940{
4941 /* Ignore the argument and return the value of
4942 inherit-process-coding-system. */
4943 return inherit_process_coding_system ? Qt : Qnil;
4944}
4945
6720a7fb
JB
4946/* Kill all processes associated with `buffer'.
4947 If `buffer' is nil, kill all processes.
4948 Since we have no subprocesses, this does nothing. */
4949
d9bb0c32 4950void
6720a7fb
JB
4951kill_buffer_processes (buffer)
4952 Lisp_Object buffer;
4953{
4954}
4955
02b9b4fd 4956void
6720a7fb
JB
4957init_process ()
4958{
4959}
4960
02b9b4fd 4961void
6720a7fb
JB
4962syms_of_process ()
4963{
4964 defsubr (&Sget_buffer_process);
52a1b894 4965 defsubr (&Sprocess_inherit_coding_system_flag);
6720a7fb
JB
4966}
4967
4968\f
4969#endif /* not subprocesses */