(tool-bar-add-item-from-menu): Add autoload cookie.
[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);
418b48fd
KH
1900 }
1901
a319f7c1 1902 freeaddrinfo (res);
418b48fd 1903 if (s < 0)
a319f7c1
KH
1904 {
1905 if (interrupt_input)
1906 request_sigio ();
1907
1908 errno = xerrno;
1909 report_file_error ("connection failed",
1910 Fcons (host, Fcons (name, Qnil)));
1911 }
70dbdb36
GM
1912
1913#else /* not HAVE_GETADDRINFO */
a319f7c1 1914
616da37c
RS
1915 while (1)
1916 {
45f93416 1917#if 0
5f0929a7
RS
1918#ifdef TRY_AGAIN
1919 h_errno = 0;
45f93416 1920#endif
5f0929a7 1921#endif
5d6c2aa3
RS
1922 immediate_quit = 1;
1923 QUIT;
616da37c 1924 host_info_ptr = gethostbyname (XSTRING (host)->data);
5d6c2aa3 1925 immediate_quit = 0;
45f93416 1926#if 0
616da37c
RS
1927#ifdef TRY_AGAIN
1928 if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN))
45f93416 1929#endif
616da37c
RS
1930#endif
1931 break;
1932 Fsleep_for (make_number (1), Qnil);
1933 }
70dbdb36 1934
d0d6b7c5
JB
1935 if (host_info_ptr == 0)
1936 /* Attempt to interpret host as numeric inet address */
1937 {
393a9679 1938 numeric_addr = inet_addr ((char *) XSTRING (host)->data);
79967d5e 1939 if (NUMERIC_ADDR_ERROR)
d0d6b7c5
JB
1940 error ("Unknown host \"%s\"", XSTRING (host)->data);
1941
1942 host_info_ptr = &host_info;
1943 host_info.h_name = 0;
1944 host_info.h_aliases = 0;
1945 host_info.h_addrtype = AF_INET;
39a21be6
JB
1946#ifdef h_addr
1947 /* Older machines have only one address slot called h_addr.
1948 Newer machines have h_addr_list, but #define h_addr to
1949 be its first element. */
1950 host_info.h_addr_list = &(addr_list[0]);
1951#endif
1952 host_info.h_addr = (char*)(&numeric_addr);
d0d6b7c5 1953 addr_list[1] = 0;
8777fbe2
RS
1954 /* numeric_addr isn't null-terminated; it has fixed length. */
1955 host_info.h_length = sizeof (numeric_addr);
d0d6b7c5
JB
1956 }
1957
1958 bzero (&address, sizeof address);
1959 bcopy (host_info_ptr->h_addr, (char *) &address.sin_addr,
1960 host_info_ptr->h_length);
1961 address.sin_family = host_info_ptr->h_addrtype;
1962 address.sin_port = port;
1963
1964 s = socket (host_info_ptr->h_addrtype, SOCK_STREAM, 0);
1965 if (s < 0)
1966 report_file_error ("error creating socket", Fcons (name, Qnil));
1967
5684cd6e
AS
1968 count1 = specpdl_ptr - specpdl;
1969 record_unwind_protect (close_file_unwind, make_number (s));
1970
457a9bee
RS
1971 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1972 when connect is interrupted. So let's not let it get interrupted.
1973 Note we do not turn off polling, because polling is only used
1974 when not interrupt_input, and thus not normally used on the systems
1975 which have this bug. On systems which use polling, there's no way
1976 to quit if polling is turned off. */
1977 if (interrupt_input)
1978 unrequest_sigio ();
1979
d0d6b7c5 1980 loop:
0f2ee0c1
RS
1981
1982 immediate_quit = 1;
1983 QUIT;
1984
e333e864
RS
1985 if (connect (s, (struct sockaddr *) &address, sizeof address) == -1
1986 && errno != EISCONN)
d0d6b7c5
JB
1987 {
1988 int xerrno = errno;
e333e864 1989
0f2ee0c1
RS
1990 immediate_quit = 0;
1991
d0d6b7c5
JB
1992 if (errno == EINTR)
1993 goto loop;
e333e864
RS
1994 if (errno == EADDRINUSE && retry < 20)
1995 {
4590788a
RS
1996 /* A delay here is needed on some FreeBSD systems,
1997 and it is harmless, since this retrying takes time anyway
1998 and should be infrequent. */
1999 Fsleep_for (make_number (1), Qnil);
e333e864
RS
2000 retry++;
2001 goto loop;
2002 }
2003
5684cd6e
AS
2004 /* Discard the unwind protect. */
2005 specpdl_ptr = specpdl + count1;
2006
68c45bf0 2007 emacs_close (s);
457a9bee
RS
2008
2009 if (interrupt_input)
2010 request_sigio ();
2011
d0d6b7c5
JB
2012 errno = xerrno;
2013 report_file_error ("connection failed",
2014 Fcons (host, Fcons (name, Qnil)));
2015 }
70dbdb36
GM
2016
2017#endif /* not HAVE_GETADDRINFO */
457a9bee 2018
0f2ee0c1
RS
2019 immediate_quit = 0;
2020
70dbdb36 2021 /* Discard the unwind protect, if any. */
5684cd6e
AS
2022 specpdl_ptr = specpdl + count1;
2023
44ade2e9
RS
2024#ifdef POLL_FOR_INPUT
2025 unbind_to (count, Qnil);
2026#endif
2027
457a9bee
RS
2028 if (interrupt_input)
2029 request_sigio ();
2030
1d2c16fa
RS
2031#else /* TERM */
2032 s = connect_server (0);
2033 if (s < 0)
2034 report_file_error ("error creating socket", Fcons (name, Qnil));
2035 send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port));
2036 send_command (s, C_DUMB, 1, 0);
2037#endif /* TERM */
d0d6b7c5
JB
2038
2039 inch = s;
59f23005 2040 outch = s;
d0d6b7c5
JB
2041
2042 if (!NILP (buffer))
2043 buffer = Fget_buffer_create (buffer);
2044 proc = make_process (name);
2045
2046 chan_process[inch] = proc;
2047
2048#ifdef O_NONBLOCK
2049 fcntl (inch, F_SETFL, O_NONBLOCK);
2050#else
2051#ifdef O_NDELAY
2052 fcntl (inch, F_SETFL, O_NDELAY);
2053#endif
2054#endif
2055
de282a05 2056 XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));
d0d6b7c5
JB
2057 XPROCESS (proc)->command_channel_p = Qnil;
2058 XPROCESS (proc)->buffer = buffer;
2059 XPROCESS (proc)->sentinel = Qnil;
2060 XPROCESS (proc)->filter = Qnil;
2061 XPROCESS (proc)->command = Qnil;
2062 XPROCESS (proc)->pid = Qnil;
7795ff9b 2063 XSETINT (XPROCESS (proc)->infd, inch);
1d056e64 2064 XSETINT (XPROCESS (proc)->outfd, outch);
d0d6b7c5
JB
2065 XPROCESS (proc)->status = Qrun;
2066 FD_SET (inch, &input_wait_mask);
a69281ff 2067 FD_SET (inch, &non_keyboard_wait_mask);
7d0e672e
RS
2068 if (inch > max_process_desc)
2069 max_process_desc = inch;
d0d6b7c5 2070
67918941
RS
2071 {
2072 /* Setup coding systems for communicating with the network stream. */
2073 struct gcpro gcpro1;
2074 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2075 Lisp_Object coding_systems = Qt;
2076 Lisp_Object args[5], val;
2077
2078 if (!NILP (Vcoding_system_for_read))
2079 val = Vcoding_system_for_read;
41d03b9a
GM
2080 else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
2081 || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
67918941
RS
2082 /* We dare not decode end-of-line format by setting VAL to
2083 Qraw_text, because the existing Emacs Lisp libraries
2084 assume that they receive bare code including a sequene of
2085 CR LF. */
2086 val = Qnil;
2087 else
2088 {
2089 args[0] = Qopen_network_stream, args[1] = name,
2090 args[2] = buffer, args[3] = host, args[4] = service;
2091 GCPRO1 (proc);
2092 coding_systems = Ffind_operation_coding_system (5, args);
2093 UNGCPRO;
2094 if (CONSP (coding_systems))
70949dac 2095 val = XCAR (coding_systems);
67918941 2096 else if (CONSP (Vdefault_process_coding_system))
70949dac 2097 val = XCAR (Vdefault_process_coding_system);
67918941
RS
2098 else
2099 val = Qnil;
2100 }
2101 XPROCESS (proc)->decode_coding_system = val;
0fa1789e 2102
67918941
RS
2103 if (!NILP (Vcoding_system_for_write))
2104 val = Vcoding_system_for_write;
2105 else if (NILP (current_buffer->enable_multibyte_characters))
2106 val = Qnil;
2107 else
2108 {
2109 if (EQ (coding_systems, Qt))
2110 {
2111 args[0] = Qopen_network_stream, args[1] = name,
2112 args[2] = buffer, args[3] = host, args[4] = service;
2113 GCPRO1 (proc);
2114 coding_systems = Ffind_operation_coding_system (5, args);
2115 UNGCPRO;
2116 }
2117 if (CONSP (coding_systems))
70949dac 2118 val = XCDR (coding_systems);
67918941 2119 else if (CONSP (Vdefault_process_coding_system))
70949dac 2120 val = XCDR (Vdefault_process_coding_system);
67918941
RS
2121 else
2122 val = Qnil;
2123 }
2124 XPROCESS (proc)->encode_coding_system = val;
2125 }
0fa1789e 2126
c7580538
KH
2127 if (!proc_decode_coding_system[inch])
2128 proc_decode_coding_system[inch]
2129 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
0fa1789e 2130 setup_coding_system (XPROCESS (proc)->decode_coding_system,
c7580538
KH
2131 proc_decode_coding_system[inch]);
2132 if (!proc_encode_coding_system[outch])
2133 proc_encode_coding_system[outch]
2134 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
0fa1789e 2135 setup_coding_system (XPROCESS (proc)->encode_coding_system,
c7580538 2136 proc_encode_coding_system[outch]);
0fa1789e
KH
2137
2138 XPROCESS (proc)->decoding_buf = make_uninit_string (0);
e7fbaa65 2139 XPROCESS (proc)->decoding_carryover = make_number (0);
0fa1789e 2140 XPROCESS (proc)->encoding_buf = make_uninit_string (0);
e7fbaa65 2141 XPROCESS (proc)->encoding_carryover = make_number (0);
0fa1789e 2142
aa91317a
RS
2143 XPROCESS (proc)->inherit_coding_system_flag
2144 = (NILP (buffer) || !inherit_process_coding_system
2145 ? Qnil : Qt);
52a1b894 2146
d0d6b7c5
JB
2147 UNGCPRO;
2148 return proc;
2149}
2150#endif /* HAVE_SOCKETS */
2151
6b53bb85 2152void
d0d6b7c5
JB
2153deactivate_process (proc)
2154 Lisp_Object proc;
2155{
2156 register int inchannel, outchannel;
2157 register struct Lisp_Process *p = XPROCESS (proc);
2158
a9f2c884
RS
2159 inchannel = XINT (p->infd);
2160 outchannel = XINT (p->outfd);
d0d6b7c5 2161
a9f2c884 2162 if (inchannel >= 0)
d0d6b7c5
JB
2163 {
2164 /* Beware SIGCHLD hereabouts. */
2165 flush_pending_output (inchannel);
2166#ifdef VMS
2167 {
2168 VMS_PROC_STUFF *get_vms_process_pointer (), *vs;
2169 sys$dassgn (outchannel);
c6c6865d 2170 vs = get_vms_process_pointer (p->pid);
d0d6b7c5
JB
2171 if (vs)
2172 give_back_vms_process_stuff (vs);
2173 }
2174#else
68c45bf0 2175 emacs_close (inchannel);
a9f2c884 2176 if (outchannel >= 0 && outchannel != inchannel)
68c45bf0 2177 emacs_close (outchannel);
d0d6b7c5
JB
2178#endif
2179
1d056e64
KH
2180 XSETINT (p->infd, -1);
2181 XSETINT (p->outfd, -1);
d0d6b7c5
JB
2182 chan_process[inchannel] = Qnil;
2183 FD_CLR (inchannel, &input_wait_mask);
a69281ff 2184 FD_CLR (inchannel, &non_keyboard_wait_mask);
7d0e672e
RS
2185 if (inchannel == max_process_desc)
2186 {
2187 int i;
2188 /* We just closed the highest-numbered process input descriptor,
2189 so recompute the highest-numbered one now. */
2190 max_process_desc = 0;
2191 for (i = 0; i < MAXDESC; i++)
2192 if (!NILP (chan_process[i]))
2193 max_process_desc = i;
2194 }
d0d6b7c5
JB
2195 }
2196}
2197
2198/* Close all descriptors currently in use for communication
2199 with subprocess. This is used in a newly-forked subprocess
2200 to get rid of irrelevant descriptors. */
2201
6b53bb85 2202void
d0d6b7c5
JB
2203close_process_descs ()
2204{
e98d950b 2205#ifndef WINDOWSNT
d0d6b7c5
JB
2206 int i;
2207 for (i = 0; i < MAXDESC; i++)
2208 {
2209 Lisp_Object process;
2210 process = chan_process[i];
2211 if (!NILP (process))
2212 {
a9f2c884
RS
2213 int in = XINT (XPROCESS (process)->infd);
2214 int out = XINT (XPROCESS (process)->outfd);
2215 if (in >= 0)
68c45bf0 2216 emacs_close (in);
a9f2c884 2217 if (out >= 0 && in != out)
68c45bf0 2218 emacs_close (out);
d0d6b7c5
JB
2219 }
2220 }
e98d950b 2221#endif
d0d6b7c5
JB
2222}
2223\f
2224DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
2225 0, 3, 0,
2226 "Allow any pending output from subprocesses to be read by Emacs.\n\
2227It is read into the process' buffers or given to their filter functions.\n\
2228Non-nil arg PROCESS means do not return until some output has been received\n\
2229from PROCESS.\n\
2230Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\
2231seconds and microseconds to wait; return after that much time whether\n\
2232or not there is input.\n\
2233Return non-nil iff we received any output before the timeout expired.")
4ee3e309
EN
2234 (process, timeout, timeout_msecs)
2235 register Lisp_Object process, timeout, timeout_msecs;
d0d6b7c5
JB
2236{
2237 int seconds;
2238 int useconds;
2239
0748d150
RS
2240 if (! NILP (process))
2241 CHECK_PROCESS (process, 0);
2242
d0d6b7c5
JB
2243 if (! NILP (timeout_msecs))
2244 {
2245 CHECK_NUMBER (timeout_msecs, 2);
2246 useconds = XINT (timeout_msecs);
bcd69aea 2247 if (!INTEGERP (timeout))
1d056e64 2248 XSETINT (timeout, 0);
d0d6b7c5
JB
2249
2250 {
2251 int carry = useconds / 1000000;
2252
2253 XSETINT (timeout, XINT (timeout) + carry);
2254 useconds -= carry * 1000000;
2255
2256 /* I think this clause is necessary because C doesn't
2257 guarantee a particular rounding direction for negative
2258 integers. */
2259 if (useconds < 0)
2260 {
2261 XSETINT (timeout, XINT (timeout) - 1);
2262 useconds += 1000000;
2263 }
2264 }
2265 }
de946e5a
RS
2266 else
2267 useconds = 0;
d0d6b7c5
JB
2268
2269 if (! NILP (timeout))
2270 {
2271 CHECK_NUMBER (timeout, 1);
2272 seconds = XINT (timeout);
ada9a4fd 2273 if (seconds < 0 || (seconds == 0 && useconds == 0))
d0d6b7c5
JB
2274 seconds = -1;
2275 }
2276 else
2277 {
4ee3e309 2278 if (NILP (process))
d0d6b7c5
JB
2279 seconds = -1;
2280 else
2281 seconds = 0;
2282 }
2283
4ee3e309
EN
2284 if (NILP (process))
2285 XSETFASTINT (process, 0);
f76475ad 2286
d0d6b7c5 2287 return
4ee3e309 2288 (wait_reading_process_input (seconds, useconds, process, 0)
d0d6b7c5
JB
2289 ? Qt : Qnil);
2290}
2291
2292/* This variable is different from waiting_for_input in keyboard.c.
2293 It is used to communicate to a lisp process-filter/sentinel (via the
2294 function Fwaiting_for_user_input_p below) whether emacs was waiting
2295 for user-input when that process-filter was called.
2296 waiting_for_input cannot be used as that is by definition 0 when
d430ee71
RS
2297 lisp code is being evalled.
2298 This is also used in record_asynch_buffer_change.
2299 For that purpose, this must be 0
2300 when not inside wait_reading_process_input. */
d0d6b7c5
JB
2301static int waiting_for_user_input_p;
2302
c573ae8e 2303/* This is here so breakpoints can be put on it. */
dfcf069d 2304static void
c573ae8e
RS
2305wait_reading_process_input_1 ()
2306{
2307}
2308
d0d6b7c5
JB
2309/* Read and dispose of subprocess output while waiting for timeout to
2310 elapse and/or keyboard input to be available.
2311
de6fd4b9 2312 TIME_LIMIT is:
d0d6b7c5
JB
2313 timeout in seconds, or
2314 zero for no limit, or
2315 -1 means gobble data immediately available but don't wait for any.
2316
de6fd4b9
RS
2317 MICROSECS is:
2318 an additional duration to wait, measured in microseconds.
2319 If this is nonzero and time_limit is 0, then the timeout
2320 consists of MICROSECS only.
6e4f3667 2321
de6fd4b9 2322 READ_KBD is a lisp value:
d0d6b7c5
JB
2323 0 to ignore keyboard input, or
2324 1 to return when input is available, or
84aa3ace 2325 -1 meaning caller will actually read the input, so don't throw to
d0d6b7c5 2326 the quit handler, or
e6194ffc 2327 a cons cell, meaning wait until its car is non-nil
de6fd4b9 2328 (and gobble terminal input into the buffer if any arrives), or
f76475ad
JB
2329 a process object, meaning wait until something arrives from that
2330 process. The return value is true iff we read some input from
2331 that process.
d0d6b7c5 2332
de6fd4b9 2333 DO_DISPLAY != 0 means redisplay should be done to show subprocess
d0d6b7c5
JB
2334 output that arrives.
2335
de6fd4b9 2336 If READ_KBD is a pointer to a struct Lisp_Process, then the
d0d6b7c5
JB
2337 function returns true iff we received input from that process
2338 before the timeout elapsed.
eb8c3be9 2339 Otherwise, return true iff we received input from any process. */
d0d6b7c5 2340
dfcf069d 2341int
d0d6b7c5 2342wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
f76475ad
JB
2343 int time_limit, microsecs;
2344 Lisp_Object read_kbd;
2345 int do_display;
d0d6b7c5 2346{
41d03b9a 2347 register int channel, nfds;
d0d6b7c5
JB
2348 static SELECT_TYPE Available;
2349 int xerrno;
2350 Lisp_Object proc;
41d03b9a 2351 EMACS_TIME timeout, end_time;
d0d6b7c5 2352 SELECT_TYPE Atemp;
a9f2c884 2353 int wait_channel = -1;
d0d6b7c5
JB
2354 struct Lisp_Process *wait_proc = 0;
2355 int got_some_input = 0;
84aa3ace 2356 Lisp_Object *wait_for_cell = 0;
d0d6b7c5
JB
2357
2358 FD_ZERO (&Available);
2359
f76475ad
JB
2360 /* If read_kbd is a process to watch, set wait_proc and wait_channel
2361 accordingly. */
bcd69aea 2362 if (PROCESSP (read_kbd))
d0d6b7c5 2363 {
f76475ad 2364 wait_proc = XPROCESS (read_kbd);
a9f2c884 2365 wait_channel = XINT (wait_proc->infd);
22719df2 2366 XSETFASTINT (read_kbd, 0);
d0d6b7c5
JB
2367 }
2368
84aa3ace 2369 /* If waiting for non-nil in a cell, record where. */
bcd69aea 2370 if (CONSP (read_kbd))
84aa3ace 2371 {
70949dac 2372 wait_for_cell = &XCAR (read_kbd);
22719df2 2373 XSETFASTINT (read_kbd, 0);
84aa3ace
RS
2374 }
2375
f76475ad 2376 waiting_for_user_input_p = XINT (read_kbd);
d0d6b7c5
JB
2377
2378 /* Since we may need to wait several times,
2379 compute the absolute time to return at. */
2380 if (time_limit || microsecs)
2381 {
2382 EMACS_GET_TIME (end_time);
2383 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
2384 EMACS_ADD_TIME (end_time, end_time, timeout);
2385 }
e07d5449
KH
2386#ifdef hpux
2387 /* AlainF 5-Jul-1996
2388 HP-UX 10.10 seem to have problems with signals coming in
2389 Causes "poll: interrupted system call" messages when Emacs is run
2390 in an X window
2391 Turn off periodic alarms (in case they are in use) */
30904ab7 2392 turn_on_atimers (0);
e07d5449 2393#endif
d0d6b7c5 2394
d0d6b7c5
JB
2395 while (1)
2396 {
c0239a0b
RS
2397 int timeout_reduced_for_timers = 0;
2398
d0d6b7c5
JB
2399 /* If calling from keyboard input, do not quit
2400 since we want to return C-g as an input character.
2401 Otherwise, do pending quit if requested. */
f76475ad 2402 if (XINT (read_kbd) >= 0)
d0d6b7c5
JB
2403 QUIT;
2404
889255b4
RS
2405 /* Exit now if the cell we're waiting for became non-nil. */
2406 if (wait_for_cell && ! NILP (*wait_for_cell))
2407 break;
2408
d0d6b7c5
JB
2409 /* Compute time from now till when time limit is up */
2410 /* Exit if already run out */
2411 if (time_limit == -1)
2412 {
2413 /* -1 specified for timeout means
2414 gobble output available now
2415 but don't wait at all. */
2416
2417 EMACS_SET_SECS_USECS (timeout, 0, 0);
2418 }
2419 else if (time_limit || microsecs)
2420 {
2421 EMACS_GET_TIME (timeout);
2422 EMACS_SUB_TIME (timeout, end_time, timeout);
2423 if (EMACS_TIME_NEG_P (timeout))
2424 break;
2425 }
2426 else
2427 {
2428 EMACS_SET_SECS_USECS (timeout, 100000, 0);
2429 }
2430
f854a00b
RS
2431 /* Normally we run timers here.
2432 But not if wait_for_cell; in those cases,
2433 the wait is supposed to be short,
2434 and those callers cannot handle running arbitrary Lisp code here. */
2435 if (! wait_for_cell)
fb4c3627 2436 {
c0239a0b 2437 EMACS_TIME timer_delay;
c573ae8e
RS
2438 int old_timers_run;
2439
2440 retry:
2441 old_timers_run = timers_run;
c0239a0b 2442 timer_delay = timer_check (1);
5de50bfb 2443 if (timers_run != old_timers_run && do_display)
c573ae8e
RS
2444 {
2445 redisplay_preserve_echo_area ();
2446 /* We must retry, since a timer may have requeued itself
2447 and that could alter the time_delay. */
2448 goto retry;
2449 }
2450
69645afc
RS
2451 /* If there is unread keyboard input, also return. */
2452 if (XINT (read_kbd) != 0
2453 && requeued_events_pending_p ())
2454 break;
2455
c0239a0b 2456 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
fb4c3627
RS
2457 {
2458 EMACS_TIME difference;
2459 EMACS_SUB_TIME (difference, timer_delay, timeout);
2460 if (EMACS_TIME_NEG_P (difference))
c0239a0b
RS
2461 {
2462 timeout = timer_delay;
2463 timeout_reduced_for_timers = 1;
2464 }
fb4c3627 2465 }
4abca5e7
RS
2466 /* If time_limit is -1, we are not going to wait at all. */
2467 else if (time_limit != -1)
c573ae8e
RS
2468 {
2469 /* This is so a breakpoint can be put here. */
2470 wait_reading_process_input_1 ();
2471 }
fb4c3627
RS
2472 }
2473
90ab1a81
JB
2474 /* Cause C-g and alarm signals to take immediate action,
2475 and cause input available signals to zero out timeout.
2476
2477 It is important that we do this before checking for process
2478 activity. If we get a SIGCHLD after the explicit checks for
2479 process activity, timeout is the only way we will know. */
2480 if (XINT (read_kbd) < 0)
2481 set_waiting_for_input (&timeout);
2482
6be429b1
JB
2483 /* If status of something has changed, and no input is
2484 available, notify the user of the change right away. After
2485 this explicit check, we'll let the SIGCHLD handler zap
2486 timeout to get our attention. */
2487 if (update_tick != process_tick && do_display)
2488 {
2489 Atemp = input_wait_mask;
2490 EMACS_SET_SECS_USECS (timeout, 0, 0);
0c9960e9
RS
2491 if ((select (max (max_process_desc, max_keyboard_desc) + 1,
2492 &Atemp, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
ecd1f654
KH
2493 &timeout)
2494 <= 0))
90ab1a81
JB
2495 {
2496 /* It's okay for us to do this and then continue with
a0e4d3f3 2497 the loop, since timeout has already been zeroed out. */
90ab1a81
JB
2498 clear_waiting_for_input ();
2499 status_notify ();
2500 }
6be429b1
JB
2501 }
2502
2503 /* Don't wait for output from a non-running process. */
2504 if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
2505 update_status (wait_proc);
2506 if (wait_proc != 0
2507 && ! EQ (wait_proc->status, Qrun))
9aa2a7f4 2508 {
215b45e9 2509 int nread, total_nread = 0;
7ce63188 2510
9aa2a7f4 2511 clear_waiting_for_input ();
7ce63188
RS
2512 XSETPROCESS (proc, wait_proc);
2513
2514 /* Read data from the process, until we exhaust it. */
e1b37c34 2515 while (XINT (wait_proc->infd) >= 0)
215b45e9 2516 {
e1b37c34
GM
2517 nread = read_process_output (proc, XINT (wait_proc->infd));
2518
2519 if (nread == 0)
2520 break;
2521
215b45e9
RS
2522 if (0 < nread)
2523 total_nread += nread;
2524#ifdef EIO
2525 else if (nread == -1 && EIO == errno)
2526 break;
e1b37c34
GM
2527#endif
2528#ifdef EAGAIN
2529 else if (nread == -1 && EAGAIN == errno)
2530 break;
2531#endif
2532#ifdef EWOULDBLOCK
2533 else if (nread == -1 && EWOULDBLOCK == errno)
2534 break;
215b45e9
RS
2535#endif
2536 }
7ce63188
RS
2537 if (total_nread > 0 && do_display)
2538 redisplay_preserve_echo_area ();
2539
9aa2a7f4
JB
2540 break;
2541 }
6be429b1 2542
d0d6b7c5
JB
2543 /* Wait till there is something to do */
2544
b5dc1c83
RS
2545 if (wait_for_cell)
2546 Available = non_process_wait_mask;
2547 else if (! XINT (read_kbd))
a69281ff
RS
2548 Available = non_keyboard_wait_mask;
2549 else
2550 Available = input_wait_mask;
d0d6b7c5 2551
ff11dfa1 2552 /* If frame size has changed or the window is newly mapped,
ffd56f97
JB
2553 redisplay now, before we start to wait. There is a race
2554 condition here; if a SIGIO arrives between now and the select
016899c0
JB
2555 and indicates that a frame is trashed, the select may block
2556 displaying a trashed screen. */
5164ee8e 2557 if (frame_garbaged && do_display)
7286affd
RS
2558 {
2559 clear_waiting_for_input ();
2560 redisplay_preserve_echo_area ();
2561 if (XINT (read_kbd) < 0)
7efe788e 2562 set_waiting_for_input (&timeout);
7286affd 2563 }
ffd56f97 2564
0a65b032
RS
2565 if (XINT (read_kbd) && detect_input_pending ())
2566 {
2567 nfds = 0;
2568 FD_ZERO (&Available);
2569 }
2570 else
0c9960e9
RS
2571 nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
2572 &Available, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
0a65b032 2573 &timeout);
6720a7fb 2574
d0d6b7c5
JB
2575 xerrno = errno;
2576
2577 /* Make C-g and alarm signals set flags again */
2578 clear_waiting_for_input ();
2579
2580 /* If we woke up due to SIGWINCH, actually change size now. */
2b653806 2581 do_pending_window_change (0);
d0d6b7c5 2582
c0239a0b
RS
2583 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
2584 /* We wanted the full specified time, so return now. */
d0d6b7c5
JB
2585 break;
2586 if (nfds < 0)
2587 {
2588 if (xerrno == EINTR)
2589 FD_ZERO (&Available);
b0310da4
JB
2590#ifdef ultrix
2591 /* Ultrix select seems to return ENOMEM when it is
2592 interrupted. Treat it just like EINTR. Bleah. Note
2593 that we want to test for the "ultrix" CPP symbol, not
2594 "__ultrix__"; the latter is only defined under GCC, but
2595 not by DEC's bundled CC. -JimB */
8058415c
JB
2596 else if (xerrno == ENOMEM)
2597 FD_ZERO (&Available);
2598#endif
d0d6b7c5
JB
2599#ifdef ALLIANT
2600 /* This happens for no known reason on ALLIANT.
2601 I am guessing that this is the right response. -- RMS. */
2602 else if (xerrno == EFAULT)
2603 FD_ZERO (&Available);
2604#endif
2605 else if (xerrno == EBADF)
2606 {
2607#ifdef AIX
2608 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
2609 the child's closure of the pts gives the parent a SIGHUP, and
2610 the ptc file descriptor is automatically closed,
2611 yielding EBADF here or at select() call above.
2612 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
a0e4d3f3 2613 in m/ibmrt-aix.h), and here we just ignore the select error.
d0d6b7c5 2614 Cleanup occurs c/o status_notify after SIGCLD. */
ffd56f97 2615 FD_ZERO (&Available); /* Cannot depend on values returned */
d0d6b7c5
JB
2616#else
2617 abort ();
2618#endif
2619 }
2620 else
68c45bf0 2621 error ("select error: %s", emacs_strerror (xerrno));
d0d6b7c5 2622 }
26ec91de 2623#if defined(sun) && !defined(USG5_4)
a69281ff 2624 else if (nfds > 0 && keyboard_bit_set (&Available)
dd2281ae 2625 && interrupt_input)
e0109153
JB
2626 /* System sometimes fails to deliver SIGIO.
2627
2628 David J. Mackenzie says that Emacs doesn't compile under
2629 Solaris if this code is enabled, thus the USG5_4 in the CPP
2630 conditional. "I haven't noticed any ill effects so far.
2631 If you find a Solaris expert somewhere, they might know
2632 better." */
d0d6b7c5
JB
2633 kill (getpid (), SIGIO);
2634#endif
2635
5d5beb62
RS
2636#if 0 /* When polling is used, interrupt_input is 0,
2637 so get_input_pending should read the input.
2638 So this should not be needed. */
2639 /* If we are using polling for input,
2640 and we see input available, make it get read now.
2641 Otherwise it might not actually get read for a second.
2642 And on hpux, since we turn off polling in wait_reading_process_input,
2643 it might never get read at all if we don't spend much time
2644 outside of wait_reading_process_input. */
2645 if (XINT (read_kbd) && interrupt_input
2646 && keyboard_bit_set (&Available)
2647 && input_polling_used ())
2648 kill (getpid (), SIGALRM);
2649#endif
2650
d0d6b7c5
JB
2651 /* Check for keyboard input */
2652 /* If there is any, return immediately
2653 to give it higher priority than subprocesses */
2654
77e1b3d4 2655 if (XINT (read_kbd) != 0
5d6c2aa3 2656 && detect_input_pending_run_timers (do_display))
6ed6233b
KH
2657 {
2658 swallow_events (do_display);
5d6c2aa3 2659 if (detect_input_pending_run_timers (do_display))
6ed6233b
KH
2660 break;
2661 }
2662
69645afc
RS
2663 /* If there is unread keyboard input, also return. */
2664 if (XINT (read_kbd) != 0
2665 && requeued_events_pending_p ())
2666 break;
2667
77e1b3d4
RS
2668 /* If we are not checking for keyboard input now,
2669 do process events (but don't run any timers).
2670 This is so that X events will be processed.
0c9960e9 2671 Otherwise they may have to wait until polling takes place.
77e1b3d4
RS
2672 That would causes delays in pasting selections, for example.
2673
2674 (We used to do this only if wait_for_cell.) */
2675 if (XINT (read_kbd) == 0 && detect_input_pending ())
f854a00b
RS
2676 {
2677 swallow_events (do_display);
0c9960e9 2678#if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
f854a00b
RS
2679 if (detect_input_pending ())
2680 break;
5d5beb62 2681#endif
0c9960e9 2682 }
f854a00b 2683
84aa3ace
RS
2684 /* Exit now if the cell we're waiting for became non-nil. */
2685 if (wait_for_cell && ! NILP (*wait_for_cell))
2686 break;
2687
4746118a 2688#ifdef SIGIO
5d5beb62 2689 /* If we think we have keyboard input waiting, but didn't get SIGIO,
d0d6b7c5
JB
2690 go read it. This can happen with X on BSD after logging out.
2691 In that case, there really is no input and no SIGIO,
2692 but select says there is input. */
2693
dd2281ae 2694 if (XINT (read_kbd) && interrupt_input
5d5beb62 2695 && keyboard_bit_set (&Available))
e643c5be 2696 kill (getpid (), SIGIO);
4746118a 2697#endif
d0d6b7c5 2698
d0d6b7c5
JB
2699 if (! wait_proc)
2700 got_some_input |= nfds > 0;
2701
32676c08
JB
2702 /* If checking input just got us a size-change event from X,
2703 obey it now if we should. */
97f3b3d6 2704 if (XINT (read_kbd) || wait_for_cell)
2b653806 2705 do_pending_window_change (0);
32676c08 2706
a9f2c884
RS
2707 /* Check for data from a process. */
2708 /* Really FIRST_PROC_DESC should be 0 on Unix,
2709 but this is safer in the short run. */
a69281ff 2710 for (channel = 0; channel <= max_process_desc; channel++)
d0d6b7c5 2711 {
a69281ff
RS
2712 if (FD_ISSET (channel, &Available)
2713 && FD_ISSET (channel, &non_keyboard_wait_mask))
d0d6b7c5
JB
2714 {
2715 int nread;
2716
2717 /* If waiting for this channel, arrange to return as
2718 soon as no more input to be processed. No more
2719 waiting. */
2720 if (wait_channel == channel)
2721 {
a9f2c884 2722 wait_channel = -1;
d0d6b7c5
JB
2723 time_limit = -1;
2724 got_some_input = 1;
2725 }
2726 proc = chan_process[channel];
2727 if (NILP (proc))
2728 continue;
2729
d0d6b7c5
JB
2730 /* Read data from the process, starting with our
2731 buffered-ahead character if we have one. */
2732
2733 nread = read_process_output (proc, channel);
2734 if (nread > 0)
2735 {
2736 /* Since read_process_output can run a filter,
2737 which can call accept-process-output,
2738 don't try to read from any other processes
2739 before doing the select again. */
2740 FD_ZERO (&Available);
2741
2742 if (do_display)
2743 redisplay_preserve_echo_area ();
2744 }
2745#ifdef EWOULDBLOCK
2746 else if (nread == -1 && errno == EWOULDBLOCK)
2747 ;
0b75e9a4 2748#endif
89d7280d
RS
2749 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
2750 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
d0d6b7c5
JB
2751#ifdef O_NONBLOCK
2752 else if (nread == -1 && errno == EAGAIN)
2753 ;
2754#else
2755#ifdef O_NDELAY
2756 else if (nread == -1 && errno == EAGAIN)
2757 ;
2758 /* Note that we cannot distinguish between no input
2759 available now and a closed pipe.
2760 With luck, a closed pipe will be accompanied by
2761 subprocess termination and SIGCHLD. */
2762 else if (nread == 0 && !NETCONN_P (proc))
2763 ;
ffd56f97
JB
2764#endif /* O_NDELAY */
2765#endif /* O_NONBLOCK */
d0d6b7c5
JB
2766#ifdef HAVE_PTYS
2767 /* On some OSs with ptys, when the process on one end of
2768 a pty exits, the other end gets an error reading with
2769 errno = EIO instead of getting an EOF (0 bytes read).
2770 Therefore, if we get an error reading and errno =
2771 EIO, just continue, because the child process has
2772 exited and should clean itself up soon (e.g. when we
5651af6d
RS
2773 get a SIGCHLD).
2774
2775 However, it has been known to happen that the SIGCHLD
2776 got lost. So raise the signl again just in case.
2777 It can't hurt. */
d0d6b7c5 2778 else if (nread == -1 && errno == EIO)
5651af6d 2779 kill (getpid (), SIGCHLD);
ffd56f97
JB
2780#endif /* HAVE_PTYS */
2781 /* If we can detect process termination, don't consider the process
2782 gone just because its pipe is closed. */
d0d6b7c5
JB
2783#ifdef SIGCHLD
2784 else if (nread == 0 && !NETCONN_P (proc))
2785 ;
2786#endif
2787 else
2788 {
2789 /* Preserve status of processes already terminated. */
2790 XSETINT (XPROCESS (proc)->tick, ++process_tick);
2791 deactivate_process (proc);
2792 if (!NILP (XPROCESS (proc)->raw_status_low))
2793 update_status (XPROCESS (proc));
2794 if (EQ (XPROCESS (proc)->status, Qrun))
2795 XPROCESS (proc)->status
2796 = Fcons (Qexit, Fcons (make_number (256), Qnil));
2797 }
2798 }
ffd56f97
JB
2799 } /* end for each file descriptor */
2800 } /* end while exit conditions not met */
d0d6b7c5 2801
d430ee71
RS
2802 waiting_for_user_input_p = 0;
2803
ffd56f97
JB
2804 /* If calling from keyboard input, do not quit
2805 since we want to return C-g as an input character.
2806 Otherwise, do pending quit if requested. */
f76475ad 2807 if (XINT (read_kbd) >= 0)
ffd56f97
JB
2808 {
2809 /* Prevent input_pending from remaining set if we quit. */
2810 clear_input_pending ();
2811 QUIT;
2812 }
e07d5449
KH
2813#ifdef hpux
2814 /* AlainF 5-Jul-1996
2815 HP-UX 10.10 seems to have problems with signals coming in
2816 Causes "poll: interrupted system call" messages when Emacs is run
2817 in an X window
2818 Turn periodic alarms back on */
5d5beb62 2819 start_polling ();
e07d5449 2820#endif
efa2a55c 2821
d0d6b7c5
JB
2822 return got_some_input;
2823}
2824\f
3b9a3dfa
RS
2825/* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
2826
2827static Lisp_Object
2828read_process_output_call (fun_and_args)
2829 Lisp_Object fun_and_args;
2830{
70949dac 2831 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
3b9a3dfa
RS
2832}
2833
2834static Lisp_Object
2835read_process_output_error_handler (error)
2836 Lisp_Object error;
2837{
2838 cmd_error_internal (error, "error in process filter: ");
2839 Vinhibit_quit = Qt;
2840 update_echo_area ();
833ba342 2841 Fsleep_for (make_number (2), Qnil);
8c983bf2 2842 return Qt;
3b9a3dfa
RS
2843}
2844
d0d6b7c5
JB
2845/* Read pending output from the process channel,
2846 starting with our buffered-ahead character if we have one.
0fa1789e 2847 Yield number of decoded characters read.
d0d6b7c5
JB
2848
2849 This function reads at most 1024 characters.
2850 If you want to read all available subprocess output,
0fa1789e
KH
2851 you must call it repeatedly until it returns zero.
2852
2853 The characters read are decoded according to PROC's coding-system
2854 for decoding. */
d0d6b7c5 2855
dfcf069d 2856int
d0d6b7c5
JB
2857read_process_output (proc, channel)
2858 Lisp_Object proc;
2859 register int channel;
2860{
1d2fc612 2861 register int nchars, nbytes;
d0d6b7c5 2862 char *chars;
d0d6b7c5
JB
2863 register Lisp_Object outstream;
2864 register struct buffer *old = current_buffer;
2865 register struct Lisp_Process *p = XPROCESS (proc);
2866 register int opoint;
c7580538 2867 struct coding_system *coding = proc_decode_coding_system[channel];
e7fbaa65 2868 int carryover = XINT (p->decoding_carryover);
d0d6b7c5
JB
2869
2870#ifdef VMS
2871 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
2872
2873 vs = get_vms_process_pointer (p->pid);
2874 if (vs)
2875 {
2876 if (!vs->iosb[0])
a319f7c1 2877 return (0); /* Really weird if it does this */
d0d6b7c5
JB
2878 if (!(vs->iosb[0] & 1))
2879 return -1; /* I/O error */
2880 }
2881 else
2882 error ("Could not get VMS process pointer");
2883 chars = vs->inputBuffer;
1d2fc612
RS
2884 nbytes = clean_vms_buffer (chars, vs->iosb[1]);
2885 if (nbytes <= 0)
d0d6b7c5
JB
2886 {
2887 start_vms_process_read (vs); /* Crank up the next read on the process */
2888 return 1; /* Nothing worth printing, say we got 1 */
2889 }
e7fbaa65 2890 if (carryover > 0)
0fa1789e 2891 {
e7fbaa65
KH
2892 /* The data carried over in the previous decoding (which are at
2893 the tail of decoding buffer) should be prepended to the new
2894 data read to decode all together. */
ed7a4b2d
KH
2895 chars = (char *) alloca (nbytes + carryover);
2896 bcopy (XSTRING (p->decoding_buf)->data, buf, carryover);
2897 bcopy (vs->inputBuffer, chars + carryover, nbytes);
0fa1789e 2898 }
d0d6b7c5 2899#else /* not VMS */
ed7a4b2d 2900 chars = (char *) alloca (carryover + 1024);
e7fbaa65
KH
2901 if (carryover)
2902 /* See the comment above. */
ed7a4b2d 2903 bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
0fa1789e 2904
d0d6b7c5 2905 if (proc_buffered_char[channel] < 0)
ed7a4b2d 2906 nbytes = emacs_read (channel, chars + carryover, 1024 - carryover);
d0d6b7c5
JB
2907 else
2908 {
ed7a4b2d 2909 chars[carryover] = proc_buffered_char[channel];
d0d6b7c5 2910 proc_buffered_char[channel] = -1;
ed7a4b2d 2911 nbytes = emacs_read (channel, chars + carryover + 1, 1023 - carryover);
1d2fc612
RS
2912 if (nbytes < 0)
2913 nbytes = 1;
d0d6b7c5 2914 else
1d2fc612 2915 nbytes = nbytes + 1;
d0d6b7c5
JB
2916 }
2917#endif /* not VMS */
2918
ca65341e
KH
2919 XSETINT (p->decoding_carryover, 0);
2920
ed7a4b2d 2921 /* At this point, NBYTES holds number of bytes just received
0fa1789e 2922 (including the one in proc_buffered_char[channel]). */
de7fbd09
KH
2923 if (nbytes <= 0)
2924 {
2925 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
2926 return nbytes;
2927 coding->mode |= CODING_MODE_LAST_BLOCK;
2928 }
d0d6b7c5 2929
1d2fc612 2930 /* Now set NBYTES how many bytes we must decode. */
e7fbaa65 2931 nbytes += carryover;
0fa1789e 2932
1d2fc612 2933 /* Read and dispose of the process output. */
d0d6b7c5
JB
2934 outstream = p->filter;
2935 if (!NILP (outstream))
2936 {
2937 /* We inhibit quit here instead of just catching it so that
2938 hitting ^G when a filter happens to be running won't screw
2939 it up. */
2940 int count = specpdl_ptr - specpdl;
30c78175 2941 Lisp_Object odeactivate;
dfc21838 2942 Lisp_Object obuffer, okeymap;
1d2fc612 2943 Lisp_Object text;
4da2f5be 2944 int outer_running_asynch_code = running_asynch_code;
bbce7d72 2945 int waiting = waiting_for_user_input_p;
30c78175 2946
dfc21838
RS
2947 /* No need to gcpro these, because all we do with them later
2948 is test them for EQness, and none of them should be a string. */
30c78175 2949 odeactivate = Vdeactivate_mark;
dfc21838
RS
2950 XSETBUFFER (obuffer, current_buffer);
2951 okeymap = current_buffer->keymap;
30c78175 2952
d0d6b7c5 2953 specbind (Qinhibit_quit, Qt);
6545aada 2954 specbind (Qlast_nonmenu_event, Qt);
3b9a3dfa 2955
4da2f5be
RS
2956 /* In case we get recursively called,
2957 and we already saved the match data nonrecursively,
2958 save the same match data in safely recursive fashion. */
2959 if (outer_running_asynch_code)
2960 {
2961 Lisp_Object tem;
2962 /* Don't clobber the CURRENT match data, either! */
dd130227 2963 tem = Fmatch_data (Qnil, Qnil);
4da2f5be 2964 restore_match_data ();
8f1ecd05
RS
2965 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
2966 Fset_match_data (tem);
4da2f5be
RS
2967 }
2968
2969 /* For speed, if a search happens within this code,
2970 save the match data in a special nonrecursive fashion. */
7074fde6 2971 running_asynch_code = 1;
4da2f5be 2972
ed7a4b2d
KH
2973 text = decode_coding_string (make_unibyte_string (chars, nbytes),
2974 coding, 0);
278bfdd6
KH
2975 if (NILP (buffer_defaults.enable_multibyte_characters))
2976 /* We had better return unibyte string. */
2977 text = string_make_unibyte (text);
2978
082a1df2 2979 Vlast_coding_system_used = coding->symbol;
ed7a4b2d
KH
2980 /* A new coding system might be found. */
2981 if (!EQ (p->decode_coding_system, coding->symbol))
2982 {
2983 p->decode_coding_system = coding->symbol;
2984
2985 /* Don't call setup_coding_system for
2986 proc_decode_coding_system[channel] here. It is done in
2987 detect_coding called via decode_coding above. */
2988
2989 /* If a coding system for encoding is not yet decided, we set
2990 it as the same as coding-system for decoding.
2991
2992 But, before doing that we must check if
2993 proc_encode_coding_system[p->outfd] surely points to a
2994 valid memory because p->outfd will be changed once EOF is
2995 sent to the process. */
2996 if (NILP (p->encode_coding_system)
2997 && proc_encode_coding_system[XINT (p->outfd)])
2998 {
2999 p->encode_coding_system = coding->symbol;
3000 setup_coding_system (coding->symbol,
3001 proc_encode_coding_system[XINT (p->outfd)]);
3002 }
3003 }
51c6067d 3004
ed7a4b2d
KH
3005 carryover = nbytes - coding->consumed;
3006 bcopy (chars + coding->consumed, XSTRING (p->decoding_buf)->data,
3007 carryover);
3008 XSETINT (p->decoding_carryover, carryover);
3009 nbytes = STRING_BYTES (XSTRING (text));
3010 nchars = XSTRING (text)->size;
3b9a3dfa
RS
3011 internal_condition_case_1 (read_process_output_call,
3012 Fcons (outstream,
1d2fc612 3013 Fcons (proc, Fcons (text, Qnil))),
3b9a3dfa
RS
3014 !NILP (Vdebug_on_error) ? Qnil : Qerror,
3015 read_process_output_error_handler);
4da2f5be
RS
3016
3017 /* If we saved the match data nonrecursively, restore it now. */
7074fde6 3018 restore_match_data ();
4da2f5be 3019 running_asynch_code = outer_running_asynch_code;
d0d6b7c5 3020
592ce97f 3021 /* Handling the process output should not deactivate the mark. */
30c78175
RS
3022 Vdeactivate_mark = odeactivate;
3023
bbce7d72
RS
3024 /* Restore waiting_for_user_input_p as it was
3025 when we were called, in case the filter clobbered it. */
3026 waiting_for_user_input_p = waiting;
3027
7973cfa8
RS
3028#if 0 /* Call record_asynch_buffer_change unconditionally,
3029 because we might have changed minor modes or other things
3030 that affect key bindings. */
dfc21838
RS
3031 if (! EQ (Fcurrent_buffer (), obuffer)
3032 || ! EQ (current_buffer->keymap, okeymap))
7973cfa8 3033#endif
927e08be
RS
3034 /* But do it only if the caller is actually going to read events.
3035 Otherwise there's no need to make him wake up, and it could
3036 cause trouble (for example it would make Fsit_for return). */
3037 if (waiting_for_user_input_p == -1)
3038 record_asynch_buffer_change ();
d72534ba 3039
d0d6b7c5
JB
3040#ifdef VMS
3041 start_vms_process_read (vs);
3042#endif
2ea6d561 3043 unbind_to (count, Qnil);
d0d6b7c5
JB
3044 return nchars;
3045 }
3046
3047 /* If no filter, write into buffer if it isn't dead. */
3048 if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
3049 {
b0310da4 3050 Lisp_Object old_read_only;
12ca5cdf 3051 int old_begv, old_zv;
d8a2934e 3052 int old_begv_byte, old_zv_byte;
30c78175 3053 Lisp_Object odeactivate;
d8a2934e
RS
3054 int before, before_byte;
3055 int opoint_byte;
ed7a4b2d 3056 Lisp_Object text;
30c78175
RS
3057
3058 odeactivate = Vdeactivate_mark;
d0d6b7c5
JB
3059
3060 Fset_buffer (p->buffer);
6ec8bbd2 3061 opoint = PT;
d8a2934e 3062 opoint_byte = PT_BYTE;
b0310da4 3063 old_read_only = current_buffer->read_only;
12ca5cdf
RS
3064 old_begv = BEGV;
3065 old_zv = ZV;
d8a2934e
RS
3066 old_begv_byte = BEGV_BYTE;
3067 old_zv_byte = ZV_BYTE;
b0310da4
JB
3068
3069 current_buffer->read_only = Qnil;
d0d6b7c5
JB
3070
3071 /* Insert new output into buffer
3072 at the current end-of-output marker,
3073 thus preserving logical ordering of input and output. */
3074 if (XMARKER (p->mark)->buffer)
d8a2934e
RS
3075 SET_PT_BOTH (clip_to_bounds (BEGV, marker_position (p->mark), ZV),
3076 clip_to_bounds (BEGV_BYTE, marker_byte_position (p->mark),
3077 ZV_BYTE));
d0d6b7c5 3078 else
d8a2934e 3079 SET_PT_BOTH (ZV, ZV_BYTE);
12ca5cdf 3080 before = PT;
d8a2934e 3081 before_byte = PT_BYTE;
b0310da4
JB
3082
3083 /* If the output marker is outside of the visible region, save
3084 the restriction and widen. */
6ec8bbd2 3085 if (! (BEGV <= PT && PT <= ZV))
b0310da4
JB
3086 Fwiden ();
3087
d0d6b7c5
JB
3088 /* Insert before markers in case we are inserting where
3089 the buffer's mark is, and the user's next command is Meta-y. */
ed7a4b2d
KH
3090 text = decode_coding_string (make_unibyte_string (chars, nbytes),
3091 coding, 0);
082a1df2 3092 Vlast_coding_system_used = coding->symbol;
ed7a4b2d
KH
3093 /* A new coding system might be found. See the comment in the
3094 similar code in the previous `if' block. */
3095 if (!EQ (p->decode_coding_system, coding->symbol))
3096 {
3097 p->decode_coding_system = coding->symbol;
3098 if (NILP (p->encode_coding_system)
3099 && proc_encode_coding_system[XINT (p->outfd)])
3100 {
3101 p->encode_coding_system = coding->symbol;
3102 setup_coding_system (coding->symbol,
3103 proc_encode_coding_system[XINT (p->outfd)]);
3104 }
3105 }
3106 carryover = nbytes - coding->consumed;
3107 bcopy (chars + coding->consumed, XSTRING (p->decoding_buf)->data,
3108 carryover);
3109 XSETINT (p->decoding_carryover, carryover);
d69864bf
KH
3110 /* Adjust the multibyteness of TEXT to that of the buffer. */
3111 if (NILP (current_buffer->enable_multibyte_characters)
3112 != ! STRING_MULTIBYTE (text))
3113 text = (STRING_MULTIBYTE (text)
3114 ? Fstring_as_unibyte (text)
3115 : Fstring_as_multibyte (text));
ed7a4b2d
KH
3116 nbytes = STRING_BYTES (XSTRING (text));
3117 nchars = XSTRING (text)->size;
3118 insert_from_string_before_markers (text, 0, 0, nchars, nbytes, 0);
a4a37e65
KH
3119 signal_after_change (before, 0, PT - before);
3120 update_compositions (before, PT, CHECK_BORDER);
0d023da1 3121
d8a2934e 3122 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
b0310da4 3123
d0d6b7c5
JB
3124 update_mode_lines++;
3125
12ca5cdf
RS
3126 /* Make sure opoint and the old restrictions
3127 float ahead of any new text just as point would. */
3128 if (opoint >= before)
d8a2934e
RS
3129 {
3130 opoint += PT - before;
3131 opoint_byte += PT_BYTE - before_byte;
3132 }
12ca5cdf 3133 if (old_begv > before)
d8a2934e
RS
3134 {
3135 old_begv += PT - before;
3136 old_begv_byte += PT_BYTE - before_byte;
3137 }
12ca5cdf 3138 if (old_zv >= before)
d8a2934e
RS
3139 {
3140 old_zv += PT - before;
3141 old_zv_byte += PT_BYTE - before_byte;
3142 }
12ca5cdf 3143
b0310da4 3144 /* If the restriction isn't what it should be, set it. */
12ca5cdf
RS
3145 if (old_begv != BEGV || old_zv != ZV)
3146 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
b0310da4 3147
592ce97f 3148 /* Handling the process output should not deactivate the mark. */
30c78175
RS
3149 Vdeactivate_mark = odeactivate;
3150
b0310da4 3151 current_buffer->read_only = old_read_only;
d8a2934e 3152 SET_PT_BOTH (opoint, opoint_byte);
d0d6b7c5
JB
3153 set_buffer_internal (old);
3154 }
3155#ifdef VMS
3156 start_vms_process_read (vs);
3157#endif
1d2fc612 3158 return nbytes;
d0d6b7c5
JB
3159}
3160
3161DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
3162 0, 0, 0,
8b4d685f 3163 "Returns non-nil if emacs is waiting for input from the user.\n\
d0d6b7c5
JB
3164This is intended for use by asynchronous process output filters and sentinels.")
3165 ()
3166{
8b4d685f 3167 return (waiting_for_user_input_p ? Qt : Qnil);
d0d6b7c5
JB
3168}
3169\f
3170/* Sending data to subprocess */
3171
3172jmp_buf send_process_frame;
0daad115 3173Lisp_Object process_sent_to;
d0d6b7c5
JB
3174
3175SIGTYPE
3176send_process_trap ()
3177{
3178#ifdef BSD4_1
3179 sigrelse (SIGPIPE);
3180 sigrelse (SIGALRM);
3181#endif /* BSD4_1 */
3182 longjmp (send_process_frame, 1);
3183}
3184
4556b700
RS
3185/* Send some data to process PROC.
3186 BUF is the beginning of the data; LEN is the number of characters.
0fa1789e
KH
3187 OBJECT is the Lisp object that the data comes from.
3188
3189 The data is encoded by PROC's coding-system for encoding before it
3190 is sent. But if the data ends at the middle of multi-byte
3191 representation, that incomplete sequence of bytes are sent without
3192 being encoded. Should we store them in a buffer to prepend them to
1fb0098c
GM
3193 the data send later?
3194
3195 This function can evaluate Lisp code and can garbage collect. */
4556b700 3196
dfcf069d 3197void
4556b700 3198send_process (proc, buf, len, object)
ecd1f654 3199 volatile Lisp_Object proc;
0daad115
GM
3200 unsigned char *volatile buf;
3201 volatile int len;
3202 volatile Lisp_Object object;
d0d6b7c5 3203{
ecd1f654 3204 /* Use volatile to protect variables from being clobbered by longjmp. */
d0d6b7c5 3205 int rv;
0fa1789e 3206 struct coding_system *coding;
6044e593
RS
3207 struct gcpro gcpro1;
3208
3209 GCPRO1 (object);
d0d6b7c5 3210
d0d6b7c5
JB
3211#ifdef VMS
3212 struct Lisp_Process *p = XPROCESS (proc);
3213 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
3214#endif /* VMS */
3215
3216 if (! NILP (XPROCESS (proc)->raw_status_low))
3217 update_status (XPROCESS (proc));
3218 if (! EQ (XPROCESS (proc)->status, Qrun))
4dd8a783
GM
3219 error ("Process %s not running",
3220 XSTRING (XPROCESS (proc)->name)->data);
0fa1789e 3221 if (XINT (XPROCESS (proc)->outfd) < 0)
4dd8a783
GM
3222 error ("Output file descriptor of %s is closed",
3223 XSTRING (XPROCESS (proc)->name)->data);
0fa1789e 3224
c7580538 3225 coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
486b111b
KH
3226 Vlast_coding_system_used = coding->symbol;
3227
ed7a4b2d
KH
3228 if ((STRINGP (object) && STRING_MULTIBYTE (object))
3229 || (BUFFERP (object)
3230 && !NILP (XBUFFER (object)->enable_multibyte_characters)))
278bfdd6
KH
3231 {
3232 coding->src_multibyte = 1;
3233 if (!EQ (coding->symbol, XPROCESS (proc)->encode_coding_system))
3234 /* The coding system for encoding was changed to raw-text
3235 because we sent a unibyte text previously. Now we are
3236 sending a multibyte text, thus we must encode it by the
3237 original coding system specified for the current
3238 process. */
3239 setup_coding_system (XPROCESS (proc)->encode_coding_system,
3240 coding);
3241 }
3242 else
3243 {
3244 coding->src_multibyte = 0;
3245 /* For sending a unibyte text, character code conversion
3246 should not take place but EOL conversion should. So, setup
3247 raw-text or one of the subsidiary. */
3248 setup_raw_text_coding_system (coding);
3249 }
a4a37e65
KH
3250 coding->dst_multibyte = 0;
3251
ed7a4b2d 3252 if (CODING_REQUIRE_ENCODING (coding))
0fa1789e
KH
3253 {
3254 int require = encoding_buffer_size (coding, len);
0daad115 3255 int from_byte = -1, from = -1, to = -1;
b684d043 3256 unsigned char *temp_buf = NULL;
0fa1789e 3257
ed7a4b2d 3258 if (BUFFERP (object))
0fa1789e 3259 {
ed7a4b2d
KH
3260 from_byte = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
3261 from = buf_bytepos_to_charpos (XBUFFER (object), from_byte);
3262 to = buf_bytepos_to_charpos (XBUFFER (object), from_byte + len);
3263 }
3264 else if (STRINGP (object))
3265 {
3266 from_byte = buf - XSTRING (object)->data;
3267 from = string_byte_to_char (object, from_byte);
3268 to = string_byte_to_char (object, from_byte + len);
0fa1789e
KH
3269 }
3270
ed7a4b2d
KH
3271 if (from_byte >= 0 && coding->composing != COMPOSITION_DISABLED)
3272 coding_save_composition (coding, from, to, object);
3273
fc932ac6 3274 if (STRING_BYTES (XSTRING (XPROCESS (proc)->encoding_buf)) < require)
ed7a4b2d
KH
3275 XPROCESS (proc)->encoding_buf = make_uninit_string (require);
3276
3277 if (from_byte >= 0)
3278 buf = (BUFFERP (object)
3279 ? BUF_BYTE_ADDRESS (XBUFFER (object), from_byte)
3280 : XSTRING (object)->data + from_byte);
0fa1789e 3281
0fa1789e 3282 object = XPROCESS (proc)->encoding_buf;
0daad115 3283 encode_coding (coding, (char *) buf, XSTRING (object)->data,
fc932ac6 3284 len, STRING_BYTES (XSTRING (object)));
e7fbaa65 3285 len = coding->produced;
0fa1789e
KH
3286 buf = XSTRING (object)->data;
3287 if (temp_buf)
3288 xfree (temp_buf);
3289 }
d0d6b7c5
JB
3290
3291#ifdef VMS
3292 vs = get_vms_process_pointer (p->pid);
3293 if (vs == 0)
3294 error ("Could not find this process: %x", p->pid);
3295 else if (write_to_vms_process (vs, buf, len))
3296 ;
0daad115 3297#else /* not VMS */
4556b700
RS
3298
3299 if (pty_max_bytes == 0)
3300 {
3301#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
3302 pty_max_bytes = fpathconf (XFASTINT (XPROCESS (proc)->outfd),
3303 _PC_MAX_CANON);
3304 if (pty_max_bytes < 0)
3305 pty_max_bytes = 250;
3306#else
3307 pty_max_bytes = 250;
3308#endif
3309 /* Deduct one, to leave space for the eof. */
3310 pty_max_bytes--;
3311 }
3312
0daad115
GM
3313 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
3314 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
3315 when returning with longjmp despite being declared volatile. */
d0d6b7c5 3316 if (!setjmp (send_process_frame))
0daad115
GM
3317 {
3318 process_sent_to = proc;
3319 while (len > 0)
3320 {
3321 int this = len;
3322 SIGTYPE (*old_sigpipe)();
93b4f699 3323
0daad115
GM
3324 /* Decide how much data we can send in one batch.
3325 Long lines need to be split into multiple batches. */
3326 if (!NILP (XPROCESS (proc)->pty_flag))
3327 {
3328 /* Starting this at zero is always correct when not the first iteration
3329 because the previous iteration ended by sending C-d.
3330 It may not be correct for the first iteration
3331 if a partial line was sent in a separate send_process call.
3332 If that proves worth handling, we need to save linepos
3333 in the process object. */
3334 int linepos = 0;
3335 unsigned char *ptr = (unsigned char *) buf;
3336 unsigned char *end = (unsigned char *) buf + len;
3337
3338 /* Scan through this text for a line that is too long. */
3339 while (ptr != end && linepos < pty_max_bytes)
3340 {
3341 if (*ptr == '\n')
3342 linepos = 0;
3343 else
3344 linepos++;
3345 ptr++;
3346 }
3347 /* If we found one, break the line there
3348 and put in a C-d to force the buffer through. */
3349 this = ptr - buf;
3350 }
93b4f699 3351
0daad115
GM
3352 /* Send this batch, using one or more write calls. */
3353 while (this > 0)
3354 {
3355 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
3356 rv = emacs_write (XINT (XPROCESS (proc)->outfd),
3357 (char *) buf, this);
3358 signal (SIGPIPE, old_sigpipe);
4556b700 3359
0daad115
GM
3360 if (rv < 0)
3361 {
3362 if (0
d0d6b7c5 3363#ifdef EWOULDBLOCK
0daad115 3364 || errno == EWOULDBLOCK
d0d6b7c5
JB
3365#endif
3366#ifdef EAGAIN
0daad115 3367 || errno == EAGAIN
d0d6b7c5 3368#endif
0daad115
GM
3369 )
3370 /* Buffer is full. Wait, accepting input;
3371 that may allow the program
3372 to finish doing output and read more. */
3373 {
3374 Lisp_Object zero;
3375 int offset = 0;
4556b700 3376
3433b6bd 3377#ifdef BROKEN_PTY_READ_AFTER_EAGAIN
0daad115
GM
3378 /* A gross hack to work around a bug in FreeBSD.
3379 In the following sequence, read(2) returns
3380 bogus data:
3381
3382 write(2) 1022 bytes
3383 write(2) 954 bytes, get EAGAIN
3384 read(2) 1024 bytes in process_read_output
3385 read(2) 11 bytes in process_read_output
3386
3387 That is, read(2) returns more bytes than have
3388 ever been written successfully. The 1033 bytes
3389 read are the 1022 bytes written successfully
3390 after processing (for example with CRs added if
3391 the terminal is set up that way which it is
3392 here). The same bytes will be seen again in a
3393 later read(2), without the CRs. */
3433b6bd 3394
0daad115
GM
3395 if (errno == EAGAIN)
3396 {
3397 int flags = FWRITE;
3398 ioctl (XINT (XPROCESS (proc)->outfd), TIOCFLUSH,
3399 &flags);
3400 }
3433b6bd
GM
3401#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
3402
0daad115
GM
3403 /* Running filters might relocate buffers or strings.
3404 Arrange to relocate BUF. */
3405 if (BUFFERP (object))
3406 offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
3407 else if (STRINGP (object))
3408 offset = buf - XSTRING (object)->data;
3409
3410 XSETFASTINT (zero, 0);
f3e6605c 3411#ifdef EMACS_HAS_USECS
0daad115 3412 wait_reading_process_input (0, 20000, zero, 0);
f3e6605c 3413#else
0daad115 3414 wait_reading_process_input (1, 0, zero, 0);
f3e6605c 3415#endif
4556b700 3416
0daad115
GM
3417 if (BUFFERP (object))
3418 buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
3419 else if (STRINGP (object))
3420 buf = offset + XSTRING (object)->data;
4556b700 3421
0daad115
GM
3422 rv = 0;
3423 }
3424 else
3425 /* This is a real error. */
3426 report_file_error ("writing to process", Fcons (proc, Qnil));
3427 }
3428 buf += rv;
3429 len -= rv;
3430 this -= rv;
3431 }
f76475ad 3432
0daad115
GM
3433 /* If we sent just part of the string, put in an EOF
3434 to force it through, before we send the rest. */
3435 if (len > 0)
3436 Fprocess_send_eof (proc);
3437 }
3438 }
3439#endif /* not VMS */
d0d6b7c5
JB
3440 else
3441 {
0daad115
GM
3442#ifndef VMS
3443 proc = process_sent_to;
3444#endif
d0d6b7c5
JB
3445 XPROCESS (proc)->raw_status_low = Qnil;
3446 XPROCESS (proc)->raw_status_high = Qnil;
3447 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
3448 XSETINT (XPROCESS (proc)->tick, ++process_tick);
3449 deactivate_process (proc);
3450#ifdef VMS
4dd8a783
GM
3451 error ("Error writing to process %s; closed it",
3452 XSTRING (XPROCESS (proc)->name)->data);
d0d6b7c5 3453#else
4dd8a783
GM
3454 error ("SIGPIPE raised on process %s; closed it",
3455 XSTRING (XPROCESS (proc)->name)->data);
d0d6b7c5
JB
3456#endif
3457 }
6044e593
RS
3458
3459 UNGCPRO;
d0d6b7c5
JB
3460}
3461
3462DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
3463 3, 3, 0,
3464 "Send current contents of region as input to PROCESS.\n\
ebb9e16f
JB
3465PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
3466nil, indicating the current buffer's process.\n\
d0d6b7c5
JB
3467Called from program, takes three arguments, PROCESS, START and END.\n\
3468If the region is more than 500 characters long,\n\
3469it is sent in several bunches. This may happen even for shorter regions.\n\
3470Output from processes can arrive in between bunches.")
3471 (process, start, end)
3472 Lisp_Object process, start, end;
3473{
3474 Lisp_Object proc;
d8a2934e 3475 int start1, end1;
d0d6b7c5
JB
3476
3477 proc = get_process (process);
3478 validate_region (&start, &end);
3479
3480 if (XINT (start) < GPT && XINT (end) > GPT)
4da6dec8 3481 move_gap (XINT (start));
d0d6b7c5 3482
d8a2934e
RS
3483 start1 = CHAR_TO_BYTE (XINT (start));
3484 end1 = CHAR_TO_BYTE (XINT (end));
3485 send_process (proc, BYTE_POS_ADDR (start1), end1 - start1,
4556b700 3486 Fcurrent_buffer ());
d0d6b7c5
JB
3487
3488 return Qnil;
3489}
3490
3491DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
3492 2, 2, 0,
3493 "Send PROCESS the contents of STRING as input.\n\
ebb9e16f
JB
3494PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
3495nil, indicating the current buffer's process.\n\
d0d6b7c5
JB
3496If STRING is more than 500 characters long,\n\
3497it is sent in several bunches. This may happen even for shorter strings.\n\
3498Output from processes can arrive in between bunches.")
3499 (process, string)
3500 Lisp_Object process, string;
3501{
3502 Lisp_Object proc;
3503 CHECK_STRING (string, 1);
3504 proc = get_process (process);
1d2fc612 3505 send_process (proc, XSTRING (string)->data,
fc932ac6 3506 STRING_BYTES (XSTRING (string)), string);
d0d6b7c5
JB
3507 return Qnil;
3508}
3509\f
b81ea5ef
RS
3510DEFUN ("process-running-child-p", Fprocess_running_child_p,
3511 Sprocess_running_child_p, 0, 1, 0,
3512 "Return t if PROCESS has given the terminal to a child.\n\
3513If the operating system does not make it possible to find out,\n\
3514return t unconditionally.")
3515 (process)
3516 Lisp_Object process;
3517{
3518 /* Initialize in case ioctl doesn't exist or gives an error,
3519 in a way that will cause returning t. */
3520 int gid = 0;
3521 Lisp_Object proc;
3522 struct Lisp_Process *p;
3523
3524 proc = get_process (process);
3525 p = XPROCESS (proc);
3526
3527 if (!EQ (p->childp, Qt))
3528 error ("Process %s is not a subprocess",
3529 XSTRING (p->name)->data);
3530 if (XINT (p->infd) < 0)
3531 error ("Process %s is not active",
3532 XSTRING (p->name)->data);
3533
3534#ifdef TIOCGPGRP
3535 if (!NILP (p->subtty))
3536 ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
3537 else
3538 ioctl (XINT (p->infd), TIOCGPGRP, &gid);
3539#endif /* defined (TIOCGPGRP ) */
3540
3541 if (gid == XFASTINT (p->pid))
3542 return Qnil;
3543 return Qt;
3544}
3545\f
d0d6b7c5 3546/* send a signal number SIGNO to PROCESS.
b81ea5ef
RS
3547 If CURRENT_GROUP is t, that means send to the process group
3548 that currently owns the terminal being used to communicate with PROCESS.
d0d6b7c5 3549 This is used for various commands in shell mode.
b81ea5ef
RS
3550 If CURRENT_GROUP is lambda, that means send to the process group
3551 that currently owns the terminal, but only if it is NOT the shell itself.
3552
d0d6b7c5 3553 If NOMSG is zero, insert signal-announcements into process's buffers
b0310da4
JB
3554 right away.
3555
3556 If we can, we try to signal PROCESS by sending control characters
e333e864 3557 down the pty. This allows us to signal inferiors who have changed
b0310da4 3558 their uid, for which killpg would return an EPERM error. */
d0d6b7c5 3559
f9738840 3560static void
d0d6b7c5
JB
3561process_send_signal (process, signo, current_group, nomsg)
3562 Lisp_Object process;
3563 int signo;
3564 Lisp_Object current_group;
3565 int nomsg;
3566{
3567 Lisp_Object proc;
3568 register struct Lisp_Process *p;
3569 int gid;
3570 int no_pgrp = 0;
3571
3572 proc = get_process (process);
3573 p = XPROCESS (proc);
3574
3575 if (!EQ (p->childp, Qt))
3576 error ("Process %s is not a subprocess",
3577 XSTRING (p->name)->data);
a9f2c884 3578 if (XINT (p->infd) < 0)
d0d6b7c5
JB
3579 error ("Process %s is not active",
3580 XSTRING (p->name)->data);
3581
3582 if (NILP (p->pty_flag))
3583 current_group = Qnil;
3584
d0d6b7c5
JB
3585 /* If we are using pgrps, get a pgrp number and make it negative. */
3586 if (!NILP (current_group))
3587 {
b0310da4 3588#ifdef SIGNALS_VIA_CHARACTERS
d0d6b7c5
JB
3589 /* If possible, send signals to the entire pgrp
3590 by sending an input character to it. */
b0310da4 3591
6be429b1
JB
3592 /* TERMIOS is the latest and bestest, and seems most likely to
3593 work. If the system has it, use it. */
3594#ifdef HAVE_TERMIOS
3595 struct termios t;
3596
3597 switch (signo)
3598 {
3599 case SIGINT:
a9f2c884 3600 tcgetattr (XINT (p->infd), &t);
4556b700 3601 send_process (proc, &t.c_cc[VINTR], 1, Qnil);
a87b802f 3602 return;
6be429b1
JB
3603
3604 case SIGQUIT:
a9f2c884 3605 tcgetattr (XINT (p->infd), &t);
4556b700 3606 send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
a87b802f 3607 return;
6be429b1
JB
3608
3609 case SIGTSTP:
a9f2c884 3610 tcgetattr (XINT (p->infd), &t);
d0adf46f 3611#if defined (VSWTCH) && !defined (PREFER_VSUSP)
4556b700 3612 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
6be429b1 3613#else
4556b700 3614 send_process (proc, &t.c_cc[VSUSP], 1, Qnil);
6be429b1 3615#endif
a87b802f 3616 return;
6be429b1
JB
3617 }
3618
3619#else /* ! HAVE_TERMIOS */
3620
b0310da4
JB
3621 /* On Berkeley descendants, the following IOCTL's retrieve the
3622 current control characters. */
d0d6b7c5 3623#if defined (TIOCGLTC) && defined (TIOCGETC)
b0310da4 3624
d0d6b7c5
JB
3625 struct tchars c;
3626 struct ltchars lc;
3627
3628 switch (signo)
3629 {
3630 case SIGINT:
a9f2c884 3631 ioctl (XINT (p->infd), TIOCGETC, &c);
4556b700 3632 send_process (proc, &c.t_intrc, 1, Qnil);
f9738840 3633 return;
d0d6b7c5 3634 case SIGQUIT:
a9f2c884 3635 ioctl (XINT (p->infd), TIOCGETC, &c);
4556b700 3636 send_process (proc, &c.t_quitc, 1, Qnil);
f9738840 3637 return;
0ad77c54 3638#ifdef SIGTSTP
d0d6b7c5 3639 case SIGTSTP:
a9f2c884 3640 ioctl (XINT (p->infd), TIOCGLTC, &lc);
4556b700 3641 send_process (proc, &lc.t_suspc, 1, Qnil);
f9738840 3642 return;
b0310da4 3643#endif /* ! defined (SIGTSTP) */
d0d6b7c5 3644 }
b0310da4
JB
3645
3646#else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
3647
3648 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
3649 characters. */
3650#ifdef TCGETA
d0d6b7c5
JB
3651 struct termio t;
3652 switch (signo)
3653 {
3654 case SIGINT:
a9f2c884 3655 ioctl (XINT (p->infd), TCGETA, &t);
4556b700 3656 send_process (proc, &t.c_cc[VINTR], 1, Qnil);
f9738840 3657 return;
d0d6b7c5 3658 case SIGQUIT:
a9f2c884 3659 ioctl (XINT (p->infd), TCGETA, &t);
4556b700 3660 send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
f9738840 3661 return;
7d79e3b4 3662#ifdef SIGTSTP
d0d6b7c5 3663 case SIGTSTP:
a9f2c884 3664 ioctl (XINT (p->infd), TCGETA, &t);
4556b700 3665 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
f9738840 3666 return;
b0310da4 3667#endif /* ! defined (SIGTSTP) */
d0d6b7c5 3668 }
b0310da4
JB
3669#else /* ! defined (TCGETA) */
3670 Your configuration files are messed up.
3671 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
3672 you'd better be using one of the alternatives above! */
3673#endif /* ! defined (TCGETA) */
3674#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
6be429b1 3675#endif /* ! defined HAVE_TERMIOS */
b0310da4 3676#endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
d0d6b7c5 3677
301c3fe4 3678#ifdef TIOCGPGRP
d0d6b7c5
JB
3679 /* Get the pgrp using the tty itself, if we have that.
3680 Otherwise, use the pty to get the pgrp.
3681 On pfa systems, saka@pfu.fujitsu.co.JP writes:
b0310da4
JB
3682 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
3683 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
d0d6b7c5
JB
3684 His patch indicates that if TIOCGPGRP returns an error, then
3685 we should just assume that p->pid is also the process group id. */
3686 {
3687 int err;
3688
3689 if (!NILP (p->subtty))
3690 err = ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
3691 else
a9f2c884 3692 err = ioctl (XINT (p->infd), TIOCGPGRP, &gid);
d0d6b7c5
JB
3693
3694#ifdef pfa
3695 if (err == -1)
3696 gid = - XFASTINT (p->pid);
301c3fe4 3697#endif /* ! defined (pfa) */
d0d6b7c5
JB
3698 }
3699 if (gid == -1)
3700 no_pgrp = 1;
3701 else
3702 gid = - gid;
b0310da4 3703#else /* ! defined (TIOCGPGRP ) */
301c3fe4
JB
3704 /* Can't select pgrps on this system, so we know that
3705 the child itself heads the pgrp. */
3706 gid = - XFASTINT (p->pid);
3707#endif /* ! defined (TIOCGPGRP ) */
b81ea5ef
RS
3708
3709 /* If current_group is lambda, and the shell owns the terminal,
3710 don't send any signal. */
3711 if (EQ (current_group, Qlambda) && gid == - XFASTINT (p->pid))
3712 return;
d0d6b7c5
JB
3713 }
3714 else
3715 gid = - XFASTINT (p->pid);
d0d6b7c5
JB
3716
3717 switch (signo)
3718 {
3719#ifdef SIGCONT
3720 case SIGCONT:
3721 p->raw_status_low = Qnil;
3722 p->raw_status_high = Qnil;
3723 p->status = Qrun;
3724 XSETINT (p->tick, ++process_tick);
3725 if (!nomsg)
3726 status_notify ();
3727 break;
301c3fe4 3728#endif /* ! defined (SIGCONT) */
d0d6b7c5
JB
3729 case SIGINT:
3730#ifdef VMS
4556b700 3731 send_process (proc, "\003", 1, Qnil); /* ^C */
d0d6b7c5
JB
3732 goto whoosh;
3733#endif
3734 case SIGQUIT:
3735#ifdef VMS
4556b700 3736 send_process (proc, "\031", 1, Qnil); /* ^Y */
d0d6b7c5
JB
3737 goto whoosh;
3738#endif
3739 case SIGKILL:
3740#ifdef VMS
3741 sys$forcex (&(XFASTINT (p->pid)), 0, 1);
3742 whoosh:
3743#endif
a9f2c884 3744 flush_pending_output (XINT (p->infd));
d0d6b7c5
JB
3745 break;
3746 }
3747
3748 /* If we don't have process groups, send the signal to the immediate
3749 subprocess. That isn't really right, but it's better than any
3750 obvious alternative. */
3751 if (no_pgrp)
3752 {
3753 kill (XFASTINT (p->pid), signo);
3754 return;
3755 }
3756
3757 /* gid may be a pid, or minus a pgrp's number */
3758#ifdef TIOCSIGSEND
3759 if (!NILP (current_group))
a9f2c884 3760 ioctl (XINT (p->infd), TIOCSIGSEND, signo);
d0d6b7c5
JB
3761 else
3762 {
3763 gid = - XFASTINT (p->pid);
3764 kill (gid, signo);
3765 }
301c3fe4 3766#else /* ! defined (TIOCSIGSEND) */
d0d6b7c5 3767 EMACS_KILLPG (-gid, signo);
301c3fe4 3768#endif /* ! defined (TIOCSIGSEND) */
d0d6b7c5
JB
3769}
3770
3771DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
7744ca33 3772 "Interrupt process PROCESS.\n\
ebb9e16f 3773PROCESS may be a process, a buffer, or the name of a process or buffer.\n\
e333e864 3774nil or no arg means current buffer's process.\n\
d0d6b7c5
JB
3775Second arg CURRENT-GROUP non-nil means send signal to\n\
3776the current process-group of the process's controlling terminal\n\
3777rather than to the process's own process group.\n\
3778If the process is a shell, this means interrupt current subjob\n\
b81ea5ef
RS
3779rather than the shell.\n\
3780\n\
3781If CURRENT-GROUP is `lambda', and if the shell owns the terminal,\n\
3782don't send the signal.")
d0d6b7c5
JB
3783 (process, current_group)
3784 Lisp_Object process, current_group;
3785{
3786 process_send_signal (process, SIGINT, current_group, 0);
3787 return process;
3788}
3789
3790DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
3791 "Kill process PROCESS. May be process or name of one.\n\
3792See function `interrupt-process' for more details on usage.")
3793 (process, current_group)
3794 Lisp_Object process, current_group;
3795{
3796 process_send_signal (process, SIGKILL, current_group, 0);
3797 return process;
3798}
3799
3800DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
3801 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
3802See function `interrupt-process' for more details on usage.")
3803 (process, current_group)
3804 Lisp_Object process, current_group;
3805{
3806 process_send_signal (process, SIGQUIT, current_group, 0);
3807 return process;
3808}
3809
3810DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
3811 "Stop process PROCESS. May be process or name of one.\n\
3812See function `interrupt-process' for more details on usage.")
3813 (process, current_group)
3814 Lisp_Object process, current_group;
3815{
3816#ifndef SIGTSTP
3817 error ("no SIGTSTP support");
3818#else
3819 process_send_signal (process, SIGTSTP, current_group, 0);
3820#endif
3821 return process;
3822}
3823
3824DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
3825 "Continue process PROCESS. May be process or name of one.\n\
3826See function `interrupt-process' for more details on usage.")
3827 (process, current_group)
3828 Lisp_Object process, current_group;
3829{
3830#ifdef SIGCONT
3831 process_send_signal (process, SIGCONT, current_group, 0);
3832#else
3833 error ("no SIGCONT support");
3834#endif
3835 return process;
3836}
3837
3838DEFUN ("signal-process", Fsignal_process, Ssignal_process,
3839 2, 2, "nProcess number: \nnSignal code: ",
4766242d
RS
3840 "Send the process with process id PID the signal with code SIGCODE.\n\
3841PID must be an integer. The process need not be a child of this Emacs.\n\
3842SIGCODE may be an integer, or a symbol whose name is a signal name.")
3843 (pid, sigcode)
3844 Lisp_Object pid, sigcode;
d0d6b7c5
JB
3845{
3846 CHECK_NUMBER (pid, 0);
4766242d
RS
3847
3848#define handle_signal(NAME, VALUE) \
3849 else if (!strcmp (name, NAME)) \
3850 XSETINT (sigcode, VALUE)
3851
3852 if (INTEGERP (sigcode))
3853 ;
3854 else
3855 {
3856 unsigned char *name;
3857
3858 CHECK_SYMBOL (sigcode, 1);
3859 name = XSYMBOL (sigcode)->name->data;
3860
3861 if (0)
3862 ;
3863#ifdef SIGHUP
3864 handle_signal ("SIGHUP", SIGHUP);
3865#endif
3866#ifdef SIGINT
3867 handle_signal ("SIGINT", SIGINT);
3868#endif
3869#ifdef SIGQUIT
3870 handle_signal ("SIGQUIT", SIGQUIT);
3871#endif
3872#ifdef SIGILL
3873 handle_signal ("SIGILL", SIGILL);
3874#endif
3875#ifdef SIGABRT
3876 handle_signal ("SIGABRT", SIGABRT);
3877#endif
3878#ifdef SIGEMT
3879 handle_signal ("SIGEMT", SIGEMT);
3880#endif
3881#ifdef SIGKILL
3882 handle_signal ("SIGKILL", SIGKILL);
3883#endif
3884#ifdef SIGFPE
3885 handle_signal ("SIGFPE", SIGFPE);
3886#endif
3887#ifdef SIGBUS
3888 handle_signal ("SIGBUS", SIGBUS);
3889#endif
3890#ifdef SIGSEGV
3891 handle_signal ("SIGSEGV", SIGSEGV);
3892#endif
3893#ifdef SIGSYS
3894 handle_signal ("SIGSYS", SIGSYS);
3895#endif
3896#ifdef SIGPIPE
3897 handle_signal ("SIGPIPE", SIGPIPE);
3898#endif
3899#ifdef SIGALRM
3900 handle_signal ("SIGALRM", SIGALRM);
3901#endif
3902#ifdef SIGTERM
3903 handle_signal ("SIGTERM", SIGTERM);
3904#endif
3905#ifdef SIGURG
3906 handle_signal ("SIGURG", SIGURG);
3907#endif
3908#ifdef SIGSTOP
3909 handle_signal ("SIGSTOP", SIGSTOP);
3910#endif
3911#ifdef SIGTSTP
3912 handle_signal ("SIGTSTP", SIGTSTP);
3913#endif
3914#ifdef SIGCONT
3915 handle_signal ("SIGCONT", SIGCONT);
3916#endif
3917#ifdef SIGCHLD
3918 handle_signal ("SIGCHLD", SIGCHLD);
3919#endif
3920#ifdef SIGTTIN
3921 handle_signal ("SIGTTIN", SIGTTIN);
3922#endif
3923#ifdef SIGTTOU
3924 handle_signal ("SIGTTOU", SIGTTOU);
3925#endif
3926#ifdef SIGIO
3927 handle_signal ("SIGIO", SIGIO);
3928#endif
3929#ifdef SIGXCPU
3930 handle_signal ("SIGXCPU", SIGXCPU);
3931#endif
3932#ifdef SIGXFSZ
3933 handle_signal ("SIGXFSZ", SIGXFSZ);
3934#endif
3935#ifdef SIGVTALRM
3936 handle_signal ("SIGVTALRM", SIGVTALRM);
3937#endif
3938#ifdef SIGPROF
3939 handle_signal ("SIGPROF", SIGPROF);
3940#endif
3941#ifdef SIGWINCH
3942 handle_signal ("SIGWINCH", SIGWINCH);
3943#endif
3944#ifdef SIGINFO
3945 handle_signal ("SIGINFO", SIGINFO);
3946#endif
3947#ifdef SIGUSR1
3948 handle_signal ("SIGUSR1", SIGUSR1);
3949#endif
3950#ifdef SIGUSR2
3951 handle_signal ("SIGUSR2", SIGUSR2);
3952#endif
3953 else
9fa195a2 3954 error ("Undefined signal name %s", name);
4766242d
RS
3955 }
3956
3957#undef handle_signal
3958
4766242d 3959 return make_number (kill (XINT (pid), XINT (sigcode)));
d0d6b7c5
JB
3960}
3961
3962DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
3963 "Make PROCESS see end-of-file in its input.\n\
7744ca33 3964EOF comes after any text already sent to it.\n\
ebb9e16f 3965PROCESS may be a process, a buffer, the name of a process or buffer, or\n\
d33a00f2
RS
3966nil, indicating the current buffer's process.\n\
3967If PROCESS is a network connection, or is a process communicating\n\
3968through a pipe (as opposed to a pty), then you cannot send any more\n\
3969text to PROCESS after you call this function.")
d0d6b7c5
JB
3970 (process)
3971 Lisp_Object process;
3972{
3973 Lisp_Object proc;
de7fbd09 3974 struct coding_system *coding;
d0d6b7c5
JB
3975
3976 proc = get_process (process);
de7fbd09 3977 coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
577d03d5
RS
3978
3979 /* Make sure the process is really alive. */
3980 if (! NILP (XPROCESS (proc)->raw_status_low))
3981 update_status (XPROCESS (proc));
3982 if (! EQ (XPROCESS (proc)->status, Qrun))
dcf970e6 3983 error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
577d03d5 3984
de7fbd09
KH
3985 if (CODING_REQUIRE_FLUSHING (coding))
3986 {
3987 coding->mode |= CODING_MODE_LAST_BLOCK;
3988 send_process (proc, "", 0, Qnil);
3989 }
3990
d0d6b7c5 3991#ifdef VMS
4556b700 3992 send_process (proc, "\032", 1, Qnil); /* ^z */
d0d6b7c5
JB
3993#else
3994 if (!NILP (XPROCESS (proc)->pty_flag))
4556b700 3995 send_process (proc, "\004", 1, Qnil);
d0d6b7c5
JB
3996 else
3997 {
4525f571
RS
3998 int old_outfd, new_outfd;
3999
93853f3d 4000#ifdef HAVE_SHUTDOWN
02f55c4b
RS
4001 /* If this is a network connection, or socketpair is used
4002 for communication with the subprocess, call shutdown to cause EOF.
4003 (In some old system, shutdown to socketpair doesn't work.
4004 Then we just can't win.) */
4005 if (NILP (XPROCESS (proc)->pid)
4006 || XINT (XPROCESS (proc)->outfd) == XINT (XPROCESS (proc)->infd))
4007 shutdown (XINT (XPROCESS (proc)->outfd), 1);
4008 /* In case of socketpair, outfd == infd, so don't close it. */
4009 if (XINT (XPROCESS (proc)->outfd) != XINT (XPROCESS (proc)->infd))
68c45bf0 4010 emacs_close (XINT (XPROCESS (proc)->outfd));
93853f3d 4011#else /* not HAVE_SHUTDOWN */
68c45bf0 4012 emacs_close (XINT (XPROCESS (proc)->outfd));
93853f3d 4013#endif /* not HAVE_SHUTDOWN */
68c45bf0 4014 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
4525f571
RS
4015 old_outfd = XINT (XPROCESS (proc)->outfd);
4016
4017 if (!proc_encode_coding_system[new_outfd])
4018 proc_encode_coding_system[new_outfd]
4019 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
4020 bcopy (proc_encode_coding_system[old_outfd],
4021 proc_encode_coding_system[new_outfd],
4022 sizeof (struct coding_system));
4023 bzero (proc_encode_coding_system[old_outfd],
4024 sizeof (struct coding_system));
4025
4026 XSETINT (XPROCESS (proc)->outfd, new_outfd);
d0d6b7c5
JB
4027 }
4028#endif /* VMS */
d0d6b7c5
JB
4029 return process;
4030}
4031
4032/* Kill all processes associated with `buffer'.
4033 If `buffer' is nil, kill all processes */
4034
6b53bb85 4035void
d0d6b7c5
JB
4036kill_buffer_processes (buffer)
4037 Lisp_Object buffer;
4038{
4039 Lisp_Object tail, proc;
4040
70949dac 4041 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
d0d6b7c5 4042 {
70949dac 4043 proc = XCDR (XCAR (tail));
b5b502d6 4044 if (GC_PROCESSP (proc)
d0d6b7c5
JB
4045 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
4046 {
4047 if (NETCONN_P (proc))
e1ab4959 4048 Fdelete_process (proc);
a9f2c884 4049 else if (XINT (XPROCESS (proc)->infd) >= 0)
d0d6b7c5
JB
4050 process_send_signal (proc, SIGHUP, Qnil, 1);
4051 }
4052 }
4053}
4054\f
4055/* On receipt of a signal that a child status has changed,
4056 loop asking about children with changed statuses until
4057 the system says there are no more.
4058 All we do is change the status;
4059 we do not run sentinels or print notifications.
4060 That is saved for the next time keyboard input is done,
4061 in order to avoid timing errors. */
4062
4063/** WARNING: this can be called during garbage collection.
4064 Therefore, it must not be fooled by the presence of mark bits in
4065 Lisp objects. */
4066
4067/** USG WARNING: Although it is not obvious from the documentation
4068 in signal(2), on a USG system the SIGCLD handler MUST NOT call
4069 signal() before executing at least one wait(), otherwise the handler
4070 will be called again, resulting in an infinite loop. The relevant
4071 portion of the documentation reads "SIGCLD signals will be queued
4072 and the signal-catching function will be continually reentered until
4073 the queue is empty". Invoking signal() causes the kernel to reexamine
4074 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
4075
4076SIGTYPE
4077sigchld_handler (signo)
4078 int signo;
4079{
4080 int old_errno = errno;
4081 Lisp_Object proc;
4082 register struct Lisp_Process *p;
6be429b1 4083 extern EMACS_TIME *input_available_clear_time;
d0d6b7c5
JB
4084
4085#ifdef BSD4_1
4086 extern int sigheld;
4087 sigheld |= sigbit (SIGCHLD);
4088#endif
4089
4090 while (1)
4091 {
4092 register int pid;
4093 WAITTYPE w;
4094 Lisp_Object tail;
4095
4096#ifdef WNOHANG
4097#ifndef WUNTRACED
4098#define WUNTRACED 0
4099#endif /* no WUNTRACED */
4100 /* Keep trying to get a status until we get a definitive result. */
4101 do
4102 {
4103 errno = 0;
4104 pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
4105 }
4106 while (pid <= 0 && errno == EINTR);
4107
4108 if (pid <= 0)
4109 {
4110 /* A real failure. We have done all our job, so return. */
4111
4112 /* USG systems forget handlers when they are used;
4113 must reestablish each time */
3c0ee47b 4114#if defined (USG) && !defined (POSIX_SIGNALS)
d0d6b7c5
JB
4115 signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
4116#endif
4117#ifdef BSD4_1
4118 sigheld &= ~sigbit (SIGCHLD);
4119 sigrelse (SIGCHLD);
4120#endif
4121 errno = old_errno;
4122 return;
4123 }
4124#else
4125 pid = wait (&w);
4126#endif /* no WNOHANG */
4127
4128 /* Find the process that signaled us, and record its status. */
4129
4130 p = 0;
70949dac 4131 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
d0d6b7c5 4132 {
70949dac 4133 proc = XCDR (XCAR (tail));
d0d6b7c5
JB
4134 p = XPROCESS (proc);
4135 if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
4136 break;
4137 p = 0;
4138 }
4139
4140 /* Look for an asynchronous process whose pid hasn't been filled
4141 in yet. */
4142 if (p == 0)
70949dac 4143 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
d0d6b7c5 4144 {
70949dac 4145 proc = XCDR (XCAR (tail));
d0d6b7c5 4146 p = XPROCESS (proc);
bcd69aea 4147 if (INTEGERP (p->pid) && XINT (p->pid) == -1)
d0d6b7c5
JB
4148 break;
4149 p = 0;
4150 }
4151
4152 /* Change the status of the process that was found. */
4153 if (p != 0)
4154 {
4155 union { int i; WAITTYPE wt; } u;
e98d950b 4156 int clear_desc_flag = 0;
d0d6b7c5
JB
4157
4158 XSETINT (p->tick, ++process_tick);
4159 u.wt = w;
5fc0154c
RS
4160 XSETINT (p->raw_status_low, u.i & 0xffff);
4161 XSETINT (p->raw_status_high, u.i >> 16);
d0d6b7c5
JB
4162
4163 /* If process has terminated, stop waiting for its output. */
e98d950b
RS
4164 if ((WIFSIGNALED (w) || WIFEXITED (w))
4165 && XINT (p->infd) >= 0)
4166 clear_desc_flag = 1;
4167
4168 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
4169 if (clear_desc_flag)
4170 {
4171 FD_CLR (XINT (p->infd), &input_wait_mask);
4172 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
4173 }
6be429b1
JB
4174
4175 /* Tell wait_reading_process_input that it needs to wake up and
4176 look around. */
4177 if (input_available_clear_time)
4178 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
d0d6b7c5
JB
4179 }
4180
4181 /* There was no asynchronous process found for that id. Check
4182 if we have a synchronous process. */
4183 else
4184 {
4185 synch_process_alive = 0;
4186
4187 /* Report the status of the synchronous process. */
4188 if (WIFEXITED (w))
4189 synch_process_retcode = WRETCODE (w);
4190 else if (WIFSIGNALED (w))
b97ad9ea
RS
4191 {
4192 int code = WTERMSIG (w);
68c45bf0
PE
4193 char *signame;
4194
ca9c0567 4195 synchronize_system_messages_locale ();
68c45bf0 4196 signame = strsignal (code);
b97ad9ea 4197
b97ad9ea
RS
4198 if (signame == 0)
4199 signame = "unknown";
4200
4201 synch_process_death = signame;
4202 }
6be429b1
JB
4203
4204 /* Tell wait_reading_process_input that it needs to wake up and
4205 look around. */
4206 if (input_available_clear_time)
4207 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
d0d6b7c5
JB
4208 }
4209
4210 /* On some systems, we must return right away.
4211 If any more processes want to signal us, we will
4212 get another signal.
4213 Otherwise (on systems that have WNOHANG), loop around
4214 to use up all the processes that have something to tell us. */
e98d950b 4215#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) || defined (WINDOWSNT)
3c0ee47b 4216#if defined (USG) && ! defined (POSIX_SIGNALS)
d0d6b7c5
JB
4217 signal (signo, sigchld_handler);
4218#endif
4219 errno = old_errno;
4220 return;
4221#endif /* USG, but not HPUX with WNOHANG */
4222 }
4223}
4224\f
4225
4226static Lisp_Object
4227exec_sentinel_unwind (data)
4228 Lisp_Object data;
4229{
70949dac 4230 XPROCESS (XCAR (data))->sentinel = XCDR (data);
d0d6b7c5
JB
4231 return Qnil;
4232}
4233
3b9a3dfa
RS
4234static Lisp_Object
4235exec_sentinel_error_handler (error)
4236 Lisp_Object error;
4237{
4238 cmd_error_internal (error, "error in process sentinel: ");
4239 Vinhibit_quit = Qt;
4240 update_echo_area ();
833ba342 4241 Fsleep_for (make_number (2), Qnil);
8c983bf2 4242 return Qt;
3b9a3dfa
RS
4243}
4244
d0d6b7c5
JB
4245static void
4246exec_sentinel (proc, reason)
4247 Lisp_Object proc, reason;
4248{
dfc21838 4249 Lisp_Object sentinel, obuffer, odeactivate, okeymap;
d0d6b7c5
JB
4250 register struct Lisp_Process *p = XPROCESS (proc);
4251 int count = specpdl_ptr - specpdl;
4da2f5be 4252 int outer_running_asynch_code = running_asynch_code;
bbce7d72 4253 int waiting = waiting_for_user_input_p;
d0d6b7c5 4254
dfc21838
RS
4255 /* No need to gcpro these, because all we do with them later
4256 is test them for EQness, and none of them should be a string. */
8fb3cf64 4257 odeactivate = Vdeactivate_mark;
dfc21838
RS
4258 XSETBUFFER (obuffer, current_buffer);
4259 okeymap = current_buffer->keymap;
4260
d0d6b7c5
JB
4261 sentinel = p->sentinel;
4262 if (NILP (sentinel))
4263 return;
4264
4265 /* Zilch the sentinel while it's running, to avoid recursive invocations;
4266 assure that it gets restored no matter how the sentinel exits. */
4267 p->sentinel = Qnil;
4268 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
4269 /* Inhibit quit so that random quits don't screw up a running filter. */
4270 specbind (Qinhibit_quit, Qt);
6545aada 4271 specbind (Qlast_nonmenu_event, Qt);
3b9a3dfa 4272
4da2f5be
RS
4273 /* In case we get recursively called,
4274 and we already saved the match data nonrecursively,
4275 save the same match data in safely recursive fashion. */
4276 if (outer_running_asynch_code)
4277 {
4278 Lisp_Object tem;
dd130227 4279 tem = Fmatch_data (Qnil, Qnil);
4da2f5be 4280 restore_match_data ();
8f1ecd05
RS
4281 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
4282 Fset_match_data (tem);
4da2f5be
RS
4283 }
4284
4285 /* For speed, if a search happens within this code,
4286 save the match data in a special nonrecursive fashion. */
7074fde6 4287 running_asynch_code = 1;
4da2f5be 4288
3b9a3dfa
RS
4289 internal_condition_case_1 (read_process_output_call,
4290 Fcons (sentinel,
4291 Fcons (proc, Fcons (reason, Qnil))),
4292 !NILP (Vdebug_on_error) ? Qnil : Qerror,
4293 exec_sentinel_error_handler);
4da2f5be
RS
4294
4295 /* If we saved the match data nonrecursively, restore it now. */
7074fde6 4296 restore_match_data ();
4da2f5be 4297 running_asynch_code = outer_running_asynch_code;
8fb3cf64
KH
4298
4299 Vdeactivate_mark = odeactivate;
bbce7d72
RS
4300
4301 /* Restore waiting_for_user_input_p as it was
4302 when we were called, in case the filter clobbered it. */
4303 waiting_for_user_input_p = waiting;
4304
7973cfa8 4305#if 0
dfc21838
RS
4306 if (! EQ (Fcurrent_buffer (), obuffer)
4307 || ! EQ (current_buffer->keymap, okeymap))
7973cfa8 4308#endif
927e08be
RS
4309 /* But do it only if the caller is actually going to read events.
4310 Otherwise there's no need to make him wake up, and it could
4311 cause trouble (for example it would make Fsit_for return). */
4312 if (waiting_for_user_input_p == -1)
4313 record_asynch_buffer_change ();
8fb3cf64 4314
2ea6d561 4315 unbind_to (count, Qnil);
d0d6b7c5
JB
4316}
4317
4318/* Report all recent events of a change in process status
4319 (either run the sentinel or output a message).
4320 This is done while Emacs is waiting for keyboard input. */
4321
6b53bb85 4322void
d0d6b7c5
JB
4323status_notify ()
4324{
4325 register Lisp_Object proc, buffer;
2e4149a8 4326 Lisp_Object tail, msg;
d0d6b7c5
JB
4327 struct gcpro gcpro1, gcpro2;
4328
2e4149a8
KH
4329 tail = Qnil;
4330 msg = Qnil;
d0d6b7c5
JB
4331 /* We need to gcpro tail; if read_process_output calls a filter
4332 which deletes a process and removes the cons to which tail points
4333 from Vprocess_alist, and then causes a GC, tail is an unprotected
4334 reference. */
4335 GCPRO2 (tail, msg);
4336
30623085
RS
4337 /* Set this now, so that if new processes are created by sentinels
4338 that we run, we get called again to handle their status changes. */
4339 update_tick = process_tick;
4340
4341 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
d0d6b7c5 4342 {
30623085
RS
4343 Lisp_Object symbol;
4344 register struct Lisp_Process *p;
4345
4346 proc = Fcdr (Fcar (tail));
4347 p = XPROCESS (proc);
4348
4349 if (XINT (p->tick) != XINT (p->update_tick))
d0d6b7c5 4350 {
30623085 4351 XSETINT (p->update_tick, XINT (p->tick));
d0d6b7c5 4352
30623085 4353 /* If process is still active, read any output that remains. */
4da2f5be
RS
4354 while (! EQ (p->filter, Qt)
4355 && XINT (p->infd) >= 0
4356 && read_process_output (proc, XINT (p->infd)) > 0);
d0d6b7c5 4357
30623085 4358 buffer = p->buffer;
d0d6b7c5 4359
30623085
RS
4360 /* Get the text to use for the message. */
4361 if (!NILP (p->raw_status_low))
4362 update_status (p);
4363 msg = status_message (p->status);
d0d6b7c5 4364
30623085
RS
4365 /* If process is terminated, deactivate it or delete it. */
4366 symbol = p->status;
4367 if (CONSP (p->status))
70949dac 4368 symbol = XCAR (p->status);
d0d6b7c5 4369
30623085
RS
4370 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
4371 || EQ (symbol, Qclosed))
4372 {
4373 if (delete_exited_processes)
4374 remove_process (proc);
4375 else
4376 deactivate_process (proc);
4377 }
d0d6b7c5 4378
0ad61fe7
RS
4379 /* The actions above may have further incremented p->tick.
4380 So set p->update_tick again
4381 so that an error in the sentinel will not cause
4382 this code to be run again. */
4383 XSETINT (p->update_tick, XINT (p->tick));
30623085
RS
4384 /* Now output the message suitably. */
4385 if (!NILP (p->sentinel))
4386 exec_sentinel (proc, msg);
4387 /* Don't bother with a message in the buffer
4388 when a process becomes runnable. */
4389 else if (!EQ (symbol, Qrun) && !NILP (buffer))
4390 {
4391 Lisp_Object ro, tem;
4392 struct buffer *old = current_buffer;
d8a2934e
RS
4393 int opoint, opoint_byte;
4394 int before, before_byte;
2e4149a8 4395
30623085 4396 ro = XBUFFER (buffer)->read_only;
d0d6b7c5 4397
30623085
RS
4398 /* Avoid error if buffer is deleted
4399 (probably that's why the process is dead, too) */
4400 if (NILP (XBUFFER (buffer)->name))
4401 continue;
4402 Fset_buffer (buffer);
12ca5cdf 4403
6ec8bbd2 4404 opoint = PT;
d8a2934e 4405 opoint_byte = PT_BYTE;
30623085
RS
4406 /* Insert new output into buffer
4407 at the current end-of-output marker,
4408 thus preserving logical ordering of input and output. */
4409 if (XMARKER (p->mark)->buffer)
d8a2934e 4410 Fgoto_char (p->mark);
30623085 4411 else
d8a2934e 4412 SET_PT_BOTH (ZV, ZV_BYTE);
12ca5cdf
RS
4413
4414 before = PT;
d8a2934e 4415 before_byte = PT_BYTE;
30623085
RS
4416
4417 tem = current_buffer->read_only;
4418 current_buffer->read_only = Qnil;
4419 insert_string ("\nProcess ");
4420 Finsert (1, &p->name);
4421 insert_string (" ");
4422 Finsert (1, &msg);
4423 current_buffer->read_only = tem;
d8a2934e 4424 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
30623085 4425
12ca5cdf 4426 if (opoint >= before)
d8a2934e
RS
4427 SET_PT_BOTH (opoint + (PT - before),
4428 opoint_byte + (PT_BYTE - before_byte));
12ca5cdf 4429 else
d8a2934e 4430 SET_PT_BOTH (opoint, opoint_byte);
12ca5cdf 4431
30623085 4432 set_buffer_internal (old);
d0d6b7c5 4433 }
30623085
RS
4434 }
4435 } /* end for */
d0d6b7c5
JB
4436
4437 update_mode_lines++; /* in case buffers use %s in mode-line-format */
4438 redisplay_preserve_echo_area ();
4439
d0d6b7c5
JB
4440 UNGCPRO;
4441}
0fa1789e
KH
4442
4443\f
4444DEFUN ("set-process-coding-system", Fset_process_coding_system,
4445 Sset_process_coding_system, 1, 3, 0,
7744ca33
KH
4446 "Set coding systems of PROCESS to DECODING and ENCODING.\n\
4447DECODING will be used to decode subprocess output and ENCODING to\n\
4448encode subprocess input.")
0fa1789e
KH
4449 (proc, decoding, encoding)
4450 register Lisp_Object proc, decoding, encoding;
4451{
4452 register struct Lisp_Process *p;
4453
4454 CHECK_PROCESS (proc, 0);
4455 p = XPROCESS (proc);
4456 if (XINT (p->infd) < 0)
4457 error ("Input file descriptor of %s closed", XSTRING (p->name)->data);
4458 if (XINT (p->outfd) < 0)
4459 error ("Output file descriptor of %s closed", XSTRING (p->name)->data);
4460
4461 p->decode_coding_system = Fcheck_coding_system (decoding);
4462 p->encode_coding_system = Fcheck_coding_system (encoding);
4463 setup_coding_system (decoding,
c7580538 4464 proc_decode_coding_system[XINT (p->infd)]);
0fa1789e 4465 setup_coding_system (encoding,
c7580538 4466 proc_encode_coding_system[XINT (p->outfd)]);
0fa1789e
KH
4467
4468 return Qnil;
4469}
4470
4471DEFUN ("process-coding-system",
4472 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
a95c35f6 4473 "Return a cons of coding systems for decoding and encoding of PROCESS.")
0fa1789e
KH
4474 (proc)
4475 register Lisp_Object proc;
4476{
4477 CHECK_PROCESS (proc, 0);
4478 return Fcons (XPROCESS (proc)->decode_coding_system,
4479 XPROCESS (proc)->encode_coding_system);
4480}
d0d6b7c5 4481\f
a69281ff
RS
4482/* The first time this is called, assume keyboard input comes from DESC
4483 instead of from where we used to expect it.
4484 Subsequent calls mean assume input keyboard can come from DESC
4485 in addition to other places. */
4486
4487static int add_keyboard_wait_descriptor_called_flag;
4488
4489void
4490add_keyboard_wait_descriptor (desc)
4491 int desc;
4492{
4493 if (! add_keyboard_wait_descriptor_called_flag)
4494 FD_CLR (0, &input_wait_mask);
4495 add_keyboard_wait_descriptor_called_flag = 1;
4496 FD_SET (desc, &input_wait_mask);
b5dc1c83 4497 FD_SET (desc, &non_process_wait_mask);
a69281ff
RS
4498 if (desc > max_keyboard_desc)
4499 max_keyboard_desc = desc;
4500}
4501
4502/* From now on, do not expect DESC to give keyboard input. */
4503
4504void
4505delete_keyboard_wait_descriptor (desc)
4506 int desc;
4507{
4508 int fd;
4509 int lim = max_keyboard_desc;
4510
4511 FD_CLR (desc, &input_wait_mask);
b5dc1c83 4512 FD_CLR (desc, &non_process_wait_mask);
a69281ff
RS
4513
4514 if (desc == max_keyboard_desc)
4515 for (fd = 0; fd < lim; fd++)
4516 if (FD_ISSET (fd, &input_wait_mask)
4517 && !FD_ISSET (fd, &non_keyboard_wait_mask))
4518 max_keyboard_desc = fd;
4519}
4520
4521/* Return nonzero if *MASK has a bit set
4522 that corresponds to one of the keyboard input descriptors. */
4523
4524int
4525keyboard_bit_set (mask)
4526 SELECT_TYPE *mask;
4527{
4528 int fd;
4529
ee8e09af 4530 for (fd = 0; fd <= max_keyboard_desc; fd++)
a69281ff
RS
4531 if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask)
4532 && !FD_ISSET (fd, &non_keyboard_wait_mask))
4533 return 1;
4534
4535 return 0;
4536}
4537\f
dfcf069d 4538void
d0d6b7c5
JB
4539init_process ()
4540{
4541 register int i;
4542
4543#ifdef SIGCHLD
4544#ifndef CANNOT_DUMP
4545 if (! noninteractive || initialized)
4546#endif
4547 signal (SIGCHLD, sigchld_handler);
4548#endif
4549
4550 FD_ZERO (&input_wait_mask);
a69281ff 4551 FD_ZERO (&non_keyboard_wait_mask);
b5dc1c83 4552 FD_ZERO (&non_process_wait_mask);
7d0e672e 4553 max_process_desc = 0;
dd2281ae 4554
a69281ff 4555 FD_SET (0, &input_wait_mask);
dd2281ae 4556
d0d6b7c5
JB
4557 Vprocess_alist = Qnil;
4558 for (i = 0; i < MAXDESC; i++)
4559 {
4560 chan_process[i] = Qnil;
4561 proc_buffered_char[i] = -1;
4562 }
c7580538
KH
4563 bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
4564 bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
d0d6b7c5 4565}
312c9964 4566
dfcf069d 4567void
d0d6b7c5
JB
4568syms_of_process ()
4569{
d0d6b7c5
JB
4570 Qprocessp = intern ("processp");
4571 staticpro (&Qprocessp);
4572 Qrun = intern ("run");
4573 staticpro (&Qrun);
4574 Qstop = intern ("stop");
4575 staticpro (&Qstop);
4576 Qsignal = intern ("signal");
4577 staticpro (&Qsignal);
4578
4579 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
4580 here again.
4581
4582 Qexit = intern ("exit");
4583 staticpro (&Qexit); */
4584
4585 Qopen = intern ("open");
4586 staticpro (&Qopen);
4587 Qclosed = intern ("closed");
4588 staticpro (&Qclosed);
4589
6545aada
RS
4590 Qlast_nonmenu_event = intern ("last-nonmenu-event");
4591 staticpro (&Qlast_nonmenu_event);
4592
d0d6b7c5
JB
4593 staticpro (&Vprocess_alist);
4594
4595 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
4596 "*Non-nil means delete processes immediately when they exit.\n\
4597nil means don't delete them until `list-processes' is run.");
4598
4599 delete_exited_processes = 1;
4600
4601 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
4602 "Control type of device used to communicate with subprocesses.\n\
e333e864
RS
4603Values are nil to use a pipe, or t or `pty' to use a pty.\n\
4604The value has no effect if the system has no ptys or if all ptys are busy:\n\
4605then a pipe is used in any case.\n\
4606The value takes effect when `start-process' is called.");
d0d6b7c5
JB
4607 Vprocess_connection_type = Qt;
4608
4609 defsubr (&Sprocessp);
4610 defsubr (&Sget_process);
4611 defsubr (&Sget_buffer_process);
4612 defsubr (&Sdelete_process);
4613 defsubr (&Sprocess_status);
4614 defsubr (&Sprocess_exit_status);
4615 defsubr (&Sprocess_id);
4616 defsubr (&Sprocess_name);
3b9a3dfa 4617 defsubr (&Sprocess_tty_name);
d0d6b7c5
JB
4618 defsubr (&Sprocess_command);
4619 defsubr (&Sset_process_buffer);
4620 defsubr (&Sprocess_buffer);
4621 defsubr (&Sprocess_mark);
4622 defsubr (&Sset_process_filter);
4623 defsubr (&Sprocess_filter);
4624 defsubr (&Sset_process_sentinel);
4625 defsubr (&Sprocess_sentinel);
de282a05 4626 defsubr (&Sset_process_window_size);
52a1b894
EZ
4627 defsubr (&Sset_process_inherit_coding_system_flag);
4628 defsubr (&Sprocess_inherit_coding_system_flag);
d0d6b7c5 4629 defsubr (&Sprocess_kill_without_query);
de282a05 4630 defsubr (&Sprocess_contact);
d0d6b7c5
JB
4631 defsubr (&Slist_processes);
4632 defsubr (&Sprocess_list);
4633 defsubr (&Sstart_process);
4634#ifdef HAVE_SOCKETS
4635 defsubr (&Sopen_network_stream);
4636#endif /* HAVE_SOCKETS */
4637 defsubr (&Saccept_process_output);
4638 defsubr (&Sprocess_send_region);
4639 defsubr (&Sprocess_send_string);
4640 defsubr (&Sinterrupt_process);
4641 defsubr (&Skill_process);
4642 defsubr (&Squit_process);
4643 defsubr (&Sstop_process);
4644 defsubr (&Scontinue_process);
b81ea5ef 4645 defsubr (&Sprocess_running_child_p);
d0d6b7c5
JB
4646 defsubr (&Sprocess_send_eof);
4647 defsubr (&Ssignal_process);
4648 defsubr (&Swaiting_for_user_input_p);
4649/* defsubr (&Sprocess_connection); */
0fa1789e
KH
4650 defsubr (&Sset_process_coding_system);
4651 defsubr (&Sprocess_coding_system);
d0d6b7c5
JB
4652}
4653
6720a7fb
JB
4654\f
4655#else /* not subprocesses */
4656
4657#include <sys/types.h>
4658#include <errno.h>
4659
4660#include "lisp.h"
4661#include "systime.h"
52a1b894
EZ
4662#include "charset.h"
4663#include "coding.h"
6720a7fb 4664#include "termopts.h"
81afb6d1 4665#include "sysselect.h"
6720a7fb 4666
ff11dfa1 4667extern int frame_garbaged;
6720a7fb 4668
f694e5d2
KH
4669extern EMACS_TIME timer_check ();
4670extern int timers_run;
6720a7fb
JB
4671
4672/* As described above, except assuming that there are no subprocesses:
4673
4674 Wait for timeout to elapse and/or keyboard input to be available.
4675
4676 time_limit is:
4677 timeout in seconds, or
4678 zero for no limit, or
4679 -1 means gobble data immediately available but don't wait for any.
4680
f76475ad 4681 read_kbd is a Lisp_Object:
6720a7fb
JB
4682 0 to ignore keyboard input, or
4683 1 to return when input is available, or
4684 -1 means caller will actually read the input, so don't throw to
4685 the quit handler.
0a65b032
RS
4686 a cons cell, meaning wait until its car is non-nil
4687 (and gobble terminal input into the buffer if any arrives), or
6720a7fb
JB
4688 We know that read_kbd will never be a Lisp_Process, since
4689 `subprocesses' isn't defined.
4690
4691 do_display != 0 means redisplay should be done to show subprocess
5164ee8e 4692 output that arrives.
6720a7fb 4693
eb8c3be9 4694 Return true iff we received input from any process. */
6720a7fb
JB
4695
4696int
4697wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
f76475ad
JB
4698 int time_limit, microsecs;
4699 Lisp_Object read_kbd;
4700 int do_display;
6720a7fb 4701{
52fd88d3 4702 register int nfds;
f694e5d2 4703 EMACS_TIME end_time, timeout;
8db121c4 4704 SELECT_TYPE waitchannels;
f694e5d2 4705 int xerrno;
0a65b032
RS
4706 Lisp_Object *wait_for_cell = 0;
4707
4708 /* If waiting for non-nil in a cell, record where. */
4709 if (CONSP (read_kbd))
4710 {
70949dac 4711 wait_for_cell = &XCAR (read_kbd);
0a65b032
RS
4712 XSETFASTINT (read_kbd, 0);
4713 }
6720a7fb
JB
4714
4715 /* What does time_limit really mean? */
4716 if (time_limit || microsecs)
4717 {
6720a7fb 4718 EMACS_GET_TIME (end_time);
52fd88d3 4719 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
6720a7fb
JB
4720 EMACS_ADD_TIME (end_time, end_time, timeout);
4721 }
6720a7fb
JB
4722
4723 /* Turn off periodic alarms (in case they are in use)
4724 because the select emulator uses alarms. */
30904ab7 4725 turn_on_atimers (0);
6720a7fb 4726
52fd88d3 4727 while (1)
6720a7fb 4728 {
bae8d137 4729 int timeout_reduced_for_timers = 0;
6720a7fb 4730
6720a7fb
JB
4731 /* If calling from keyboard input, do not quit
4732 since we want to return C-g as an input character.
4733 Otherwise, do pending quit if requested. */
f76475ad 4734 if (XINT (read_kbd) >= 0)
6720a7fb
JB
4735 QUIT;
4736
0a65b032
RS
4737 /* Exit now if the cell we're waiting for became non-nil. */
4738 if (wait_for_cell && ! NILP (*wait_for_cell))
4739 break;
4740
bae8d137
RS
4741 /* Compute time from now till when time limit is up */
4742 /* Exit if already run out */
52fd88d3
EZ
4743 if (time_limit == -1)
4744 {
4745 /* -1 specified for timeout means
4746 gobble output available now
4747 but don't wait at all. */
4748
4749 EMACS_SET_SECS_USECS (timeout, 0, 0);
4750 }
4751 else if (time_limit || microsecs)
6720a7fb 4752 {
f694e5d2
KH
4753 EMACS_GET_TIME (timeout);
4754 EMACS_SUB_TIME (timeout, end_time, timeout);
4755 if (EMACS_TIME_NEG_P (timeout))
6720a7fb
JB
4756 break;
4757 }
52fd88d3
EZ
4758 else
4759 {
4760 EMACS_SET_SECS_USECS (timeout, 100000, 0);
4761 }
6720a7fb 4762
bae8d137
RS
4763 /* If our caller will not immediately handle keyboard events,
4764 run timer events directly.
4765 (Callers that will immediately read keyboard events
4766 call timer_delay on their own.) */
f854a00b 4767 if (! wait_for_cell)
bae8d137
RS
4768 {
4769 EMACS_TIME timer_delay;
0a65b032
RS
4770 int old_timers_run;
4771
4772 retry:
4773 old_timers_run = timers_run;
bae8d137
RS
4774 timer_delay = timer_check (1);
4775 if (timers_run != old_timers_run && do_display)
0a65b032
RS
4776 {
4777 redisplay_preserve_echo_area ();
4778 /* We must retry, since a timer may have requeued itself
4779 and that could alter the time delay. */
4780 goto retry;
4781 }
4782
52fd88d3
EZ
4783 /* If there is unread keyboard input, also return. */
4784 if (XINT (read_kbd) != 0
4785 && requeued_events_pending_p ())
4786 break;
4787
f694e5d2 4788 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
bae8d137
RS
4789 {
4790 EMACS_TIME difference;
f694e5d2 4791 EMACS_SUB_TIME (difference, timer_delay, timeout);
bae8d137
RS
4792 if (EMACS_TIME_NEG_P (difference))
4793 {
f694e5d2 4794 timeout = timer_delay;
bae8d137
RS
4795 timeout_reduced_for_timers = 1;
4796 }
4797 }
4798 }
4799
6720a7fb
JB
4800 /* Cause C-g and alarm signals to take immediate action,
4801 and cause input available signals to zero out timeout. */
f76475ad 4802 if (XINT (read_kbd) < 0)
6720a7fb
JB
4803 set_waiting_for_input (&timeout);
4804
0a65b032
RS
4805 /* Wait till there is something to do. */
4806
4807 if (! XINT (read_kbd) && wait_for_cell == 0)
4808 FD_ZERO (&waitchannels);
4809 else
4810 FD_SET (0, &waitchannels);
4811
ff11dfa1 4812 /* If a frame has been newly mapped and needs updating,
6720a7fb 4813 reprocess its display stuff. */
5164ee8e 4814 if (frame_garbaged && do_display)
0a65b032
RS
4815 {
4816 clear_waiting_for_input ();
4817 redisplay_preserve_echo_area ();
4818 if (XINT (read_kbd) < 0)
4819 set_waiting_for_input (&timeout);
4820 }
6720a7fb 4821
1861b214
RS
4822 if (XINT (read_kbd) && detect_input_pending ())
4823 {
4824 nfds = 0;
4825 FD_ZERO (&waitchannels);
4826 }
4827 else
4828 nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
4829 &timeout);
f694e5d2
KH
4830
4831 xerrno = errno;
6720a7fb
JB
4832
4833 /* Make C-g and alarm signals set flags again */
4834 clear_waiting_for_input ();
4835
4836 /* If we woke up due to SIGWINCH, actually change size now. */
2b653806 4837 do_pending_window_change (0);
6720a7fb 4838
f694e5d2
KH
4839 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
4840 /* We waited the full specified time, so return now. */
4841 break;
4842
6720a7fb
JB
4843 if (nfds == -1)
4844 {
4845 /* If the system call was interrupted, then go around the
4846 loop again. */
f694e5d2 4847 if (xerrno == EINTR)
8db121c4 4848 FD_ZERO (&waitchannels);
f694e5d2 4849 else
68c45bf0 4850 error ("select error: %s", emacs_strerror (xerrno));
6720a7fb
JB
4851 }
4852#ifdef sun
4853 else if (nfds > 0 && (waitchannels & 1) && interrupt_input)
4854 /* System sometimes fails to deliver SIGIO. */
4855 kill (getpid (), SIGIO);
4856#endif
7324d660 4857#ifdef SIGIO
f76475ad 4858 if (XINT (read_kbd) && interrupt_input && (waitchannels & 1))
e643c5be 4859 kill (getpid (), SIGIO);
7324d660 4860#endif
6720a7fb 4861
f694e5d2
KH
4862 /* Check for keyboard input */
4863
f854a00b 4864 if ((XINT (read_kbd) != 0)
f694e5d2
KH
4865 && detect_input_pending_run_timers (do_display))
4866 {
4867 swallow_events (do_display);
4868 if (detect_input_pending_run_timers (do_display))
4869 break;
4870 }
0a65b032 4871
52fd88d3
EZ
4872 /* If there is unread keyboard input, also return. */
4873 if (XINT (read_kbd) != 0
4874 && requeued_events_pending_p ())
4875 break;
4876
f854a00b
RS
4877 /* If wait_for_cell. check for keyboard input
4878 but don't run any timers.
4879 ??? (It seems wrong to me to check for keyboard
4880 input at all when wait_for_cell, but the code
4881 has been this way since July 1994.
4882 Try changing this after version 19.31.) */
4883 if (wait_for_cell
4884 && detect_input_pending ())
4885 {
4886 swallow_events (do_display);
4887 if (detect_input_pending ())
4888 break;
4889 }
4890
0a65b032
RS
4891 /* Exit now if the cell we're waiting for became non-nil. */
4892 if (wait_for_cell && ! NILP (*wait_for_cell))
4893 break;
6720a7fb
JB
4894 }
4895
a87b802f
JB
4896 start_polling ();
4897
6720a7fb
JB
4898 return 0;
4899}
4900
4901
4902DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
51ab806a 4903 /* Don't confuse make-docfile by having two doc strings for this function.
312c9964
RS
4904 make-docfile does not pay attention to #if, for good reason! */
4905 0)
6720a7fb
JB
4906 (name)
4907 register Lisp_Object name;
4908{
4909 return Qnil;
4910}
4911
52a1b894
EZ
4912DEFUN ("process-inherit-coding-system-flag",
4913 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
4914 1, 1, 0,
4915 /* Don't confuse make-docfile by having two doc strings for this function.
4916 make-docfile does not pay attention to #if, for good reason! */
4917 0)
4918 (process)
4919 register Lisp_Object process;
4920{
4921 /* Ignore the argument and return the value of
4922 inherit-process-coding-system. */
4923 return inherit_process_coding_system ? Qt : Qnil;
4924}
4925
6720a7fb
JB
4926/* Kill all processes associated with `buffer'.
4927 If `buffer' is nil, kill all processes.
4928 Since we have no subprocesses, this does nothing. */
4929
d9bb0c32 4930void
6720a7fb
JB
4931kill_buffer_processes (buffer)
4932 Lisp_Object buffer;
4933{
4934}
4935
02b9b4fd 4936void
6720a7fb
JB
4937init_process ()
4938{
4939}
4940
02b9b4fd 4941void
6720a7fb
JB
4942syms_of_process ()
4943{
4944 defsubr (&Sget_buffer_process);
52a1b894 4945 defsubr (&Sprocess_inherit_coding_system_flag);
6720a7fb
JB
4946}
4947
4948\f
4949#endif /* not subprocesses */