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