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