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