(post-read-decode-hz)
[emacs.git] / src / process.c
blob5ca96d83e9cdcdeeb64b7fd089f80537f720bbaf
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.
5 This file is part of GNU Emacs.
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.
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.
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. */
23 #define _GNU_SOURCE /* to get strsignal declared with glibc 2 */
24 #include <config.h>
25 #include <signal.h>
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. */
35 #ifdef subprocesses
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
47 #if defined(WINDOWSNT) || defined(UNIX98_PTYS)
48 #include <stdlib.h>
49 #include <fcntl.h>
50 #endif /* not WINDOWSNT */
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 */
62 /* TERM is a poor-man's SLIP, used on GNU/Linux. */
63 #ifdef TERM
64 #include <client.h>
65 #endif
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
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 */
83 #ifdef BROKEN_O_NONBLOCK
84 #undef O_NONBLOCK
85 #endif /* BROKEN_O_NONBLOCK */
87 #ifdef NEED_BSDTTY
88 #include <bsdtty.h>
89 #endif
91 #ifdef IRIS
92 #include <sys/sysmacros.h> /* for "minor" */
93 #endif /* not IRIS */
95 #ifdef HAVE_SYS_WAIT
96 #include <sys/wait.h>
97 #endif
99 #include "systime.h"
100 #include "systty.h"
102 #include "lisp.h"
103 #include "window.h"
104 #include "buffer.h"
105 #include "character.h"
106 #include "coding.h"
107 #include "process.h"
108 #include "termhooks.h"
109 #include "termopts.h"
110 #include "commands.h"
111 #include "keyboard.h"
112 #include "frame.h"
113 #include "blockinput.h"
114 #include "dispextern.h"
115 #include "composite.h"
116 #include "atimer.h"
118 Lisp_Object Qprocessp;
119 Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed;
120 Lisp_Object Qlast_nonmenu_event;
121 /* Qexit is declared and initialized in eval.c. */
123 /* a process object is a network connection when its childp field is neither
124 Qt nor Qnil but is instead a cons cell (HOSTNAME PORTNUM). */
126 #ifdef HAVE_SOCKETS
127 #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
128 #else
129 #define NETCONN_P(p) 0
130 #endif /* HAVE_SOCKETS */
132 /* Define first descriptor number available for subprocesses. */
133 #ifdef VMS
134 #define FIRST_PROC_DESC 1
135 #else /* Not VMS */
136 #define FIRST_PROC_DESC 3
137 #endif
139 /* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
140 testing SIGCHLD. */
142 #if !defined (SIGCHLD) && defined (SIGCLD)
143 #define SIGCHLD SIGCLD
144 #endif /* SIGCLD */
146 #include "syssignal.h"
148 #include "syswait.h"
150 extern void set_waiting_for_input P_ ((EMACS_TIME *));
152 #ifndef USE_CRT_DLL
153 extern int errno;
154 #endif
155 #ifdef VMS
156 extern char *sys_errlist[];
157 #endif
159 #ifndef HAVE_H_ERRNO
160 extern int h_errno;
161 #endif
163 /* t means use pty, nil means use a pipe,
164 maybe other values to come. */
165 static Lisp_Object Vprocess_connection_type;
167 #ifdef SKTPAIR
168 #ifndef HAVE_SOCKETS
169 #include <sys/socket.h>
170 #endif
171 #endif /* SKTPAIR */
173 /* These next two vars are non-static since sysdep.c uses them in the
174 emulation of `select'. */
175 /* Number of events of change of status of a process. */
176 int process_tick;
177 /* Number of events for which the user or sentinel has been notified. */
178 int update_tick;
180 #include "sysselect.h"
182 extern int keyboard_bit_set P_ ((SELECT_TYPE *));
184 /* If we support a window system, turn on the code to poll periodically
185 to detect C-g. It isn't actually used when doing interrupt input. */
186 #ifdef HAVE_WINDOW_SYSTEM
187 #define POLL_FOR_INPUT
188 #endif
190 /* Mask of bits indicating the descriptors that we wait for input on. */
192 static SELECT_TYPE input_wait_mask;
194 /* Mask that excludes keyboard input descriptor (s). */
196 static SELECT_TYPE non_keyboard_wait_mask;
198 /* Mask that excludes process input descriptor (s). */
200 static SELECT_TYPE non_process_wait_mask;
202 /* The largest descriptor currently in use for a process object. */
203 static int max_process_desc;
205 /* The largest descriptor currently in use for keyboard input. */
206 static int max_keyboard_desc;
208 /* Nonzero means delete a process right away if it exits. */
209 static int delete_exited_processes;
211 /* Indexed by descriptor, gives the process (if any) for that descriptor */
212 Lisp_Object chan_process[MAXDESC];
214 /* Alist of elements (NAME . PROCESS) */
215 Lisp_Object Vprocess_alist;
217 /* Buffered-ahead input char from process, indexed by channel.
218 -1 means empty (no char is buffered).
219 Used on sys V where the only way to tell if there is any
220 output from the process is to read at least one char.
221 Always -1 on systems that support FIONREAD. */
223 /* Don't make static; need to access externally. */
224 int proc_buffered_char[MAXDESC];
226 /* Table of `struct coding-system' for each process. */
227 static struct coding_system *proc_decode_coding_system[MAXDESC];
228 static struct coding_system *proc_encode_coding_system[MAXDESC];
230 static Lisp_Object get_process ();
232 extern EMACS_TIME timer_check ();
233 extern int timers_run;
235 /* Maximum number of bytes to send to a pty without an eof. */
236 static int pty_max_bytes;
238 extern Lisp_Object Vfile_name_coding_system, Vdefault_file_name_coding_system;
240 #ifdef HAVE_PTYS
241 #ifdef HAVE_PTY_H
242 #include <pty.h>
243 #endif
244 /* The file name of the pty opened by allocate_pty. */
246 static char pty_name[24];
247 #endif
249 /* Compute the Lisp form of the process status, p->status, from
250 the numeric status that was returned by `wait'. */
252 Lisp_Object status_convert ();
254 void
255 update_status (p)
256 struct Lisp_Process *p;
258 union { int i; WAITTYPE wt; } u;
259 u.i = XFASTINT (p->raw_status_low) + (XFASTINT (p->raw_status_high) << 16);
260 p->status = status_convert (u.wt);
261 p->raw_status_low = Qnil;
262 p->raw_status_high = Qnil;
265 /* Convert a process status word in Unix format to
266 the list that we use internally. */
268 Lisp_Object
269 status_convert (w)
270 WAITTYPE w;
272 if (WIFSTOPPED (w))
273 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
274 else if (WIFEXITED (w))
275 return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
276 WCOREDUMP (w) ? Qt : Qnil));
277 else if (WIFSIGNALED (w))
278 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
279 WCOREDUMP (w) ? Qt : Qnil));
280 else
281 return Qrun;
284 /* Given a status-list, extract the three pieces of information
285 and store them individually through the three pointers. */
287 void
288 decode_status (l, symbol, code, coredump)
289 Lisp_Object l;
290 Lisp_Object *symbol;
291 int *code;
292 int *coredump;
294 Lisp_Object tem;
296 if (SYMBOLP (l))
298 *symbol = l;
299 *code = 0;
300 *coredump = 0;
302 else
304 *symbol = XCAR (l);
305 tem = XCDR (l);
306 *code = XFASTINT (XCAR (tem));
307 tem = XCDR (tem);
308 *coredump = !NILP (tem);
312 /* Return a string describing a process status list. */
314 Lisp_Object
315 status_message (status)
316 Lisp_Object status;
318 Lisp_Object symbol;
319 int code, coredump;
320 Lisp_Object string, string2;
322 decode_status (status, &symbol, &code, &coredump);
324 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
326 char *signame;
327 synchronize_system_messages_locale ();
328 signame = strsignal (code);
329 if (signame == 0)
330 signame = "unknown";
331 string = build_string (signame);
332 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
333 XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
334 return concat2 (string, string2);
336 else if (EQ (symbol, Qexit))
338 if (code == 0)
339 return build_string ("finished\n");
340 string = Fnumber_to_string (make_number (code));
341 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
342 return concat2 (build_string ("exited abnormally with code "),
343 concat2 (string, string2));
345 else
346 return Fcopy_sequence (Fsymbol_name (symbol));
349 #ifdef HAVE_PTYS
351 /* Open an available pty, returning a file descriptor.
352 Return -1 on failure.
353 The file name of the terminal corresponding to the pty
354 is left in the variable pty_name. */
357 allocate_pty ()
359 struct stat stb;
360 register int c, i;
361 int fd;
363 /* Some systems name their pseudoterminals so that there are gaps in
364 the usual sequence - for example, on HP9000/S700 systems, there
365 are no pseudoterminals with names ending in 'f'. So we wait for
366 three failures in a row before deciding that we've reached the
367 end of the ptys. */
368 int failed_count = 0;
370 #ifdef PTY_ITERATION
371 PTY_ITERATION
372 #else
373 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
374 for (i = 0; i < 16; i++)
375 #endif
377 #ifdef PTY_NAME_SPRINTF
378 PTY_NAME_SPRINTF
379 #else
380 sprintf (pty_name, "/dev/pty%c%x", c, i);
381 #endif /* no PTY_NAME_SPRINTF */
383 #ifdef PTY_OPEN
384 PTY_OPEN;
385 #else /* no PTY_OPEN */
386 #ifdef IRIS
387 /* Unusual IRIS code */
388 *ptyv = emacs_open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
389 if (fd < 0)
390 return -1;
391 if (fstat (fd, &stb) < 0)
392 return -1;
393 #else /* not IRIS */
394 if (stat (pty_name, &stb) < 0)
396 failed_count++;
397 if (failed_count >= 3)
398 return -1;
400 else
401 failed_count = 0;
402 #ifdef O_NONBLOCK
403 fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
404 #else
405 fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
406 #endif
407 #endif /* not IRIS */
408 #endif /* no PTY_OPEN */
410 if (fd >= 0)
412 /* check to make certain that both sides are available
413 this avoids a nasty yet stupid bug in rlogins */
414 #ifdef PTY_TTY_NAME_SPRINTF
415 PTY_TTY_NAME_SPRINTF
416 #else
417 sprintf (pty_name, "/dev/tty%c%x", c, i);
418 #endif /* no PTY_TTY_NAME_SPRINTF */
419 #ifndef UNIPLUS
420 if (access (pty_name, 6) != 0)
422 emacs_close (fd);
423 #if !defined(IRIS) && !defined(__sgi)
424 continue;
425 #else
426 return -1;
427 #endif /* IRIS */
429 #endif /* not UNIPLUS */
430 setup_pty (fd);
431 return fd;
434 return -1;
436 #endif /* HAVE_PTYS */
438 Lisp_Object
439 make_process (name)
440 Lisp_Object name;
442 register Lisp_Object val, tem, name1;
443 register struct Lisp_Process *p;
444 char suffix[10];
445 register int i;
447 p = allocate_process ();
449 XSETINT (p->infd, -1);
450 XSETINT (p->outfd, -1);
451 XSETFASTINT (p->pid, 0);
452 XSETFASTINT (p->tick, 0);
453 XSETFASTINT (p->update_tick, 0);
454 p->raw_status_low = Qnil;
455 p->raw_status_high = Qnil;
456 p->status = Qrun;
457 p->mark = Fmake_marker ();
459 /* If name is already in use, modify it until it is unused. */
461 name1 = name;
462 for (i = 1; ; i++)
464 tem = Fget_process (name1);
465 if (NILP (tem)) break;
466 sprintf (suffix, "<%d>", i);
467 name1 = concat2 (name, build_string (suffix));
469 name = name1;
470 p->name = name;
471 XSETPROCESS (val, p);
472 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
473 return val;
476 void
477 remove_process (proc)
478 register Lisp_Object proc;
480 register Lisp_Object pair;
482 pair = Frassq (proc, Vprocess_alist);
483 Vprocess_alist = Fdelq (pair, Vprocess_alist);
485 deactivate_process (proc);
488 DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
489 doc: /* Return t if OBJECT is a process. */)
490 (object)
491 Lisp_Object object;
493 return PROCESSP (object) ? Qt : Qnil;
496 DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
497 doc: /* Return the process named NAME, or nil if there is none. */)
498 (name)
499 register Lisp_Object name;
501 if (PROCESSP (name))
502 return name;
503 CHECK_STRING (name);
504 return Fcdr (Fassoc (name, Vprocess_alist));
507 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
508 doc: /* Return the (or a) process associated with BUFFER.
509 BUFFER may be a buffer or the name of one. */)
510 (buffer)
511 register Lisp_Object buffer;
513 register Lisp_Object buf, tail, proc;
515 if (NILP (buffer)) return Qnil;
516 buf = Fget_buffer (buffer);
517 if (NILP (buf)) return Qnil;
519 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
521 proc = Fcdr (Fcar (tail));
522 if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
523 return proc;
525 return Qnil;
528 /* This is how commands for the user decode process arguments. It
529 accepts a process, a process name, a buffer, a buffer name, or nil.
530 Buffers denote the first process in the buffer, and nil denotes the
531 current buffer. */
533 static Lisp_Object
534 get_process (name)
535 register Lisp_Object name;
537 register Lisp_Object proc, obj;
538 if (STRINGP (name))
540 obj = Fget_process (name);
541 if (NILP (obj))
542 obj = Fget_buffer (name);
543 if (NILP (obj))
544 error ("Process %s does not exist", XSTRING (name)->data);
546 else if (NILP (name))
547 obj = Fcurrent_buffer ();
548 else
549 obj = name;
551 /* Now obj should be either a buffer object or a process object.
553 if (BUFFERP (obj))
555 proc = Fget_buffer_process (obj);
556 if (NILP (proc))
557 error ("Buffer %s has no process", XSTRING (XBUFFER (obj)->name)->data);
559 else
561 CHECK_PROCESS (obj);
562 proc = obj;
564 return proc;
567 DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
568 doc: /* Delete PROCESS: kill it and forget about it immediately.
569 PROCESS may be a process, a buffer, the name of a process or buffer, or
570 nil, indicating the current buffer's process. */)
571 (process)
572 register Lisp_Object process;
574 process = get_process (process);
575 XPROCESS (process)->raw_status_low = Qnil;
576 XPROCESS (process)->raw_status_high = Qnil;
577 if (NETCONN_P (process))
579 XPROCESS (process)->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
580 XSETINT (XPROCESS (process)->tick, ++process_tick);
582 else if (XINT (XPROCESS (process)->infd) >= 0)
584 Fkill_process (process, Qnil);
585 /* Do this now, since remove_process will make sigchld_handler do nothing. */
586 XPROCESS (process)->status
587 = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
588 XSETINT (XPROCESS (process)->tick, ++process_tick);
589 status_notify ();
591 remove_process (process);
592 return Qnil;
595 DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
596 doc: /* Return the status of PROCESS.
597 The returned value is one of the following symbols:
598 run -- for a process that is running.
599 stop -- for a process stopped but continuable.
600 exit -- for a process that has exited.
601 signal -- for a process that has got a fatal signal.
602 open -- for a network stream connection that is open.
603 closed -- for a network stream connection that is closed.
604 nil -- if arg is a process name and no such process exists.
605 PROCESS may be a process, a buffer, the name of a process, or
606 nil, indicating the current buffer's process. */)
607 (process)
608 register Lisp_Object process;
610 register struct Lisp_Process *p;
611 register Lisp_Object status;
613 if (STRINGP (process))
614 process = Fget_process (process);
615 else
616 process = get_process (process);
618 if (NILP (process))
619 return process;
621 p = XPROCESS (process);
622 if (!NILP (p->raw_status_low))
623 update_status (p);
624 status = p->status;
625 if (CONSP (status))
626 status = XCAR (status);
627 if (NETCONN_P (process))
629 if (EQ (status, Qrun))
630 status = Qopen;
631 else if (EQ (status, Qexit))
632 status = Qclosed;
634 return status;
637 DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
638 1, 1, 0,
639 doc: /* Return the exit status of PROCESS or the signal number that killed it.
640 If PROCESS has not yet exited or died, return 0. */)
641 (process)
642 register Lisp_Object process;
644 CHECK_PROCESS (process);
645 if (!NILP (XPROCESS (process)->raw_status_low))
646 update_status (XPROCESS (process));
647 if (CONSP (XPROCESS (process)->status))
648 return XCAR (XCDR (XPROCESS (process)->status));
649 return make_number (0);
652 DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
653 doc: /* Return the process id of PROCESS.
654 This is the pid of the Unix process which PROCESS uses or talks to.
655 For a network connection, this value is nil. */)
656 (process)
657 register Lisp_Object process;
659 CHECK_PROCESS (process);
660 return XPROCESS (process)->pid;
663 DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
664 doc: /* Return the name of PROCESS, as a string.
665 This is the name of the program invoked in PROCESS,
666 possibly modified to make it unique among process names. */)
667 (process)
668 register Lisp_Object process;
670 CHECK_PROCESS (process);
671 return XPROCESS (process)->name;
674 DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
675 doc: /* Return the command that was executed to start PROCESS.
676 This is a list of strings, the first string being the program executed
677 and the rest of the strings being the arguments given to it.
678 For a non-child channel, this is nil. */)
679 (process)
680 register Lisp_Object process;
682 CHECK_PROCESS (process);
683 return XPROCESS (process)->command;
686 DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
687 doc: /* Return the name of the terminal PROCESS uses, or nil if none.
688 This is the terminal that the process itself reads and writes on,
689 not the name of the pty that Emacs uses to talk with that terminal. */)
690 (process)
691 register Lisp_Object process;
693 CHECK_PROCESS (process);
694 return XPROCESS (process)->tty_name;
697 DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
698 2, 2, 0,
699 doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */)
700 (process, buffer)
701 register Lisp_Object process, buffer;
703 CHECK_PROCESS (process);
704 if (!NILP (buffer))
705 CHECK_BUFFER (buffer);
706 XPROCESS (process)->buffer = buffer;
707 return buffer;
710 DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
711 1, 1, 0,
712 doc: /* Return the buffer PROCESS is associated with.
713 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
714 (process)
715 register Lisp_Object process;
717 CHECK_PROCESS (process);
718 return XPROCESS (process)->buffer;
721 DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
722 1, 1, 0,
723 doc: /* Return the marker for the end of the last output from PROCESS. */)
724 (process)
725 register Lisp_Object process;
727 CHECK_PROCESS (process);
728 return XPROCESS (process)->mark;
731 DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
732 2, 2, 0,
733 doc: /* Give PROCESS the filter function FILTER; nil means no filter.
734 t means stop accepting output from the process.
735 When a process has a filter, each time it does output
736 the entire string of output is passed to the filter.
737 The filter gets two arguments: the process and the string of output.
738 If the process has a filter, its buffer is not used for output. */)
739 (process, filter)
740 register Lisp_Object process, filter;
742 struct Lisp_Process *p;
744 CHECK_PROCESS (process);
745 p = XPROCESS (process);
747 /* Don't signal an error if the process' input file descriptor
748 is closed. This could make debugging Lisp more difficult,
749 for example when doing something like
751 (setq process (start-process ...))
752 (debug)
753 (set-process-filter process ...) */
755 if (XINT (p->infd) >= 0)
757 if (EQ (filter, Qt))
759 FD_CLR (XINT (p->infd), &input_wait_mask);
760 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
762 else if (EQ (XPROCESS (process)->filter, Qt))
764 FD_SET (XINT (p->infd), &input_wait_mask);
765 FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
769 p->filter = filter;
770 return filter;
773 DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
774 1, 1, 0,
775 doc: /* Returns the filter function of PROCESS; nil if none.
776 See `set-process-filter' for more info on filter functions. */)
777 (process)
778 register Lisp_Object process;
780 CHECK_PROCESS (process);
781 return XPROCESS (process)->filter;
784 DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
785 2, 2, 0,
786 doc: /* Give PROCESS the sentinel SENTINEL; nil for none.
787 The sentinel is called as a function when the process changes state.
788 It gets two arguments: the process, and a string describing the change. */)
789 (process, sentinel)
790 register Lisp_Object process, sentinel;
792 CHECK_PROCESS (process);
793 XPROCESS (process)->sentinel = sentinel;
794 return sentinel;
797 DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
798 1, 1, 0,
799 doc: /* Return the sentinel of PROCESS; nil if none.
800 See `set-process-sentinel' for more info on sentinels. */)
801 (process)
802 register Lisp_Object process;
804 CHECK_PROCESS (process);
805 return XPROCESS (process)->sentinel;
808 DEFUN ("set-process-window-size", Fset_process_window_size,
809 Sset_process_window_size, 3, 3, 0,
810 doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
811 (process, height, width)
812 register Lisp_Object process, height, width;
814 CHECK_PROCESS (process);
815 CHECK_NATNUM (height);
816 CHECK_NATNUM (width);
818 if (XINT (XPROCESS (process)->infd) < 0
819 || set_window_size (XINT (XPROCESS (process)->infd),
820 XINT (height), XINT (width)) <= 0)
821 return Qnil;
822 else
823 return Qt;
826 DEFUN ("set-process-inherit-coding-system-flag",
827 Fset_process_inherit_coding_system_flag,
828 Sset_process_inherit_coding_system_flag, 2, 2, 0,
829 doc: /* Determine whether buffer of PROCESS will inherit coding-system.
830 If the second argument FLAG is non-nil, then the variable
831 `buffer-file-coding-system' of the buffer associated with PROCESS
832 will be bound to the value of the coding system used to decode
833 the process output.
835 This is useful when the coding system specified for the process buffer
836 leaves either the character code conversion or the end-of-line conversion
837 unspecified, or if the coding system used to decode the process output
838 is more appropriate for saving the process buffer.
840 Binding the variable `inherit-process-coding-system' to non-nil before
841 starting the process is an alternative way of setting the inherit flag
842 for the process which will run. */)
843 (process, flag)
844 register Lisp_Object process, flag;
846 CHECK_PROCESS (process);
847 XPROCESS (process)->inherit_coding_system_flag = flag;
848 return flag;
851 DEFUN ("process-inherit-coding-system-flag",
852 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
853 1, 1, 0,
854 doc: /* Return the value of inherit-coding-system flag for PROCESS.
855 If this flag is t, `buffer-file-coding-system' of the buffer
856 associated with PROCESS will inherit the coding system used to decode
857 the process output. */)
858 (process)
859 register Lisp_Object process;
861 CHECK_PROCESS (process);
862 return XPROCESS (process)->inherit_coding_system_flag;
865 DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
866 Sprocess_kill_without_query, 1, 2, 0,
867 doc: /* Say no query needed if PROCESS is running when Emacs is exited.
868 Optional second argument if non-nil says to require a query.
869 Value is t if a query was formerly required. */)
870 (process, value)
871 register Lisp_Object process, value;
873 Lisp_Object tem;
875 CHECK_PROCESS (process);
876 tem = XPROCESS (process)->kill_without_query;
877 XPROCESS (process)->kill_without_query = Fnull (value);
879 return Fnull (tem);
882 DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
883 1, 1, 0,
884 doc: /* Return the contact info of PROCESS; t for a real child.
885 For a net connection, the value is a cons cell of the form (HOST SERVICE). */)
886 (process)
887 register Lisp_Object process;
889 CHECK_PROCESS (process);
890 return XPROCESS (process)->childp;
893 #if 0 /* Turned off because we don't currently record this info
894 in the process. Perhaps add it. */
895 DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
896 doc: /* Return the connection type of PROCESS.
897 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
898 a socket connection. */)
899 (process)
900 Lisp_Object process;
902 return XPROCESS (process)->type;
904 #endif
906 Lisp_Object
907 list_processes_1 ()
909 register Lisp_Object tail, tem;
910 Lisp_Object proc, minspace, tem1;
911 register struct Lisp_Process *p;
912 char tembuf[80];
914 XSETFASTINT (minspace, 1);
916 set_buffer_internal (XBUFFER (Vstandard_output));
917 Fbuffer_disable_undo (Vstandard_output);
919 current_buffer->truncate_lines = Qt;
921 write_string ("\
922 Proc Status Buffer Tty Command\n\
923 ---- ------ ------ --- -------\n", -1);
925 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
927 Lisp_Object symbol;
929 proc = Fcdr (Fcar (tail));
930 p = XPROCESS (proc);
931 if (NILP (p->childp))
932 continue;
934 Finsert (1, &p->name);
935 Findent_to (make_number (13), minspace);
937 if (!NILP (p->raw_status_low))
938 update_status (p);
939 symbol = p->status;
940 if (CONSP (p->status))
941 symbol = XCAR (p->status);
944 if (EQ (symbol, Qsignal))
946 Lisp_Object tem;
947 tem = Fcar (Fcdr (p->status));
948 #ifdef VMS
949 if (XINT (tem) < NSIG)
950 write_string (sys_errlist [XINT (tem)], -1);
951 else
952 #endif
953 Fprinc (symbol, Qnil);
955 else if (NETCONN_P (proc))
957 if (EQ (symbol, Qrun))
958 write_string ("open", -1);
959 else if (EQ (symbol, Qexit))
960 write_string ("closed", -1);
961 else
962 Fprinc (symbol, Qnil);
964 else
965 Fprinc (symbol, Qnil);
967 if (EQ (symbol, Qexit))
969 Lisp_Object tem;
970 tem = Fcar (Fcdr (p->status));
971 if (XFASTINT (tem))
973 sprintf (tembuf, " %d", (int) XFASTINT (tem));
974 write_string (tembuf, -1);
978 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
979 remove_process (proc);
981 Findent_to (make_number (22), minspace);
982 if (NILP (p->buffer))
983 insert_string ("(none)");
984 else if (NILP (XBUFFER (p->buffer)->name))
985 insert_string ("(Killed)");
986 else
987 Finsert (1, &XBUFFER (p->buffer)->name);
989 Findent_to (make_number (37), minspace);
991 if (STRINGP (p->tty_name))
992 Finsert (1, &p->tty_name);
993 else
994 insert_string ("(none)");
996 Findent_to (make_number (49), minspace);
998 if (NETCONN_P (proc))
1000 sprintf (tembuf, "(network stream connection to %s)\n",
1001 XSTRING (XCAR (p->childp))->data);
1002 insert_string (tembuf);
1004 else
1006 tem = p->command;
1007 while (1)
1009 tem1 = Fcar (tem);
1010 Finsert (1, &tem1);
1011 tem = Fcdr (tem);
1012 if (NILP (tem))
1013 break;
1014 insert_string (" ");
1016 insert_string ("\n");
1019 return Qnil;
1022 DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
1023 doc: /* Display a list of all processes.
1024 Any process listed as exited or signaled is actually eliminated
1025 after the listing is made. */)
1028 internal_with_output_to_temp_buffer ("*Process List*",
1029 list_processes_1, Qnil);
1030 return Qnil;
1033 DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
1034 doc: /* Return a list of all processes. */)
1037 return Fmapcar (Qcdr, Vprocess_alist);
1040 /* Starting asynchronous inferior processes. */
1042 static Lisp_Object start_process_unwind ();
1044 DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
1045 doc: /* Start a program in a subprocess. Return the process object for it.
1046 NAME is name for process. It is modified if necessary to make it unique.
1047 BUFFER is the buffer or (buffer-name) to associate with the process.
1048 Process output goes at end of that buffer, unless you specify
1049 an output stream or filter function to handle the output.
1050 BUFFER may be also nil, meaning that this process is not associated
1051 with any buffer.
1052 Third arg is program file name. It is searched for in PATH.
1053 Remaining arguments are strings to give program as arguments.
1054 usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
1055 (nargs, args)
1056 int nargs;
1057 register Lisp_Object *args;
1059 Lisp_Object buffer, name, program, proc, current_dir, tem;
1060 #ifdef VMS
1061 register unsigned char *new_argv;
1062 int len;
1063 #else
1064 register unsigned char **new_argv;
1065 #endif
1066 register int i;
1067 int count = specpdl_ptr - specpdl;
1069 buffer = args[1];
1070 if (!NILP (buffer))
1071 buffer = Fget_buffer_create (buffer);
1073 /* Make sure that the child will be able to chdir to the current
1074 buffer's current directory, or its unhandled equivalent. We
1075 can't just have the child check for an error when it does the
1076 chdir, since it's in a vfork.
1078 We have to GCPRO around this because Fexpand_file_name and
1079 Funhandled_file_name_directory might call a file name handling
1080 function. The argument list is protected by the caller, so all
1081 we really have to worry about is buffer. */
1083 struct gcpro gcpro1, gcpro2;
1085 current_dir = current_buffer->directory;
1087 GCPRO2 (buffer, current_dir);
1089 current_dir
1090 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
1091 Qnil);
1092 if (NILP (Ffile_accessible_directory_p (current_dir)))
1093 report_file_error ("Setting current directory",
1094 Fcons (current_buffer->directory, Qnil));
1096 UNGCPRO;
1099 name = args[0];
1100 CHECK_STRING (name);
1102 program = args[2];
1104 CHECK_STRING (program);
1106 proc = make_process (name);
1107 /* If an error occurs and we can't start the process, we want to
1108 remove it from the process list. This means that each error
1109 check in create_process doesn't need to call remove_process
1110 itself; it's all taken care of here. */
1111 record_unwind_protect (start_process_unwind, proc);
1113 XPROCESS (proc)->childp = Qt;
1114 XPROCESS (proc)->command_channel_p = Qnil;
1115 XPROCESS (proc)->buffer = buffer;
1116 XPROCESS (proc)->sentinel = Qnil;
1117 XPROCESS (proc)->filter = Qnil;
1118 XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
1120 /* Make the process marker point into the process buffer (if any). */
1121 if (!NILP (buffer))
1122 set_marker_both (XPROCESS (proc)->mark, buffer,
1123 BUF_ZV (XBUFFER (buffer)),
1124 BUF_ZV_BYTE (XBUFFER (buffer)));
1127 /* Decide coding systems for communicating with the process. Here
1128 we don't setup the structure coding_system nor pay attention to
1129 unibyte mode. They are done in create_process. */
1131 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1132 Lisp_Object coding_systems = Qt;
1133 Lisp_Object val, *args2;
1134 struct gcpro gcpro1, gcpro2;
1136 val = Vcoding_system_for_read;
1137 if (NILP (val))
1139 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
1140 args2[0] = Qstart_process;
1141 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
1142 GCPRO2 (proc, current_dir);
1143 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1144 UNGCPRO;
1145 if (CONSP (coding_systems))
1146 val = XCAR (coding_systems);
1147 else if (CONSP (Vdefault_process_coding_system))
1148 val = XCAR (Vdefault_process_coding_system);
1150 XPROCESS (proc)->decode_coding_system = val;
1152 val = Vcoding_system_for_write;
1153 if (NILP (val))
1155 if (EQ (coding_systems, Qt))
1157 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof args2);
1158 args2[0] = Qstart_process;
1159 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
1160 GCPRO2 (proc, current_dir);
1161 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1162 UNGCPRO;
1164 if (CONSP (coding_systems))
1165 val = XCDR (coding_systems);
1166 else if (CONSP (Vdefault_process_coding_system))
1167 val = XCDR (Vdefault_process_coding_system);
1169 XPROCESS (proc)->encode_coding_system = val;
1172 #ifdef VMS
1173 /* Make a one member argv with all args concatenated
1174 together separated by a blank. */
1175 len = STRING_BYTES (XSTRING (program)) + 2;
1176 for (i = 3; i < nargs; i++)
1178 tem = args[i];
1179 CHECK_STRING (tem);
1180 len += STRING_BYTES (XSTRING (tem)) + 1; /* count the blank */
1182 new_argv = (unsigned char *) alloca (len);
1183 strcpy (new_argv, XSTRING (program)->data);
1184 for (i = 3; i < nargs; i++)
1186 tem = args[i];
1187 CHECK_STRING (tem);
1188 strcat (new_argv, " ");
1189 strcat (new_argv, XSTRING (tem)->data);
1191 /* Need to add code here to check for program existence on VMS */
1193 #else /* not VMS */
1194 new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
1196 /* If program file name is not absolute, search our path for it */
1197 if (!IS_DIRECTORY_SEP (XSTRING (program)->data[0])
1198 && !(XSTRING (program)->size > 1
1199 && IS_DEVICE_SEP (XSTRING (program)->data[1])))
1201 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1203 tem = Qnil;
1204 GCPRO4 (name, program, buffer, current_dir);
1205 openp (Vexec_path, program, Vexec_suffixes, &tem, 1);
1206 UNGCPRO;
1207 if (NILP (tem))
1208 report_file_error ("Searching for program", Fcons (program, Qnil));
1209 tem = Fexpand_file_name (tem, Qnil);
1210 tem = ENCODE_FILE (tem);
1211 new_argv[0] = XSTRING (tem)->data;
1213 else
1215 if (!NILP (Ffile_directory_p (program)))
1216 error ("Specified program for new process is a directory");
1218 tem = ENCODE_FILE (program);
1219 new_argv[0] = XSTRING (tem)->data;
1222 /* Here we encode arguments by the coding system used for sending
1223 data to the process. We don't support using different coding
1224 systems for encoding arguments and for encoding data sent to the
1225 process. */
1227 for (i = 3; i < nargs; i++)
1229 tem = args[i];
1230 CHECK_STRING (tem);
1231 if (STRING_MULTIBYTE (tem))
1232 tem = (code_convert_string_norecord
1233 (tem, XPROCESS (proc)->encode_coding_system, 1));
1234 new_argv[i - 2] = XSTRING (tem)->data;
1236 new_argv[i - 2] = 0;
1237 #endif /* not VMS */
1239 XPROCESS (proc)->decoding_buf = make_uninit_string (0);
1240 XPROCESS (proc)->decoding_carryover = make_number (0);
1241 XPROCESS (proc)->encoding_buf = make_uninit_string (0);
1242 XPROCESS (proc)->encoding_carryover = make_number (0);
1244 XPROCESS (proc)->inherit_coding_system_flag
1245 = (NILP (buffer) || !inherit_process_coding_system
1246 ? Qnil : Qt);
1248 create_process (proc, (char **) new_argv, current_dir);
1250 return unbind_to (count, proc);
1253 /* This function is the unwind_protect form for Fstart_process. If
1254 PROC doesn't have its pid set, then we know someone has signaled
1255 an error and the process wasn't started successfully, so we should
1256 remove it from the process list. */
1257 static Lisp_Object
1258 start_process_unwind (proc)
1259 Lisp_Object proc;
1261 if (!PROCESSP (proc))
1262 abort ();
1264 /* Was PROC started successfully? */
1265 if (XINT (XPROCESS (proc)->pid) <= 0)
1266 remove_process (proc);
1268 return Qnil;
1271 void
1272 create_process_1 (timer)
1273 struct atimer *timer;
1275 /* Nothing to do. */
1279 #if 0 /* This doesn't work; see the note before sigchld_handler. */
1280 #ifdef USG
1281 #ifdef SIGCHLD
1282 /* Mimic blocking of signals on system V, which doesn't really have it. */
1284 /* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1285 int sigchld_deferred;
1287 SIGTYPE
1288 create_process_sigchld ()
1290 signal (SIGCHLD, create_process_sigchld);
1292 sigchld_deferred = 1;
1294 #endif
1295 #endif
1296 #endif
1298 #ifndef VMS /* VMS version of this function is in vmsproc.c. */
1299 void
1300 create_process (process, new_argv, current_dir)
1301 Lisp_Object process;
1302 char **new_argv;
1303 Lisp_Object current_dir;
1305 int pid, inchannel, outchannel;
1306 int sv[2];
1307 #ifdef POSIX_SIGNALS
1308 sigset_t procmask;
1309 sigset_t blocked;
1310 struct sigaction sigint_action;
1311 struct sigaction sigquit_action;
1312 #ifdef AIX
1313 struct sigaction sighup_action;
1314 #endif
1315 #else /* !POSIX_SIGNALS */
1316 #if 0
1317 #ifdef SIGCHLD
1318 SIGTYPE (*sigchld)();
1319 #endif
1320 #endif /* 0 */
1321 #endif /* !POSIX_SIGNALS */
1322 /* Use volatile to protect variables from being clobbered by longjmp. */
1323 volatile int forkin, forkout;
1324 volatile int pty_flag = 0;
1325 #ifndef USE_CRT_DLL
1326 extern char **environ;
1327 #endif
1329 inchannel = outchannel = -1;
1331 #ifdef HAVE_PTYS
1332 if (!NILP (Vprocess_connection_type))
1333 outchannel = inchannel = allocate_pty ();
1335 if (inchannel >= 0)
1337 #ifndef USG
1338 /* On USG systems it does not work to open the pty's tty here
1339 and then close and reopen it in the child. */
1340 #ifdef O_NOCTTY
1341 /* Don't let this terminal become our controlling terminal
1342 (in case we don't have one). */
1343 forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
1344 #else
1345 forkout = forkin = emacs_open (pty_name, O_RDWR, 0);
1346 #endif
1347 if (forkin < 0)
1348 report_file_error ("Opening pty", Qnil);
1349 #else
1350 forkin = forkout = -1;
1351 #endif /* not USG */
1352 pty_flag = 1;
1354 else
1355 #endif /* HAVE_PTYS */
1356 #ifdef SKTPAIR
1358 if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
1359 report_file_error ("Opening socketpair", Qnil);
1360 outchannel = inchannel = sv[0];
1361 forkout = forkin = sv[1];
1363 #else /* not SKTPAIR */
1365 int tem;
1366 tem = pipe (sv);
1367 if (tem < 0)
1368 report_file_error ("Creating pipe", Qnil);
1369 inchannel = sv[0];
1370 forkout = sv[1];
1371 tem = pipe (sv);
1372 if (tem < 0)
1374 emacs_close (inchannel);
1375 emacs_close (forkout);
1376 report_file_error ("Creating pipe", Qnil);
1378 outchannel = sv[1];
1379 forkin = sv[0];
1381 #endif /* not SKTPAIR */
1383 #if 0
1384 /* Replaced by close_process_descs */
1385 set_exclusive_use (inchannel);
1386 set_exclusive_use (outchannel);
1387 #endif
1389 /* Stride people say it's a mystery why this is needed
1390 as well as the O_NDELAY, but that it fails without this. */
1391 #if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1393 int one = 1;
1394 ioctl (inchannel, FIONBIO, &one);
1396 #endif
1398 #ifdef O_NONBLOCK
1399 fcntl (inchannel, F_SETFL, O_NONBLOCK);
1400 fcntl (outchannel, F_SETFL, O_NONBLOCK);
1401 #else
1402 #ifdef O_NDELAY
1403 fcntl (inchannel, F_SETFL, O_NDELAY);
1404 fcntl (outchannel, F_SETFL, O_NDELAY);
1405 #endif
1406 #endif
1408 /* Record this as an active process, with its channels.
1409 As a result, child_setup will close Emacs's side of the pipes. */
1410 chan_process[inchannel] = process;
1411 XSETINT (XPROCESS (process)->infd, inchannel);
1412 XSETINT (XPROCESS (process)->outfd, outchannel);
1413 /* Record the tty descriptor used in the subprocess. */
1414 if (forkin < 0)
1415 XPROCESS (process)->subtty = Qnil;
1416 else
1417 XSETFASTINT (XPROCESS (process)->subtty, forkin);
1418 XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
1419 XPROCESS (process)->status = Qrun;
1420 if (!proc_decode_coding_system[inchannel])
1421 proc_decode_coding_system[inchannel]
1422 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
1423 setup_coding_system (XPROCESS (process)->decode_coding_system,
1424 proc_decode_coding_system[inchannel]);
1425 if (!proc_encode_coding_system[outchannel])
1426 proc_encode_coding_system[outchannel]
1427 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
1428 setup_coding_system (XPROCESS (process)->encode_coding_system,
1429 proc_encode_coding_system[outchannel]);
1431 /* Delay interrupts until we have a chance to store
1432 the new fork's pid in its process structure */
1433 #ifdef POSIX_SIGNALS
1434 sigemptyset (&blocked);
1435 #ifdef SIGCHLD
1436 sigaddset (&blocked, SIGCHLD);
1437 #endif
1438 #ifdef HAVE_WORKING_VFORK
1439 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1440 this sets the parent's signal handlers as well as the child's.
1441 So delay all interrupts whose handlers the child might munge,
1442 and record the current handlers so they can be restored later. */
1443 sigaddset (&blocked, SIGINT ); sigaction (SIGINT , 0, &sigint_action );
1444 sigaddset (&blocked, SIGQUIT); sigaction (SIGQUIT, 0, &sigquit_action);
1445 #ifdef AIX
1446 sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action );
1447 #endif
1448 #endif /* HAVE_WORKING_VFORK */
1449 sigprocmask (SIG_BLOCK, &blocked, &procmask);
1450 #else /* !POSIX_SIGNALS */
1451 #ifdef SIGCHLD
1452 #ifdef BSD4_1
1453 sighold (SIGCHLD);
1454 #else /* not BSD4_1 */
1455 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1456 sigsetmask (sigmask (SIGCHLD));
1457 #else /* ordinary USG */
1458 #if 0
1459 sigchld_deferred = 0;
1460 sigchld = signal (SIGCHLD, create_process_sigchld);
1461 #endif
1462 #endif /* ordinary USG */
1463 #endif /* not BSD4_1 */
1464 #endif /* SIGCHLD */
1465 #endif /* !POSIX_SIGNALS */
1467 FD_SET (inchannel, &input_wait_mask);
1468 FD_SET (inchannel, &non_keyboard_wait_mask);
1469 if (inchannel > max_process_desc)
1470 max_process_desc = inchannel;
1472 /* Until we store the proper pid, enable sigchld_handler
1473 to recognize an unknown pid as standing for this process.
1474 It is very important not to let this `marker' value stay
1475 in the table after this function has returned; if it does
1476 it might cause call-process to hang and subsequent asynchronous
1477 processes to get their return values scrambled. */
1478 XSETINT (XPROCESS (process)->pid, -1);
1480 BLOCK_INPUT;
1483 /* child_setup must clobber environ on systems with true vfork.
1484 Protect it from permanent change. */
1485 char **save_environ = environ;
1487 current_dir = ENCODE_FILE (current_dir);
1489 #ifndef WINDOWSNT
1490 pid = vfork ();
1491 if (pid == 0)
1492 #endif /* not WINDOWSNT */
1494 int xforkin = forkin;
1495 int xforkout = forkout;
1497 #if 0 /* This was probably a mistake--it duplicates code later on,
1498 but fails to handle all the cases. */
1499 /* Make sure SIGCHLD is not blocked in the child. */
1500 sigsetmask (SIGEMPTYMASK);
1501 #endif
1503 /* Make the pty be the controlling terminal of the process. */
1504 #ifdef HAVE_PTYS
1505 /* First, disconnect its current controlling terminal. */
1506 #ifdef HAVE_SETSID
1507 /* We tried doing setsid only if pty_flag, but it caused
1508 process_set_signal to fail on SGI when using a pipe. */
1509 setsid ();
1510 /* Make the pty's terminal the controlling terminal. */
1511 if (pty_flag)
1513 #ifdef TIOCSCTTY
1514 /* We ignore the return value
1515 because faith@cs.unc.edu says that is necessary on Linux. */
1516 ioctl (xforkin, TIOCSCTTY, 0);
1517 #endif
1519 #else /* not HAVE_SETSID */
1520 #ifdef USG
1521 /* It's very important to call setpgrp here and no time
1522 afterwards. Otherwise, we lose our controlling tty which
1523 is set when we open the pty. */
1524 setpgrp ();
1525 #endif /* USG */
1526 #endif /* not HAVE_SETSID */
1527 #if defined (HAVE_TERMIOS) && defined (LDISC1)
1528 if (pty_flag && xforkin >= 0)
1530 struct termios t;
1531 tcgetattr (xforkin, &t);
1532 t.c_lflag = LDISC1;
1533 if (tcsetattr (xforkin, TCSANOW, &t) < 0)
1534 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
1536 #else
1537 #if defined (NTTYDISC) && defined (TIOCSETD)
1538 if (pty_flag && xforkin >= 0)
1540 /* Use new line discipline. */
1541 int ldisc = NTTYDISC;
1542 ioctl (xforkin, TIOCSETD, &ldisc);
1544 #endif
1545 #endif
1546 #ifdef TIOCNOTTY
1547 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1548 can do TIOCSPGRP only to the process's controlling tty. */
1549 if (pty_flag)
1551 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1552 I can't test it since I don't have 4.3. */
1553 int j = emacs_open ("/dev/tty", O_RDWR, 0);
1554 ioctl (j, TIOCNOTTY, 0);
1555 emacs_close (j);
1556 #ifndef USG
1557 /* In order to get a controlling terminal on some versions
1558 of BSD, it is necessary to put the process in pgrp 0
1559 before it opens the terminal. */
1560 #ifdef HAVE_SETPGID
1561 setpgid (0, 0);
1562 #else
1563 setpgrp (0, 0);
1564 #endif
1565 #endif
1567 #endif /* TIOCNOTTY */
1569 #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY)
1570 /*** There is a suggestion that this ought to be a
1571 conditional on TIOCSPGRP,
1572 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1573 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1574 that system does seem to need this code, even though
1575 both HAVE_SETSID and TIOCSCTTY are defined. */
1576 /* Now close the pty (if we had it open) and reopen it.
1577 This makes the pty the controlling terminal of the subprocess. */
1578 if (pty_flag)
1580 #ifdef SET_CHILD_PTY_PGRP
1581 int pgrp = getpid ();
1582 #endif
1584 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1585 would work? */
1586 if (xforkin >= 0)
1587 emacs_close (xforkin);
1588 xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0);
1590 if (xforkin < 0)
1592 emacs_write (1, "Couldn't open the pty terminal ", 31);
1593 emacs_write (1, pty_name, strlen (pty_name));
1594 emacs_write (1, "\n", 1);
1595 _exit (1);
1598 #ifdef SET_CHILD_PTY_PGRP
1599 ioctl (xforkin, TIOCSPGRP, &pgrp);
1600 ioctl (xforkout, TIOCSPGRP, &pgrp);
1601 #endif
1603 #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */
1605 #ifdef SETUP_SLAVE_PTY
1606 if (pty_flag)
1608 SETUP_SLAVE_PTY;
1610 #endif /* SETUP_SLAVE_PTY */
1611 #ifdef AIX
1612 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1613 Now reenable it in the child, so it will die when we want it to. */
1614 if (pty_flag)
1615 signal (SIGHUP, SIG_DFL);
1616 #endif
1617 #endif /* HAVE_PTYS */
1619 signal (SIGINT, SIG_DFL);
1620 signal (SIGQUIT, SIG_DFL);
1622 /* Stop blocking signals in the child. */
1623 #ifdef POSIX_SIGNALS
1624 sigprocmask (SIG_SETMASK, &procmask, 0);
1625 #else /* !POSIX_SIGNALS */
1626 #ifdef SIGCHLD
1627 #ifdef BSD4_1
1628 sigrelse (SIGCHLD);
1629 #else /* not BSD4_1 */
1630 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1631 sigsetmask (SIGEMPTYMASK);
1632 #else /* ordinary USG */
1633 #if 0
1634 signal (SIGCHLD, sigchld);
1635 #endif
1636 #endif /* ordinary USG */
1637 #endif /* not BSD4_1 */
1638 #endif /* SIGCHLD */
1639 #endif /* !POSIX_SIGNALS */
1641 if (pty_flag)
1642 child_setup_tty (xforkout);
1643 #ifdef WINDOWSNT
1644 pid = child_setup (xforkin, xforkout, xforkout,
1645 new_argv, 1, current_dir);
1646 #else /* not WINDOWSNT */
1647 child_setup (xforkin, xforkout, xforkout,
1648 new_argv, 1, current_dir);
1649 #endif /* not WINDOWSNT */
1651 environ = save_environ;
1654 UNBLOCK_INPUT;
1656 /* This runs in the Emacs process. */
1657 if (pid < 0)
1659 if (forkin >= 0)
1660 emacs_close (forkin);
1661 if (forkin != forkout && forkout >= 0)
1662 emacs_close (forkout);
1664 else
1666 /* vfork succeeded. */
1667 XSETFASTINT (XPROCESS (process)->pid, pid);
1669 #ifdef WINDOWSNT
1670 register_child (pid, inchannel);
1671 #endif /* WINDOWSNT */
1673 /* If the subfork execv fails, and it exits,
1674 this close hangs. I don't know why.
1675 So have an interrupt jar it loose. */
1677 struct atimer *timer;
1678 EMACS_TIME offset;
1680 stop_polling ();
1681 EMACS_SET_SECS_USECS (offset, 1, 0);
1682 timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
1684 XPROCESS (process)->subtty = Qnil;
1685 if (forkin >= 0)
1686 emacs_close (forkin);
1688 cancel_atimer (timer);
1689 start_polling ();
1692 if (forkin != forkout && forkout >= 0)
1693 emacs_close (forkout);
1695 #ifdef HAVE_PTYS
1696 if (pty_flag)
1697 XPROCESS (process)->tty_name = build_string (pty_name);
1698 else
1699 #endif
1700 XPROCESS (process)->tty_name = Qnil;
1703 /* Restore the signal state whether vfork succeeded or not.
1704 (We will signal an error, below, if it failed.) */
1705 #ifdef POSIX_SIGNALS
1706 #ifdef HAVE_WORKING_VFORK
1707 /* Restore the parent's signal handlers. */
1708 sigaction (SIGINT, &sigint_action, 0);
1709 sigaction (SIGQUIT, &sigquit_action, 0);
1710 #ifdef AIX
1711 sigaction (SIGHUP, &sighup_action, 0);
1712 #endif
1713 #endif /* HAVE_WORKING_VFORK */
1714 /* Stop blocking signals in the parent. */
1715 sigprocmask (SIG_SETMASK, &procmask, 0);
1716 #else /* !POSIX_SIGNALS */
1717 #ifdef SIGCHLD
1718 #ifdef BSD4_1
1719 sigrelse (SIGCHLD);
1720 #else /* not BSD4_1 */
1721 #if defined (BSD_SYSTEM) || defined (UNIPLUS) || defined (HPUX)
1722 sigsetmask (SIGEMPTYMASK);
1723 #else /* ordinary USG */
1724 #if 0
1725 signal (SIGCHLD, sigchld);
1726 /* Now really handle any of these signals
1727 that came in during this function. */
1728 if (sigchld_deferred)
1729 kill (getpid (), SIGCHLD);
1730 #endif
1731 #endif /* ordinary USG */
1732 #endif /* not BSD4_1 */
1733 #endif /* SIGCHLD */
1734 #endif /* !POSIX_SIGNALS */
1736 /* Now generate the error if vfork failed. */
1737 if (pid < 0)
1738 report_file_error ("Doing vfork", Qnil);
1740 #endif /* not VMS */
1742 #ifdef HAVE_SOCKETS
1744 /* open a TCP network connection to a given HOST/SERVICE. Treated
1745 exactly like a normal process when reading and writing. Only
1746 differences are in status display and process deletion. A network
1747 connection has no PID; you cannot signal it. All you can do is
1748 deactivate and close it via delete-process */
1750 DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
1751 4, 4, 0,
1752 doc: /* Open a TCP connection for a service to a host.
1753 Returns a subprocess-object to represent the connection.
1754 Input and output work as for subprocesses; `delete-process' closes it.
1755 Args are NAME BUFFER HOST SERVICE.
1756 NAME is name for process. It is modified if necessary to make it unique.
1757 BUFFER is the buffer (or buffer-name) to associate with the process.
1758 Process output goes at end of that buffer, unless you specify
1759 an output stream or filter function to handle the output.
1760 BUFFER may be also nil, meaning that this process is not associated
1761 with any buffer
1762 Third arg is name of the host to connect to, or its IP address.
1763 Fourth arg SERVICE is name of the service desired, or an integer
1764 specifying a port number to connect to. */)
1765 (name, buffer, host, service)
1766 Lisp_Object name, buffer, host, service;
1768 Lisp_Object proc;
1769 #ifdef HAVE_GETADDRINFO
1770 struct addrinfo hints, *res, *lres;
1771 int ret = 0;
1772 int xerrno = 0;
1773 char *portstring, portbuf[128];
1774 #else /* HAVE_GETADDRINFO */
1775 struct sockaddr_in address;
1776 struct servent *svc_info;
1777 struct hostent *host_info_ptr, host_info;
1778 char *(addr_list[2]);
1779 IN_ADDR numeric_addr;
1780 int port;
1781 #endif /* HAVE_GETADDRINFO */
1782 int s = -1, outch, inch;
1783 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1784 int retry = 0;
1785 int count = specpdl_ptr - specpdl;
1786 int count1;
1788 #ifdef WINDOWSNT
1789 /* Ensure socket support is loaded if available. */
1790 init_winsock (TRUE);
1791 #endif
1793 GCPRO4 (name, buffer, host, service);
1794 CHECK_STRING (name);
1795 CHECK_STRING (host);
1797 #ifdef HAVE_GETADDRINFO
1798 /* SERVICE can either be a string or int.
1799 Convert to a C string for later use by getaddrinfo. */
1800 if (INTEGERP (service))
1802 sprintf (portbuf, "%ld", (long) XINT (service));
1803 portstring = portbuf;
1805 else
1807 CHECK_STRING (service);
1808 portstring = XSTRING (service)->data;
1810 #else /* HAVE_GETADDRINFO */
1811 if (INTEGERP (service))
1812 port = htons ((unsigned short) XINT (service));
1813 else
1815 CHECK_STRING (service);
1816 svc_info = getservbyname (XSTRING (service)->data, "tcp");
1817 if (svc_info == 0)
1818 error ("Unknown service \"%s\"", XSTRING (service)->data);
1819 port = svc_info->s_port;
1821 #endif /* HAVE_GETADDRINFO */
1824 /* Slow down polling to every ten seconds.
1825 Some kernels have a bug which causes retrying connect to fail
1826 after a connect. Polling can interfere with gethostbyname too. */
1827 #ifdef POLL_FOR_INPUT
1828 record_unwind_protect (unwind_stop_other_atimers, Qnil);
1829 bind_polling_period (10);
1830 #endif
1832 #ifndef TERM
1833 #ifdef HAVE_GETADDRINFO
1834 immediate_quit = 1;
1835 QUIT;
1836 memset (&hints, 0, sizeof (hints));
1837 hints.ai_flags = 0;
1838 hints.ai_family = AF_UNSPEC;
1839 hints.ai_socktype = SOCK_STREAM;
1840 hints.ai_protocol = 0;
1841 ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
1842 if (ret)
1843 #ifdef HAVE_GAI_STRERROR
1844 error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret));
1845 #else
1846 error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring,
1847 ret);
1848 #endif
1849 immediate_quit = 0;
1851 /* Do this in case we never enter the for-loop below. */
1852 count1 = specpdl_ptr - specpdl;
1853 s = -1;
1855 for (lres = res; lres; lres = lres->ai_next)
1857 s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
1858 if (s < 0)
1860 xerrno = errno;
1861 continue;
1864 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1865 when connect is interrupted. So let's not let it get interrupted.
1866 Note we do not turn off polling, because polling is only used
1867 when not interrupt_input, and thus not normally used on the systems
1868 which have this bug. On systems which use polling, there's no way
1869 to quit if polling is turned off. */
1870 if (interrupt_input)
1871 unrequest_sigio ();
1873 /* Make us close S if quit. */
1874 count1 = specpdl_ptr - specpdl;
1875 record_unwind_protect (close_file_unwind, make_number (s));
1877 loop:
1879 immediate_quit = 1;
1880 QUIT;
1882 /* This turns off all alarm-based interrupts; the
1883 bind_polling_period call above doesn't always turn all the
1884 short-interval ones off, especially if interrupt_input is
1885 set.
1887 It'd be nice to be able to control the connect timeout
1888 though. Would non-blocking connect calls be portable? */
1889 turn_on_atimers (0);
1890 ret = connect (s, lres->ai_addr, lres->ai_addrlen);
1891 xerrno = errno;
1892 turn_on_atimers (1);
1894 if (ret == 0 || xerrno == EISCONN)
1895 /* The unwind-protect will be discarded afterwards.
1896 Likewise for immediate_quit. */
1897 break;
1899 immediate_quit = 0;
1901 if (xerrno == EINTR)
1902 goto loop;
1903 if (xerrno == EADDRINUSE && retry < 20)
1905 /* A delay here is needed on some FreeBSD systems,
1906 and it is harmless, since this retrying takes time anyway
1907 and should be infrequent. */
1908 Fsleep_for (make_number (1), Qnil);
1909 retry++;
1910 goto loop;
1913 /* Discard the unwind protect closing S. */
1914 specpdl_ptr = specpdl + count1;
1915 count1 = specpdl_ptr - specpdl;
1917 emacs_close (s);
1918 s = -1;
1921 freeaddrinfo (res);
1922 if (s < 0)
1924 if (interrupt_input)
1925 request_sigio ();
1927 errno = xerrno;
1928 report_file_error ("connection failed",
1929 Fcons (host, Fcons (name, Qnil)));
1932 #else /* not HAVE_GETADDRINFO */
1934 while (1)
1936 #if 0
1937 #ifdef TRY_AGAIN
1938 h_errno = 0;
1939 #endif
1940 #endif
1941 immediate_quit = 1;
1942 QUIT;
1943 host_info_ptr = gethostbyname (XSTRING (host)->data);
1944 immediate_quit = 0;
1945 #if 0
1946 #ifdef TRY_AGAIN
1947 if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN))
1948 #endif
1949 #endif
1950 break;
1951 Fsleep_for (make_number (1), Qnil);
1954 if (host_info_ptr == 0)
1955 /* Attempt to interpret host as numeric inet address */
1957 numeric_addr = inet_addr ((char *) XSTRING (host)->data);
1958 if (NUMERIC_ADDR_ERROR)
1959 error ("Unknown host \"%s\"", XSTRING (host)->data);
1961 host_info_ptr = &host_info;
1962 host_info.h_name = 0;
1963 host_info.h_aliases = 0;
1964 host_info.h_addrtype = AF_INET;
1965 #ifdef h_addr
1966 /* Older machines have only one address slot called h_addr.
1967 Newer machines have h_addr_list, but #define h_addr to
1968 be its first element. */
1969 host_info.h_addr_list = &(addr_list[0]);
1970 #endif
1971 host_info.h_addr = (char*)(&numeric_addr);
1972 addr_list[1] = 0;
1973 /* numeric_addr isn't null-terminated; it has fixed length. */
1974 host_info.h_length = sizeof (numeric_addr);
1977 bzero (&address, sizeof address);
1978 bcopy (host_info_ptr->h_addr, (char *) &address.sin_addr,
1979 host_info_ptr->h_length);
1980 address.sin_family = host_info_ptr->h_addrtype;
1981 address.sin_port = port;
1983 s = socket (host_info_ptr->h_addrtype, SOCK_STREAM, 0);
1984 if (s < 0)
1985 report_file_error ("error creating socket", Fcons (name, Qnil));
1987 count1 = specpdl_ptr - specpdl;
1988 record_unwind_protect (close_file_unwind, make_number (s));
1990 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1991 when connect is interrupted. So let's not let it get interrupted.
1992 Note we do not turn off polling, because polling is only used
1993 when not interrupt_input, and thus not normally used on the systems
1994 which have this bug. On systems which use polling, there's no way
1995 to quit if polling is turned off. */
1996 if (interrupt_input)
1997 unrequest_sigio ();
1999 loop:
2001 immediate_quit = 1;
2002 QUIT;
2004 if (connect (s, (struct sockaddr *) &address, sizeof address) == -1
2005 && errno != EISCONN)
2007 int xerrno = errno;
2009 immediate_quit = 0;
2011 if (errno == EINTR)
2012 goto loop;
2013 if (errno == EADDRINUSE && retry < 20)
2015 /* A delay here is needed on some FreeBSD systems,
2016 and it is harmless, since this retrying takes time anyway
2017 and should be infrequent. */
2018 Fsleep_for (make_number (1), Qnil);
2019 retry++;
2020 goto loop;
2023 /* Discard the unwind protect. */
2024 specpdl_ptr = specpdl + count1;
2026 emacs_close (s);
2028 if (interrupt_input)
2029 request_sigio ();
2031 errno = xerrno;
2032 report_file_error ("connection failed",
2033 Fcons (host, Fcons (name, Qnil)));
2036 #endif /* not HAVE_GETADDRINFO */
2038 immediate_quit = 0;
2040 /* Discard the unwind protect, if any. */
2041 specpdl_ptr = specpdl + count1;
2043 #ifdef POLL_FOR_INPUT
2044 unbind_to (count, Qnil);
2045 #endif
2047 if (interrupt_input)
2048 request_sigio ();
2050 #else /* TERM */
2051 s = connect_server (0);
2052 if (s < 0)
2053 report_file_error ("error creating socket", Fcons (name, Qnil));
2054 send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port));
2055 send_command (s, C_DUMB, 1, 0);
2056 #endif /* TERM */
2058 inch = s;
2059 outch = s;
2061 if (!NILP (buffer))
2062 buffer = Fget_buffer_create (buffer);
2063 proc = make_process (name);
2065 chan_process[inch] = proc;
2067 #ifdef O_NONBLOCK
2068 fcntl (inch, F_SETFL, O_NONBLOCK);
2069 #else
2070 #ifdef O_NDELAY
2071 fcntl (inch, F_SETFL, O_NDELAY);
2072 #endif
2073 #endif
2075 XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));
2076 XPROCESS (proc)->command_channel_p = Qnil;
2077 XPROCESS (proc)->buffer = buffer;
2078 XPROCESS (proc)->sentinel = Qnil;
2079 XPROCESS (proc)->filter = Qnil;
2080 XPROCESS (proc)->command = Qnil;
2081 XPROCESS (proc)->pid = Qnil;
2082 XSETINT (XPROCESS (proc)->infd, inch);
2083 XSETINT (XPROCESS (proc)->outfd, outch);
2084 XPROCESS (proc)->status = Qrun;
2085 FD_SET (inch, &input_wait_mask);
2086 FD_SET (inch, &non_keyboard_wait_mask);
2087 if (inch > max_process_desc)
2088 max_process_desc = inch;
2091 /* Setup coding systems for communicating with the network stream. */
2092 struct gcpro gcpro1;
2093 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2094 Lisp_Object coding_systems = Qt;
2095 Lisp_Object args[5], val;
2097 if (!NILP (Vcoding_system_for_read))
2098 val = Vcoding_system_for_read;
2099 else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
2100 || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
2101 /* We dare not decode end-of-line format by setting VAL to
2102 Qraw_text, because the existing Emacs Lisp libraries
2103 assume that they receive bare code including a sequene of
2104 CR LF. */
2105 val = Qnil;
2106 else
2108 args[0] = Qopen_network_stream, args[1] = name,
2109 args[2] = buffer, args[3] = host, args[4] = service;
2110 GCPRO1 (proc);
2111 coding_systems = Ffind_operation_coding_system (5, args);
2112 UNGCPRO;
2113 if (CONSP (coding_systems))
2114 val = XCAR (coding_systems);
2115 else if (CONSP (Vdefault_process_coding_system))
2116 val = XCAR (Vdefault_process_coding_system);
2117 else
2118 val = Qnil;
2120 XPROCESS (proc)->decode_coding_system = val;
2122 if (!NILP (Vcoding_system_for_write))
2123 val = Vcoding_system_for_write;
2124 else if (NILP (current_buffer->enable_multibyte_characters))
2125 val = Qnil;
2126 else
2128 if (EQ (coding_systems, Qt))
2130 args[0] = Qopen_network_stream, args[1] = name,
2131 args[2] = buffer, args[3] = host, args[4] = service;
2132 GCPRO1 (proc);
2133 coding_systems = Ffind_operation_coding_system (5, args);
2134 UNGCPRO;
2136 if (CONSP (coding_systems))
2137 val = XCDR (coding_systems);
2138 else if (CONSP (Vdefault_process_coding_system))
2139 val = XCDR (Vdefault_process_coding_system);
2140 else
2141 val = Qnil;
2143 XPROCESS (proc)->encode_coding_system = val;
2146 if (!proc_decode_coding_system[inch])
2147 proc_decode_coding_system[inch]
2148 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
2149 setup_coding_system (XPROCESS (proc)->decode_coding_system,
2150 proc_decode_coding_system[inch]);
2151 if (!proc_encode_coding_system[outch])
2152 proc_encode_coding_system[outch]
2153 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
2154 setup_coding_system (XPROCESS (proc)->encode_coding_system,
2155 proc_encode_coding_system[outch]);
2157 XPROCESS (proc)->decoding_buf = make_uninit_string (0);
2158 XPROCESS (proc)->decoding_carryover = make_number (0);
2159 XPROCESS (proc)->encoding_buf = make_uninit_string (0);
2160 XPROCESS (proc)->encoding_carryover = make_number (0);
2162 XPROCESS (proc)->inherit_coding_system_flag
2163 = (NILP (buffer) || !inherit_process_coding_system
2164 ? Qnil : Qt);
2166 UNGCPRO;
2167 return proc;
2169 #endif /* HAVE_SOCKETS */
2171 void
2172 deactivate_process (proc)
2173 Lisp_Object proc;
2175 register int inchannel, outchannel;
2176 register struct Lisp_Process *p = XPROCESS (proc);
2178 inchannel = XINT (p->infd);
2179 outchannel = XINT (p->outfd);
2181 if (inchannel >= 0)
2183 /* Beware SIGCHLD hereabouts. */
2184 flush_pending_output (inchannel);
2185 #ifdef VMS
2187 VMS_PROC_STUFF *get_vms_process_pointer (), *vs;
2188 sys$dassgn (outchannel);
2189 vs = get_vms_process_pointer (p->pid);
2190 if (vs)
2191 give_back_vms_process_stuff (vs);
2193 #else
2194 emacs_close (inchannel);
2195 if (outchannel >= 0 && outchannel != inchannel)
2196 emacs_close (outchannel);
2197 #endif
2199 XSETINT (p->infd, -1);
2200 XSETINT (p->outfd, -1);
2201 chan_process[inchannel] = Qnil;
2202 FD_CLR (inchannel, &input_wait_mask);
2203 FD_CLR (inchannel, &non_keyboard_wait_mask);
2204 if (inchannel == max_process_desc)
2206 int i;
2207 /* We just closed the highest-numbered process input descriptor,
2208 so recompute the highest-numbered one now. */
2209 max_process_desc = 0;
2210 for (i = 0; i < MAXDESC; i++)
2211 if (!NILP (chan_process[i]))
2212 max_process_desc = i;
2217 /* Close all descriptors currently in use for communication
2218 with subprocess. This is used in a newly-forked subprocess
2219 to get rid of irrelevant descriptors. */
2221 void
2222 close_process_descs ()
2224 #ifndef WINDOWSNT
2225 int i;
2226 for (i = 0; i < MAXDESC; i++)
2228 Lisp_Object process;
2229 process = chan_process[i];
2230 if (!NILP (process))
2232 int in = XINT (XPROCESS (process)->infd);
2233 int out = XINT (XPROCESS (process)->outfd);
2234 if (in >= 0)
2235 emacs_close (in);
2236 if (out >= 0 && in != out)
2237 emacs_close (out);
2240 #endif
2243 DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
2244 0, 3, 0,
2245 doc: /* Allow any pending output from subprocesses to be read by Emacs.
2246 It is read into the process' buffers or given to their filter functions.
2247 Non-nil arg PROCESS means do not return until some output has been received
2248 from PROCESS.
2249 Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of
2250 seconds and microseconds to wait; return after that much time whether
2251 or not there is input.
2252 Return non-nil iff we received any output before the timeout expired. */)
2253 (process, timeout, timeout_msecs)
2254 register Lisp_Object process, timeout, timeout_msecs;
2256 int seconds;
2257 int useconds;
2259 if (! NILP (process))
2260 CHECK_PROCESS (process);
2262 if (! NILP (timeout_msecs))
2264 CHECK_NUMBER (timeout_msecs);
2265 useconds = XINT (timeout_msecs);
2266 if (!INTEGERP (timeout))
2267 XSETINT (timeout, 0);
2270 int carry = useconds / 1000000;
2272 XSETINT (timeout, XINT (timeout) + carry);
2273 useconds -= carry * 1000000;
2275 /* I think this clause is necessary because C doesn't
2276 guarantee a particular rounding direction for negative
2277 integers. */
2278 if (useconds < 0)
2280 XSETINT (timeout, XINT (timeout) - 1);
2281 useconds += 1000000;
2285 else
2286 useconds = 0;
2288 if (! NILP (timeout))
2290 CHECK_NUMBER (timeout);
2291 seconds = XINT (timeout);
2292 if (seconds < 0 || (seconds == 0 && useconds == 0))
2293 seconds = -1;
2295 else
2297 if (NILP (process))
2298 seconds = -1;
2299 else
2300 seconds = 0;
2303 if (NILP (process))
2304 XSETFASTINT (process, 0);
2306 return
2307 (wait_reading_process_input (seconds, useconds, process, 0)
2308 ? Qt : Qnil);
2311 /* This variable is different from waiting_for_input in keyboard.c.
2312 It is used to communicate to a lisp process-filter/sentinel (via the
2313 function Fwaiting_for_user_input_p below) whether emacs was waiting
2314 for user-input when that process-filter was called.
2315 waiting_for_input cannot be used as that is by definition 0 when
2316 lisp code is being evalled.
2317 This is also used in record_asynch_buffer_change.
2318 For that purpose, this must be 0
2319 when not inside wait_reading_process_input. */
2320 static int waiting_for_user_input_p;
2322 /* This is here so breakpoints can be put on it. */
2323 static void
2324 wait_reading_process_input_1 ()
2328 /* Read and dispose of subprocess output while waiting for timeout to
2329 elapse and/or keyboard input to be available.
2331 TIME_LIMIT is:
2332 timeout in seconds, or
2333 zero for no limit, or
2334 -1 means gobble data immediately available but don't wait for any.
2336 MICROSECS is:
2337 an additional duration to wait, measured in microseconds.
2338 If this is nonzero and time_limit is 0, then the timeout
2339 consists of MICROSECS only.
2341 READ_KBD is a lisp value:
2342 0 to ignore keyboard input, or
2343 1 to return when input is available, or
2344 -1 meaning caller will actually read the input, so don't throw to
2345 the quit handler, or
2346 a cons cell, meaning wait until its car is non-nil
2347 (and gobble terminal input into the buffer if any arrives), or
2348 a process object, meaning wait until something arrives from that
2349 process. The return value is true iff we read some input from
2350 that process.
2352 DO_DISPLAY != 0 means redisplay should be done to show subprocess
2353 output that arrives.
2355 If READ_KBD is a pointer to a struct Lisp_Process, then the
2356 function returns true iff we received input from that process
2357 before the timeout elapsed.
2358 Otherwise, return true iff we received input from any process. */
2361 wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
2362 int time_limit, microsecs;
2363 Lisp_Object read_kbd;
2364 int do_display;
2366 register int channel, nfds;
2367 static SELECT_TYPE Available;
2368 int xerrno;
2369 Lisp_Object proc;
2370 EMACS_TIME timeout, end_time;
2371 SELECT_TYPE Atemp;
2372 int wait_channel = -1;
2373 struct Lisp_Process *wait_proc = 0;
2374 int got_some_input = 0;
2375 /* Either nil or a cons cell, the car of which is of interest and
2376 may be changed outside of this routine. */
2377 Lisp_Object wait_for_cell = Qnil;
2379 FD_ZERO (&Available);
2381 /* If read_kbd is a process to watch, set wait_proc and wait_channel
2382 accordingly. */
2383 if (PROCESSP (read_kbd))
2385 wait_proc = XPROCESS (read_kbd);
2386 wait_channel = XINT (wait_proc->infd);
2387 XSETFASTINT (read_kbd, 0);
2390 /* If waiting for non-nil in a cell, record where. */
2391 if (CONSP (read_kbd))
2393 wait_for_cell = read_kbd;
2394 XSETFASTINT (read_kbd, 0);
2397 waiting_for_user_input_p = XINT (read_kbd);
2399 /* Since we may need to wait several times,
2400 compute the absolute time to return at. */
2401 if (time_limit || microsecs)
2403 EMACS_GET_TIME (end_time);
2404 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
2405 EMACS_ADD_TIME (end_time, end_time, timeout);
2407 #ifdef hpux
2408 /* AlainF 5-Jul-1996
2409 HP-UX 10.10 seem to have problems with signals coming in
2410 Causes "poll: interrupted system call" messages when Emacs is run
2411 in an X window
2412 Turn off periodic alarms (in case they are in use) */
2413 turn_on_atimers (0);
2414 #endif
2416 while (1)
2418 int timeout_reduced_for_timers = 0;
2420 /* If calling from keyboard input, do not quit
2421 since we want to return C-g as an input character.
2422 Otherwise, do pending quit if requested. */
2423 if (XINT (read_kbd) >= 0)
2424 QUIT;
2426 /* Exit now if the cell we're waiting for became non-nil. */
2427 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
2428 break;
2430 /* Compute time from now till when time limit is up */
2431 /* Exit if already run out */
2432 if (time_limit == -1)
2434 /* -1 specified for timeout means
2435 gobble output available now
2436 but don't wait at all. */
2438 EMACS_SET_SECS_USECS (timeout, 0, 0);
2440 else if (time_limit || microsecs)
2442 EMACS_GET_TIME (timeout);
2443 EMACS_SUB_TIME (timeout, end_time, timeout);
2444 if (EMACS_TIME_NEG_P (timeout))
2445 break;
2447 else
2449 EMACS_SET_SECS_USECS (timeout, 100000, 0);
2452 /* Normally we run timers here.
2453 But not if wait_for_cell; in those cases,
2454 the wait is supposed to be short,
2455 and those callers cannot handle running arbitrary Lisp code here. */
2456 if (NILP (wait_for_cell))
2458 EMACS_TIME timer_delay;
2462 int old_timers_run = timers_run;
2463 struct buffer *old_buffer = current_buffer;
2465 timer_delay = timer_check (1);
2467 /* If a timer has run, this might have changed buffers
2468 an alike. Make read_key_sequence aware of that. */
2469 if (timers_run != old_timers_run
2470 && old_buffer != current_buffer
2471 && waiting_for_user_input_p == -1)
2472 record_asynch_buffer_change ();
2474 if (timers_run != old_timers_run && do_display)
2475 /* We must retry, since a timer may have requeued itself
2476 and that could alter the time_delay. */
2477 redisplay_preserve_echo_area (9);
2478 else
2479 break;
2481 while (!detect_input_pending ());
2483 /* If there is unread keyboard input, also return. */
2484 if (XINT (read_kbd) != 0
2485 && requeued_events_pending_p ())
2486 break;
2488 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
2490 EMACS_TIME difference;
2491 EMACS_SUB_TIME (difference, timer_delay, timeout);
2492 if (EMACS_TIME_NEG_P (difference))
2494 timeout = timer_delay;
2495 timeout_reduced_for_timers = 1;
2498 /* If time_limit is -1, we are not going to wait at all. */
2499 else if (time_limit != -1)
2501 /* This is so a breakpoint can be put here. */
2502 wait_reading_process_input_1 ();
2506 /* Cause C-g and alarm signals to take immediate action,
2507 and cause input available signals to zero out timeout.
2509 It is important that we do this before checking for process
2510 activity. If we get a SIGCHLD after the explicit checks for
2511 process activity, timeout is the only way we will know. */
2512 if (XINT (read_kbd) < 0)
2513 set_waiting_for_input (&timeout);
2515 /* If status of something has changed, and no input is
2516 available, notify the user of the change right away. After
2517 this explicit check, we'll let the SIGCHLD handler zap
2518 timeout to get our attention. */
2519 if (update_tick != process_tick && do_display)
2521 Atemp = input_wait_mask;
2522 EMACS_SET_SECS_USECS (timeout, 0, 0);
2523 if ((select (max (max_process_desc, max_keyboard_desc) + 1,
2524 &Atemp, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
2525 &timeout)
2526 <= 0))
2528 /* It's okay for us to do this and then continue with
2529 the loop, since timeout has already been zeroed out. */
2530 clear_waiting_for_input ();
2531 status_notify ();
2535 /* Don't wait for output from a non-running process. */
2536 if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
2537 update_status (wait_proc);
2538 if (wait_proc != 0
2539 && ! EQ (wait_proc->status, Qrun))
2541 int nread, total_nread = 0;
2543 clear_waiting_for_input ();
2544 XSETPROCESS (proc, wait_proc);
2546 /* Read data from the process, until we exhaust it. */
2547 while (XINT (wait_proc->infd) >= 0)
2549 nread = read_process_output (proc, XINT (wait_proc->infd));
2551 if (nread == 0)
2552 break;
2554 if (0 < nread)
2555 total_nread += nread;
2556 #ifdef EIO
2557 else if (nread == -1 && EIO == errno)
2558 break;
2559 #endif
2560 #ifdef EAGAIN
2561 else if (nread == -1 && EAGAIN == errno)
2562 break;
2563 #endif
2564 #ifdef EWOULDBLOCK
2565 else if (nread == -1 && EWOULDBLOCK == errno)
2566 break;
2567 #endif
2569 if (total_nread > 0 && do_display)
2570 redisplay_preserve_echo_area (10);
2572 break;
2575 /* Wait till there is something to do */
2577 if (!NILP (wait_for_cell))
2578 Available = non_process_wait_mask;
2579 else if (! XINT (read_kbd))
2580 Available = non_keyboard_wait_mask;
2581 else
2582 Available = input_wait_mask;
2584 /* If frame size has changed or the window is newly mapped,
2585 redisplay now, before we start to wait. There is a race
2586 condition here; if a SIGIO arrives between now and the select
2587 and indicates that a frame is trashed, the select may block
2588 displaying a trashed screen. */
2589 if (frame_garbaged && do_display)
2591 clear_waiting_for_input ();
2592 redisplay_preserve_echo_area (11);
2593 if (XINT (read_kbd) < 0)
2594 set_waiting_for_input (&timeout);
2597 if (XINT (read_kbd) && detect_input_pending ())
2599 nfds = 0;
2600 FD_ZERO (&Available);
2602 else
2603 nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
2604 &Available, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
2605 &timeout);
2607 xerrno = errno;
2609 /* Make C-g and alarm signals set flags again */
2610 clear_waiting_for_input ();
2612 /* If we woke up due to SIGWINCH, actually change size now. */
2613 do_pending_window_change (0);
2615 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
2616 /* We wanted the full specified time, so return now. */
2617 break;
2618 if (nfds < 0)
2620 if (xerrno == EINTR)
2621 FD_ZERO (&Available);
2622 #ifdef ultrix
2623 /* Ultrix select seems to return ENOMEM when it is
2624 interrupted. Treat it just like EINTR. Bleah. Note
2625 that we want to test for the "ultrix" CPP symbol, not
2626 "__ultrix__"; the latter is only defined under GCC, but
2627 not by DEC's bundled CC. -JimB */
2628 else if (xerrno == ENOMEM)
2629 FD_ZERO (&Available);
2630 #endif
2631 #ifdef ALLIANT
2632 /* This happens for no known reason on ALLIANT.
2633 I am guessing that this is the right response. -- RMS. */
2634 else if (xerrno == EFAULT)
2635 FD_ZERO (&Available);
2636 #endif
2637 else if (xerrno == EBADF)
2639 #ifdef AIX
2640 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
2641 the child's closure of the pts gives the parent a SIGHUP, and
2642 the ptc file descriptor is automatically closed,
2643 yielding EBADF here or at select() call above.
2644 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
2645 in m/ibmrt-aix.h), and here we just ignore the select error.
2646 Cleanup occurs c/o status_notify after SIGCLD. */
2647 FD_ZERO (&Available); /* Cannot depend on values returned */
2648 #else
2649 abort ();
2650 #endif
2652 else
2653 error ("select error: %s", emacs_strerror (xerrno));
2655 #if defined(sun) && !defined(USG5_4)
2656 else if (nfds > 0 && keyboard_bit_set (&Available)
2657 && interrupt_input)
2658 /* System sometimes fails to deliver SIGIO.
2660 David J. Mackenzie says that Emacs doesn't compile under
2661 Solaris if this code is enabled, thus the USG5_4 in the CPP
2662 conditional. "I haven't noticed any ill effects so far.
2663 If you find a Solaris expert somewhere, they might know
2664 better." */
2665 kill (getpid (), SIGIO);
2666 #endif
2668 #if 0 /* When polling is used, interrupt_input is 0,
2669 so get_input_pending should read the input.
2670 So this should not be needed. */
2671 /* If we are using polling for input,
2672 and we see input available, make it get read now.
2673 Otherwise it might not actually get read for a second.
2674 And on hpux, since we turn off polling in wait_reading_process_input,
2675 it might never get read at all if we don't spend much time
2676 outside of wait_reading_process_input. */
2677 if (XINT (read_kbd) && interrupt_input
2678 && keyboard_bit_set (&Available)
2679 && input_polling_used ())
2680 kill (getpid (), SIGALRM);
2681 #endif
2683 /* Check for keyboard input */
2684 /* If there is any, return immediately
2685 to give it higher priority than subprocesses */
2687 if (XINT (read_kbd) != 0)
2689 int old_timers_run = timers_run;
2690 struct buffer *old_buffer = current_buffer;
2691 int leave = 0;
2693 if (detect_input_pending_run_timers (do_display))
2695 swallow_events (do_display);
2696 if (detect_input_pending_run_timers (do_display))
2697 leave = 1;
2700 /* If a timer has run, this might have changed buffers
2701 an alike. Make read_key_sequence aware of that. */
2702 if (timers_run != old_timers_run
2703 && waiting_for_user_input_p == -1
2704 && old_buffer != current_buffer)
2705 record_asynch_buffer_change ();
2707 if (leave)
2708 break;
2711 /* If there is unread keyboard input, also return. */
2712 if (XINT (read_kbd) != 0
2713 && requeued_events_pending_p ())
2714 break;
2716 /* If we are not checking for keyboard input now,
2717 do process events (but don't run any timers).
2718 This is so that X events will be processed.
2719 Otherwise they may have to wait until polling takes place.
2720 That would causes delays in pasting selections, for example.
2722 (We used to do this only if wait_for_cell.) */
2723 if (XINT (read_kbd) == 0 && detect_input_pending ())
2725 swallow_events (do_display);
2726 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
2727 if (detect_input_pending ())
2728 break;
2729 #endif
2732 /* Exit now if the cell we're waiting for became non-nil. */
2733 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
2734 break;
2736 #ifdef SIGIO
2737 /* If we think we have keyboard input waiting, but didn't get SIGIO,
2738 go read it. This can happen with X on BSD after logging out.
2739 In that case, there really is no input and no SIGIO,
2740 but select says there is input. */
2742 if (XINT (read_kbd) && interrupt_input
2743 && keyboard_bit_set (&Available))
2744 kill (getpid (), SIGIO);
2745 #endif
2747 if (! wait_proc)
2748 got_some_input |= nfds > 0;
2750 /* If checking input just got us a size-change event from X,
2751 obey it now if we should. */
2752 if (XINT (read_kbd) || ! NILP (wait_for_cell))
2753 do_pending_window_change (0);
2755 /* Check for data from a process. */
2756 /* Really FIRST_PROC_DESC should be 0 on Unix,
2757 but this is safer in the short run. */
2758 for (channel = 0; channel <= max_process_desc; channel++)
2760 if (FD_ISSET (channel, &Available)
2761 && FD_ISSET (channel, &non_keyboard_wait_mask))
2763 int nread;
2765 /* If waiting for this channel, arrange to return as
2766 soon as no more input to be processed. No more
2767 waiting. */
2768 if (wait_channel == channel)
2770 wait_channel = -1;
2771 time_limit = -1;
2772 got_some_input = 1;
2774 proc = chan_process[channel];
2775 if (NILP (proc))
2776 continue;
2778 /* Read data from the process, starting with our
2779 buffered-ahead character if we have one. */
2781 nread = read_process_output (proc, channel);
2782 if (nread > 0)
2784 /* Since read_process_output can run a filter,
2785 which can call accept-process-output,
2786 don't try to read from any other processes
2787 before doing the select again. */
2788 FD_ZERO (&Available);
2790 if (do_display)
2791 redisplay_preserve_echo_area (12);
2793 #ifdef EWOULDBLOCK
2794 else if (nread == -1 && errno == EWOULDBLOCK)
2796 #endif
2797 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
2798 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
2799 #ifdef O_NONBLOCK
2800 else if (nread == -1 && errno == EAGAIN)
2802 #else
2803 #ifdef O_NDELAY
2804 else if (nread == -1 && errno == EAGAIN)
2806 /* Note that we cannot distinguish between no input
2807 available now and a closed pipe.
2808 With luck, a closed pipe will be accompanied by
2809 subprocess termination and SIGCHLD. */
2810 else if (nread == 0 && !NETCONN_P (proc))
2812 #endif /* O_NDELAY */
2813 #endif /* O_NONBLOCK */
2814 #ifdef HAVE_PTYS
2815 /* On some OSs with ptys, when the process on one end of
2816 a pty exits, the other end gets an error reading with
2817 errno = EIO instead of getting an EOF (0 bytes read).
2818 Therefore, if we get an error reading and errno =
2819 EIO, just continue, because the child process has
2820 exited and should clean itself up soon (e.g. when we
2821 get a SIGCHLD).
2823 However, it has been known to happen that the SIGCHLD
2824 got lost. So raise the signl again just in case.
2825 It can't hurt. */
2826 else if (nread == -1 && errno == EIO)
2827 kill (getpid (), SIGCHLD);
2828 #endif /* HAVE_PTYS */
2829 /* If we can detect process termination, don't consider the process
2830 gone just because its pipe is closed. */
2831 #ifdef SIGCHLD
2832 else if (nread == 0 && !NETCONN_P (proc))
2834 #endif
2835 else
2837 /* Preserve status of processes already terminated. */
2838 XSETINT (XPROCESS (proc)->tick, ++process_tick);
2839 deactivate_process (proc);
2840 if (!NILP (XPROCESS (proc)->raw_status_low))
2841 update_status (XPROCESS (proc));
2842 if (EQ (XPROCESS (proc)->status, Qrun))
2843 XPROCESS (proc)->status
2844 = Fcons (Qexit, Fcons (make_number (256), Qnil));
2847 } /* end for each file descriptor */
2848 } /* end while exit conditions not met */
2850 waiting_for_user_input_p = 0;
2852 /* If calling from keyboard input, do not quit
2853 since we want to return C-g as an input character.
2854 Otherwise, do pending quit if requested. */
2855 if (XINT (read_kbd) >= 0)
2857 /* Prevent input_pending from remaining set if we quit. */
2858 clear_input_pending ();
2859 QUIT;
2861 #ifdef hpux
2862 /* AlainF 5-Jul-1996
2863 HP-UX 10.10 seems to have problems with signals coming in
2864 Causes "poll: interrupted system call" messages when Emacs is run
2865 in an X window
2866 Turn periodic alarms back on */
2867 start_polling ();
2868 #endif
2870 return got_some_input;
2873 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
2875 static Lisp_Object
2876 read_process_output_call (fun_and_args)
2877 Lisp_Object fun_and_args;
2879 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
2882 static Lisp_Object
2883 read_process_output_error_handler (error)
2884 Lisp_Object error;
2886 cmd_error_internal (error, "error in process filter: ");
2887 Vinhibit_quit = Qt;
2888 update_echo_area ();
2889 Fsleep_for (make_number (2), Qnil);
2890 return Qt;
2893 /* Read pending output from the process channel,
2894 starting with our buffered-ahead character if we have one.
2895 Yield number of decoded characters read.
2897 This function reads at most 1024 characters.
2898 If you want to read all available subprocess output,
2899 you must call it repeatedly until it returns zero.
2901 The characters read are decoded according to PROC's coding-system
2902 for decoding. */
2905 read_process_output (proc, channel)
2906 Lisp_Object proc;
2907 register int channel;
2909 register int nchars, nbytes;
2910 char *chars;
2911 register Lisp_Object outstream;
2912 register struct buffer *old = current_buffer;
2913 register struct Lisp_Process *p = XPROCESS (proc);
2914 register int opoint;
2915 struct coding_system *coding = proc_decode_coding_system[channel];
2916 int carryover = XINT (p->decoding_carryover);
2918 #ifdef VMS
2919 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
2921 vs = get_vms_process_pointer (p->pid);
2922 if (vs)
2924 if (!vs->iosb[0])
2925 return (0); /* Really weird if it does this */
2926 if (!(vs->iosb[0] & 1))
2927 return -1; /* I/O error */
2929 else
2930 error ("Could not get VMS process pointer");
2931 chars = vs->inputBuffer;
2932 nbytes = clean_vms_buffer (chars, vs->iosb[1]);
2933 if (nbytes <= 0)
2935 start_vms_process_read (vs); /* Crank up the next read on the process */
2936 return 1; /* Nothing worth printing, say we got 1 */
2938 if (carryover > 0)
2940 /* The data carried over in the previous decoding (which are at
2941 the tail of decoding buffer) should be prepended to the new
2942 data read to decode all together. */
2943 chars = (char *) alloca (nbytes + carryover);
2944 bcopy (XSTRING (p->decoding_buf)->data, buf, carryover);
2945 bcopy (vs->inputBuffer, chars + carryover, nbytes);
2947 #else /* not VMS */
2948 chars = (char *) alloca (carryover + 1024);
2949 if (carryover)
2950 /* See the comment above. */
2951 bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
2953 if (proc_buffered_char[channel] < 0)
2954 nbytes = emacs_read (channel, chars + carryover, 1024 - carryover);
2955 else
2957 chars[carryover] = proc_buffered_char[channel];
2958 proc_buffered_char[channel] = -1;
2959 nbytes = emacs_read (channel, chars + carryover + 1, 1023 - carryover);
2960 if (nbytes < 0)
2961 nbytes = 1;
2962 else
2963 nbytes = nbytes + 1;
2965 #endif /* not VMS */
2967 XSETINT (p->decoding_carryover, 0);
2969 /* At this point, NBYTES holds number of bytes just received
2970 (including the one in proc_buffered_char[channel]). */
2971 if (nbytes <= 0)
2973 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
2974 return nbytes;
2975 coding->mode |= CODING_MODE_LAST_BLOCK;
2978 /* Now set NBYTES how many bytes we must decode. */
2979 nbytes += carryover;
2981 /* Read and dispose of the process output. */
2982 outstream = p->filter;
2983 if (!NILP (outstream))
2985 /* We inhibit quit here instead of just catching it so that
2986 hitting ^G when a filter happens to be running won't screw
2987 it up. */
2988 int count = specpdl_ptr - specpdl;
2989 Lisp_Object odeactivate;
2990 Lisp_Object obuffer, okeymap;
2991 Lisp_Object text;
2992 int outer_running_asynch_code = running_asynch_code;
2993 int waiting = waiting_for_user_input_p;
2995 /* No need to gcpro these, because all we do with them later
2996 is test them for EQness, and none of them should be a string. */
2997 odeactivate = Vdeactivate_mark;
2998 XSETBUFFER (obuffer, current_buffer);
2999 okeymap = current_buffer->keymap;
3001 specbind (Qinhibit_quit, Qt);
3002 specbind (Qlast_nonmenu_event, Qt);
3004 /* In case we get recursively called,
3005 and we already saved the match data nonrecursively,
3006 save the same match data in safely recursive fashion. */
3007 if (outer_running_asynch_code)
3009 Lisp_Object tem;
3010 /* Don't clobber the CURRENT match data, either! */
3011 tem = Fmatch_data (Qnil, Qnil);
3012 restore_match_data ();
3013 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
3014 Fset_match_data (tem);
3017 /* For speed, if a search happens within this code,
3018 save the match data in a special nonrecursive fashion. */
3019 running_asynch_code = 1;
3021 decode_coding_c_string (coding, chars, nbytes, Qt);
3022 text = coding->dst_object;
3023 if (NILP (buffer_defaults.enable_multibyte_characters))
3024 /* We had better return unibyte string. */
3025 text = string_make_unibyte (text);
3027 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
3028 /* A new coding system might be found. */
3029 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
3031 p->decode_coding_system = Vlast_coding_system_used;
3033 /* Don't call setup_coding_system for
3034 proc_decode_coding_system[channel] here. It is done in
3035 detect_coding called via decode_coding above. */
3037 /* If a coding system for encoding is not yet decided, we set
3038 it as the same as coding-system for decoding.
3040 But, before doing that we must check if
3041 proc_encode_coding_system[p->outfd] surely points to a
3042 valid memory because p->outfd will be changed once EOF is
3043 sent to the process. */
3044 if (NILP (p->encode_coding_system)
3045 && proc_encode_coding_system[XINT (p->outfd)])
3047 p->encode_coding_system = Vlast_coding_system_used;
3048 setup_coding_system (p->encode_coding_system,
3049 proc_encode_coding_system[XINT (p->outfd)]);
3053 carryover = nbytes - coding->consumed;
3054 bcopy (chars + coding->consumed, XSTRING (p->decoding_buf)->data,
3055 carryover);
3056 XSETINT (p->decoding_carryover, carryover);
3057 nbytes = STRING_BYTES (XSTRING (text));
3058 nchars = XSTRING (text)->size;
3059 if (nbytes > 0)
3060 internal_condition_case_1 (read_process_output_call,
3061 Fcons (outstream,
3062 Fcons (proc, Fcons (text, Qnil))),
3063 !NILP (Vdebug_on_error) ? Qnil : Qerror,
3064 read_process_output_error_handler);
3066 /* If we saved the match data nonrecursively, restore it now. */
3067 restore_match_data ();
3068 running_asynch_code = outer_running_asynch_code;
3070 /* Handling the process output should not deactivate the mark. */
3071 Vdeactivate_mark = odeactivate;
3073 /* Restore waiting_for_user_input_p as it was
3074 when we were called, in case the filter clobbered it. */
3075 waiting_for_user_input_p = waiting;
3077 #if 0 /* Call record_asynch_buffer_change unconditionally,
3078 because we might have changed minor modes or other things
3079 that affect key bindings. */
3080 if (! EQ (Fcurrent_buffer (), obuffer)
3081 || ! EQ (current_buffer->keymap, okeymap))
3082 #endif
3083 /* But do it only if the caller is actually going to read events.
3084 Otherwise there's no need to make him wake up, and it could
3085 cause trouble (for example it would make Fsit_for return). */
3086 if (waiting_for_user_input_p == -1)
3087 record_asynch_buffer_change ();
3089 #ifdef VMS
3090 start_vms_process_read (vs);
3091 #endif
3092 unbind_to (count, Qnil);
3093 return nchars;
3096 /* If no filter, write into buffer if it isn't dead. */
3097 if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
3099 Lisp_Object old_read_only;
3100 int old_begv, old_zv;
3101 int old_begv_byte, old_zv_byte;
3102 Lisp_Object odeactivate;
3103 int before, before_byte;
3104 int opoint_byte;
3105 Lisp_Object text;
3106 struct buffer *b;
3108 odeactivate = Vdeactivate_mark;
3110 Fset_buffer (p->buffer);
3111 opoint = PT;
3112 opoint_byte = PT_BYTE;
3113 old_read_only = current_buffer->read_only;
3114 old_begv = BEGV;
3115 old_zv = ZV;
3116 old_begv_byte = BEGV_BYTE;
3117 old_zv_byte = ZV_BYTE;
3119 current_buffer->read_only = Qnil;
3121 /* Insert new output into buffer
3122 at the current end-of-output marker,
3123 thus preserving logical ordering of input and output. */
3124 if (XMARKER (p->mark)->buffer)
3125 SET_PT_BOTH (clip_to_bounds (BEGV, marker_position (p->mark), ZV),
3126 clip_to_bounds (BEGV_BYTE, marker_byte_position (p->mark),
3127 ZV_BYTE));
3128 else
3129 SET_PT_BOTH (ZV, ZV_BYTE);
3130 before = PT;
3131 before_byte = PT_BYTE;
3133 /* If the output marker is outside of the visible region, save
3134 the restriction and widen. */
3135 if (! (BEGV <= PT && PT <= ZV))
3136 Fwiden ();
3138 decode_coding_c_string (coding, chars, nbytes, Qt);
3139 text = coding->dst_object;
3140 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
3141 /* A new coding system might be found. See the comment in the
3142 similar code in the previous `if' block. */
3143 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
3145 p->decode_coding_system = Vlast_coding_system_used;
3146 if (NILP (p->encode_coding_system)
3147 && proc_encode_coding_system[XINT (p->outfd)])
3149 p->encode_coding_system = Vlast_coding_system_used;
3150 setup_coding_system (p->encode_coding_system,
3151 proc_encode_coding_system[XINT (p->outfd)]);
3154 carryover = nbytes - coding->consumed;
3155 bcopy (chars + coding->consumed, XSTRING (p->decoding_buf)->data,
3156 carryover);
3157 XSETINT (p->decoding_carryover, carryover);
3158 /* Adjust the multibyteness of TEXT to that of the buffer. */
3159 if (NILP (current_buffer->enable_multibyte_characters)
3160 != ! STRING_MULTIBYTE (text))
3161 text = (STRING_MULTIBYTE (text)
3162 ? Fstring_as_unibyte (text)
3163 : Fstring_as_multibyte (text));
3164 nbytes = STRING_BYTES (XSTRING (text));
3165 nchars = XSTRING (text)->size;
3166 /* Insert before markers in case we are inserting where
3167 the buffer's mark is, and the user's next command is Meta-y. */
3168 insert_from_string_before_markers (text, 0, 0, nchars, nbytes, 0);
3170 /* Make sure the process marker's position is valid when the
3171 process buffer is changed in the signal_after_change above.
3172 W3 is known to do that. */
3173 if (BUFFERP (p->buffer)
3174 && (b = XBUFFER (p->buffer), b != current_buffer))
3175 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
3176 else
3177 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
3179 update_mode_lines++;
3181 /* Make sure opoint and the old restrictions
3182 float ahead of any new text just as point would. */
3183 if (opoint >= before)
3185 opoint += PT - before;
3186 opoint_byte += PT_BYTE - before_byte;
3188 if (old_begv > before)
3190 old_begv += PT - before;
3191 old_begv_byte += PT_BYTE - before_byte;
3193 if (old_zv >= before)
3195 old_zv += PT - before;
3196 old_zv_byte += PT_BYTE - before_byte;
3199 /* If the restriction isn't what it should be, set it. */
3200 if (old_begv != BEGV || old_zv != ZV)
3201 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
3203 /* Handling the process output should not deactivate the mark. */
3204 Vdeactivate_mark = odeactivate;
3206 current_buffer->read_only = old_read_only;
3207 SET_PT_BOTH (opoint, opoint_byte);
3208 set_buffer_internal (old);
3210 #ifdef VMS
3211 start_vms_process_read (vs);
3212 #endif
3213 return nbytes;
3216 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
3217 0, 0, 0,
3218 doc: /* Returns non-nil if emacs is waiting for input from the user.
3219 This is intended for use by asynchronous process output filters and sentinels. */)
3222 return (waiting_for_user_input_p ? Qt : Qnil);
3225 /* Sending data to subprocess */
3227 jmp_buf send_process_frame;
3228 Lisp_Object process_sent_to;
3230 SIGTYPE
3231 send_process_trap ()
3233 #ifdef BSD4_1
3234 sigrelse (SIGPIPE);
3235 sigrelse (SIGALRM);
3236 #endif /* BSD4_1 */
3237 longjmp (send_process_frame, 1);
3240 /* Send some data to process PROC.
3241 BUF is the beginning of the data; LEN is the number of characters.
3242 OBJECT is the Lisp object that the data comes from. If OBJECT is
3243 nil or t, it means that the data comes from C string.
3245 If OBJECT is not nil, the data is encoded by PROC's coding-system
3246 for encoding before it is sent.
3248 This function can evaluate Lisp code and can garbage collect. */
3250 void
3251 send_process (proc, buf, len, object)
3252 volatile Lisp_Object proc;
3253 unsigned char *volatile buf;
3254 volatile int len;
3255 volatile Lisp_Object object;
3257 /* Use volatile to protect variables from being clobbered by longjmp. */
3258 int rv;
3259 struct coding_system *coding;
3260 struct gcpro gcpro1;
3262 GCPRO1 (object);
3264 #ifdef VMS
3265 struct Lisp_Process *p = XPROCESS (proc);
3266 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
3267 #endif /* VMS */
3269 if (! NILP (XPROCESS (proc)->raw_status_low))
3270 update_status (XPROCESS (proc));
3271 if (! EQ (XPROCESS (proc)->status, Qrun))
3272 error ("Process %s not running",
3273 XSTRING (XPROCESS (proc)->name)->data);
3274 if (XINT (XPROCESS (proc)->outfd) < 0)
3275 error ("Output file descriptor of %s is closed",
3276 XSTRING (XPROCESS (proc)->name)->data);
3278 coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
3279 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
3281 if ((STRINGP (object) && STRING_MULTIBYTE (object))
3282 || (BUFFERP (object)
3283 && !NILP (XBUFFER (object)->enable_multibyte_characters))
3284 || EQ (object, Qt))
3286 if (!EQ (Vlast_coding_system_used,
3287 XPROCESS (proc)->encode_coding_system))
3288 /* The coding system for encoding was changed to raw-text
3289 because we sent a unibyte text previously. Now we are
3290 sending a multibyte text, thus we must encode it by the
3291 original coding system specified for the current
3292 process. */
3293 setup_coding_system (XPROCESS (proc)->encode_coding_system, coding);
3295 else
3297 /* For sending a unibyte text, character code conversion should
3298 not take place but EOL conversion should. So, setup raw-text
3299 or one of the subsidiary if we have not yet done it. */
3300 if (CODING_REQUIRE_ENCODING (coding))
3302 if (CODING_REQUIRE_FLUSHING (coding))
3304 /* But, before changing the coding, we must flush out data. */
3305 coding->mode |= CODING_MODE_LAST_BLOCK;
3306 send_process (proc, "", 0, Qt);
3307 coding->mode &= ~CODING_MODE_LAST_BLOCK;
3309 coding->src_multibyte = 0;
3310 setup_coding_system (raw_text_coding_system
3311 (Vlast_coding_system_used),
3312 coding);
3315 coding->dst_multibyte = 0;
3317 if (CODING_REQUIRE_ENCODING (coding))
3319 coding->dst_object = Qt;
3320 if (BUFFERP (object))
3322 int from_byte, from, to;
3323 int save_pt, save_pt_byte;
3324 struct buffer *cur = current_buffer;
3326 set_buffer_internal (XBUFFER (object));
3327 save_pt = PT, save_pt_byte = PT_BYTE;
3329 from_byte = PTR_BYTE_POS (buf);
3330 from = BYTE_TO_CHAR (from_byte);
3331 to = BYTE_TO_CHAR (from_byte + len);
3332 TEMP_SET_PT_BOTH (from, from_byte);
3333 encode_coding_object (coding, object, from, from_byte,
3334 to, from_byte + len, Qt);
3335 TEMP_SET_PT_BOTH (save_pt, save_pt_byte);
3336 set_buffer_internal (cur);
3338 else if (STRINGP (object))
3340 encode_coding_string (coding, object, 1);
3342 else
3344 coding->dst_object = make_unibyte_string (buf, len);
3345 coding->produced = len;
3348 len = coding->produced;
3349 buf = XSTRING (coding->dst_object)->data;
3352 #ifdef VMS
3353 vs = get_vms_process_pointer (p->pid);
3354 if (vs == 0)
3355 error ("Could not find this process: %x", p->pid);
3356 else if (write_to_vms_process (vs, buf, len))
3358 #else /* not VMS */
3360 if (pty_max_bytes == 0)
3362 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
3363 pty_max_bytes = fpathconf (XFASTINT (XPROCESS (proc)->outfd),
3364 _PC_MAX_CANON);
3365 if (pty_max_bytes < 0)
3366 pty_max_bytes = 250;
3367 #else
3368 pty_max_bytes = 250;
3369 #endif
3370 /* Deduct one, to leave space for the eof. */
3371 pty_max_bytes--;
3374 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
3375 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
3376 when returning with longjmp despite being declared volatile. */
3377 if (!setjmp (send_process_frame))
3379 process_sent_to = proc;
3380 while (len > 0)
3382 int this = len;
3383 SIGTYPE (*old_sigpipe)();
3385 /* Decide how much data we can send in one batch.
3386 Long lines need to be split into multiple batches. */
3387 if (!NILP (XPROCESS (proc)->pty_flag))
3389 /* Starting this at zero is always correct when not the first
3390 iteration because the previous iteration ended by sending C-d.
3391 It may not be correct for the first iteration
3392 if a partial line was sent in a separate send_process call.
3393 If that proves worth handling, we need to save linepos
3394 in the process object. */
3395 int linepos = 0;
3396 unsigned char *ptr = (unsigned char *) buf;
3397 unsigned char *end = (unsigned char *) buf + len;
3399 /* Scan through this text for a line that is too long. */
3400 while (ptr != end && linepos < pty_max_bytes)
3402 if (*ptr == '\n')
3403 linepos = 0;
3404 else
3405 linepos++;
3406 ptr++;
3408 /* If we found one, break the line there
3409 and put in a C-d to force the buffer through. */
3410 this = ptr - buf;
3413 /* Send this batch, using one or more write calls. */
3414 while (this > 0)
3416 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
3417 rv = emacs_write (XINT (XPROCESS (proc)->outfd),
3418 (char *) buf, this);
3419 signal (SIGPIPE, old_sigpipe);
3421 if (rv < 0)
3423 if (0
3424 #ifdef EWOULDBLOCK
3425 || errno == EWOULDBLOCK
3426 #endif
3427 #ifdef EAGAIN
3428 || errno == EAGAIN
3429 #endif
3431 /* Buffer is full. Wait, accepting input;
3432 that may allow the program
3433 to finish doing output and read more. */
3435 Lisp_Object zero;
3436 int offset = 0;
3438 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
3439 /* A gross hack to work around a bug in FreeBSD.
3440 In the following sequence, read(2) returns
3441 bogus data:
3443 write(2) 1022 bytes
3444 write(2) 954 bytes, get EAGAIN
3445 read(2) 1024 bytes in process_read_output
3446 read(2) 11 bytes in process_read_output
3448 That is, read(2) returns more bytes than have
3449 ever been written successfully. The 1033 bytes
3450 read are the 1022 bytes written successfully
3451 after processing (for example with CRs added if
3452 the terminal is set up that way which it is
3453 here). The same bytes will be seen again in a
3454 later read(2), without the CRs. */
3456 if (errno == EAGAIN)
3458 int flags = FWRITE;
3459 ioctl (XINT (XPROCESS (proc)->outfd), TIOCFLUSH,
3460 &flags);
3462 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
3464 /* Running filters might relocate buffers or strings.
3465 Arrange to relocate BUF. */
3466 if (BUFFERP (object))
3467 offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
3468 else if (STRINGP (object))
3469 offset = buf - XSTRING (object)->data;
3471 XSETFASTINT (zero, 0);
3472 #ifdef EMACS_HAS_USECS
3473 wait_reading_process_input (0, 20000, zero, 0);
3474 #else
3475 wait_reading_process_input (1, 0, zero, 0);
3476 #endif
3478 if (BUFFERP (object))
3479 buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
3480 else if (STRINGP (object))
3481 buf = offset + XSTRING (object)->data;
3483 rv = 0;
3485 else
3486 /* This is a real error. */
3487 report_file_error ("writing to process", Fcons (proc, Qnil));
3489 buf += rv;
3490 len -= rv;
3491 this -= rv;
3494 /* If we sent just part of the string, put in an EOF
3495 to force it through, before we send the rest. */
3496 if (len > 0)
3497 Fprocess_send_eof (proc);
3500 #endif /* not VMS */
3501 else
3503 #ifndef VMS
3504 proc = process_sent_to;
3505 #endif
3506 XPROCESS (proc)->raw_status_low = Qnil;
3507 XPROCESS (proc)->raw_status_high = Qnil;
3508 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
3509 XSETINT (XPROCESS (proc)->tick, ++process_tick);
3510 deactivate_process (proc);
3511 #ifdef VMS
3512 error ("Error writing to process %s; closed it",
3513 XSTRING (XPROCESS (proc)->name)->data);
3514 #else
3515 error ("SIGPIPE raised on process %s; closed it",
3516 XSTRING (XPROCESS (proc)->name)->data);
3517 #endif
3520 UNGCPRO;
3523 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
3524 3, 3, 0,
3525 doc: /* Send current contents of region as input to PROCESS.
3526 PROCESS may be a process, a buffer, the name of a process or buffer, or
3527 nil, indicating the current buffer's process.
3528 Called from program, takes three arguments, PROCESS, START and END.
3529 If the region is more than 500 characters long,
3530 it is sent in several bunches. This may happen even for shorter regions.
3531 Output from processes can arrive in between bunches. */)
3532 (process, start, end)
3533 Lisp_Object process, start, end;
3535 Lisp_Object proc;
3536 int start1, end1;
3538 proc = get_process (process);
3539 validate_region (&start, &end);
3541 if (XINT (start) < GPT && XINT (end) > GPT)
3542 move_gap (XINT (start));
3544 start1 = CHAR_TO_BYTE (XINT (start));
3545 end1 = CHAR_TO_BYTE (XINT (end));
3546 send_process (proc, BYTE_POS_ADDR (start1), end1 - start1,
3547 Fcurrent_buffer ());
3549 return Qnil;
3552 DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
3553 2, 2, 0,
3554 doc: /* Send PROCESS the contents of STRING as input.
3555 PROCESS may be a process, a buffer, the name of a process or buffer, or
3556 nil, indicating the current buffer's process.
3557 If STRING is more than 500 characters long,
3558 it is sent in several bunches. This may happen even for shorter strings.
3559 Output from processes can arrive in between bunches. */)
3560 (process, string)
3561 Lisp_Object process, string;
3563 Lisp_Object proc;
3564 CHECK_STRING (string);
3565 proc = get_process (process);
3566 send_process (proc, XSTRING (string)->data,
3567 STRING_BYTES (XSTRING (string)), string);
3568 return Qnil;
3571 DEFUN ("process-running-child-p", Fprocess_running_child_p,
3572 Sprocess_running_child_p, 0, 1, 0,
3573 doc: /* Return t if PROCESS has given the terminal to a child.
3574 If the operating system does not make it possible to find out,
3575 return t unconditionally. */)
3576 (process)
3577 Lisp_Object process;
3579 /* Initialize in case ioctl doesn't exist or gives an error,
3580 in a way that will cause returning t. */
3581 int gid = 0;
3582 Lisp_Object proc;
3583 struct Lisp_Process *p;
3585 proc = get_process (process);
3586 p = XPROCESS (proc);
3588 if (!EQ (p->childp, Qt))
3589 error ("Process %s is not a subprocess",
3590 XSTRING (p->name)->data);
3591 if (XINT (p->infd) < 0)
3592 error ("Process %s is not active",
3593 XSTRING (p->name)->data);
3595 #ifdef TIOCGPGRP
3596 if (!NILP (p->subtty))
3597 ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
3598 else
3599 ioctl (XINT (p->infd), TIOCGPGRP, &gid);
3600 #endif /* defined (TIOCGPGRP ) */
3602 if (gid == XFASTINT (p->pid))
3603 return Qnil;
3604 return Qt;
3607 /* send a signal number SIGNO to PROCESS.
3608 If CURRENT_GROUP is t, that means send to the process group
3609 that currently owns the terminal being used to communicate with PROCESS.
3610 This is used for various commands in shell mode.
3611 If CURRENT_GROUP is lambda, that means send to the process group
3612 that currently owns the terminal, but only if it is NOT the shell itself.
3614 If NOMSG is zero, insert signal-announcements into process's buffers
3615 right away.
3617 If we can, we try to signal PROCESS by sending control characters
3618 down the pty. This allows us to signal inferiors who have changed
3619 their uid, for which killpg would return an EPERM error. */
3621 static void
3622 process_send_signal (process, signo, current_group, nomsg)
3623 Lisp_Object process;
3624 int signo;
3625 Lisp_Object current_group;
3626 int nomsg;
3628 Lisp_Object proc;
3629 register struct Lisp_Process *p;
3630 int gid;
3631 int no_pgrp = 0;
3633 proc = get_process (process);
3634 p = XPROCESS (proc);
3636 if (!EQ (p->childp, Qt))
3637 error ("Process %s is not a subprocess",
3638 XSTRING (p->name)->data);
3639 if (XINT (p->infd) < 0)
3640 error ("Process %s is not active",
3641 XSTRING (p->name)->data);
3643 if (NILP (p->pty_flag))
3644 current_group = Qnil;
3646 /* If we are using pgrps, get a pgrp number and make it negative. */
3647 if (!NILP (current_group))
3649 #ifdef SIGNALS_VIA_CHARACTERS
3650 /* If possible, send signals to the entire pgrp
3651 by sending an input character to it. */
3653 /* TERMIOS is the latest and bestest, and seems most likely to
3654 work. If the system has it, use it. */
3655 #ifdef HAVE_TERMIOS
3656 struct termios t;
3658 switch (signo)
3660 case SIGINT:
3661 tcgetattr (XINT (p->infd), &t);
3662 send_process (proc, &t.c_cc[VINTR], 1, Qnil);
3663 return;
3665 case SIGQUIT:
3666 tcgetattr (XINT (p->infd), &t);
3667 send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
3668 return;
3670 case SIGTSTP:
3671 tcgetattr (XINT (p->infd), &t);
3672 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
3673 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
3674 #else
3675 send_process (proc, &t.c_cc[VSUSP], 1, Qnil);
3676 #endif
3677 return;
3680 #else /* ! HAVE_TERMIOS */
3682 /* On Berkeley descendants, the following IOCTL's retrieve the
3683 current control characters. */
3684 #if defined (TIOCGLTC) && defined (TIOCGETC)
3686 struct tchars c;
3687 struct ltchars lc;
3689 switch (signo)
3691 case SIGINT:
3692 ioctl (XINT (p->infd), TIOCGETC, &c);
3693 send_process (proc, &c.t_intrc, 1, Qnil);
3694 return;
3695 case SIGQUIT:
3696 ioctl (XINT (p->infd), TIOCGETC, &c);
3697 send_process (proc, &c.t_quitc, 1, Qnil);
3698 return;
3699 #ifdef SIGTSTP
3700 case SIGTSTP:
3701 ioctl (XINT (p->infd), TIOCGLTC, &lc);
3702 send_process (proc, &lc.t_suspc, 1, Qnil);
3703 return;
3704 #endif /* ! defined (SIGTSTP) */
3707 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
3709 /* On SYSV descendants, the TCGETA ioctl retrieves the current control
3710 characters. */
3711 #ifdef TCGETA
3712 struct termio t;
3713 switch (signo)
3715 case SIGINT:
3716 ioctl (XINT (p->infd), TCGETA, &t);
3717 send_process (proc, &t.c_cc[VINTR], 1, Qnil);
3718 return;
3719 case SIGQUIT:
3720 ioctl (XINT (p->infd), TCGETA, &t);
3721 send_process (proc, &t.c_cc[VQUIT], 1, Qnil);
3722 return;
3723 #ifdef SIGTSTP
3724 case SIGTSTP:
3725 ioctl (XINT (p->infd), TCGETA, &t);
3726 send_process (proc, &t.c_cc[VSWTCH], 1, Qnil);
3727 return;
3728 #endif /* ! defined (SIGTSTP) */
3730 #else /* ! defined (TCGETA) */
3731 Your configuration files are messed up.
3732 /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
3733 you'd better be using one of the alternatives above! */
3734 #endif /* ! defined (TCGETA) */
3735 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
3736 #endif /* ! defined HAVE_TERMIOS */
3737 #endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
3739 #ifdef TIOCGPGRP
3740 /* Get the pgrp using the tty itself, if we have that.
3741 Otherwise, use the pty to get the pgrp.
3742 On pfa systems, saka@pfu.fujitsu.co.JP writes:
3743 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
3744 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
3745 His patch indicates that if TIOCGPGRP returns an error, then
3746 we should just assume that p->pid is also the process group id. */
3748 int err;
3750 if (!NILP (p->subtty))
3751 err = ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
3752 else
3753 err = ioctl (XINT (p->infd), TIOCGPGRP, &gid);
3755 #ifdef pfa
3756 if (err == -1)
3757 gid = - XFASTINT (p->pid);
3758 #endif /* ! defined (pfa) */
3760 if (gid == -1)
3761 no_pgrp = 1;
3762 else
3763 gid = - gid;
3764 #else /* ! defined (TIOCGPGRP ) */
3765 /* Can't select pgrps on this system, so we know that
3766 the child itself heads the pgrp. */
3767 gid = - XFASTINT (p->pid);
3768 #endif /* ! defined (TIOCGPGRP ) */
3770 /* If current_group is lambda, and the shell owns the terminal,
3771 don't send any signal. */
3772 if (EQ (current_group, Qlambda) && gid == - XFASTINT (p->pid))
3773 return;
3775 else
3776 gid = - XFASTINT (p->pid);
3778 switch (signo)
3780 #ifdef SIGCONT
3781 case SIGCONT:
3782 p->raw_status_low = Qnil;
3783 p->raw_status_high = Qnil;
3784 p->status = Qrun;
3785 XSETINT (p->tick, ++process_tick);
3786 if (!nomsg)
3787 status_notify ();
3788 break;
3789 #endif /* ! defined (SIGCONT) */
3790 case SIGINT:
3791 #ifdef VMS
3792 send_process (proc, "\003", 1, Qnil); /* ^C */
3793 goto whoosh;
3794 #endif
3795 case SIGQUIT:
3796 #ifdef VMS
3797 send_process (proc, "\031", 1, Qnil); /* ^Y */
3798 goto whoosh;
3799 #endif
3800 case SIGKILL:
3801 #ifdef VMS
3802 sys$forcex (&(XFASTINT (p->pid)), 0, 1);
3803 whoosh:
3804 #endif
3805 flush_pending_output (XINT (p->infd));
3806 break;
3809 /* If we don't have process groups, send the signal to the immediate
3810 subprocess. That isn't really right, but it's better than any
3811 obvious alternative. */
3812 if (no_pgrp)
3814 kill (XFASTINT (p->pid), signo);
3815 return;
3818 /* gid may be a pid, or minus a pgrp's number */
3819 #ifdef TIOCSIGSEND
3820 if (!NILP (current_group))
3821 ioctl (XINT (p->infd), TIOCSIGSEND, signo);
3822 else
3824 gid = - XFASTINT (p->pid);
3825 kill (gid, signo);
3827 #else /* ! defined (TIOCSIGSEND) */
3828 EMACS_KILLPG (-gid, signo);
3829 #endif /* ! defined (TIOCSIGSEND) */
3832 DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
3833 doc: /* Interrupt process PROCESS.
3834 PROCESS may be a process, a buffer, or the name of a process or buffer.
3835 nil or no arg means current buffer's process.
3836 Second arg CURRENT-GROUP non-nil means send signal to
3837 the current process-group of the process's controlling terminal
3838 rather than to the process's own process group.
3839 If the process is a shell, this means interrupt current subjob
3840 rather than the shell.
3842 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
3843 don't send the signal. */)
3844 (process, current_group)
3845 Lisp_Object process, current_group;
3847 process_send_signal (process, SIGINT, current_group, 0);
3848 return process;
3851 DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
3852 doc: /* Kill process PROCESS. May be process or name of one.
3853 See function `interrupt-process' for more details on usage. */)
3854 (process, current_group)
3855 Lisp_Object process, current_group;
3857 process_send_signal (process, SIGKILL, current_group, 0);
3858 return process;
3861 DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
3862 doc: /* Send QUIT signal to process PROCESS. May be process or name of one.
3863 See function `interrupt-process' for more details on usage. */)
3864 (process, current_group)
3865 Lisp_Object process, current_group;
3867 process_send_signal (process, SIGQUIT, current_group, 0);
3868 return process;
3871 DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
3872 doc: /* Stop process PROCESS. May be process or name of one.
3873 See function `interrupt-process' for more details on usage. */)
3874 (process, current_group)
3875 Lisp_Object process, current_group;
3877 #ifndef SIGTSTP
3878 error ("no SIGTSTP support");
3879 #else
3880 process_send_signal (process, SIGTSTP, current_group, 0);
3881 #endif
3882 return process;
3885 DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
3886 doc: /* Continue process PROCESS. May be process or name of one.
3887 See function `interrupt-process' for more details on usage. */)
3888 (process, current_group)
3889 Lisp_Object process, current_group;
3891 #ifdef SIGCONT
3892 process_send_signal (process, SIGCONT, current_group, 0);
3893 #else
3894 error ("no SIGCONT support");
3895 #endif
3896 return process;
3899 DEFUN ("signal-process", Fsignal_process, Ssignal_process,
3900 2, 2, "nProcess number: \nnSignal code: ",
3901 doc: /* Send the process with process id PID the signal with code SIGCODE.
3902 PID must be an integer. The process need not be a child of this Emacs.
3903 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
3904 (pid, sigcode)
3905 Lisp_Object pid, sigcode;
3907 CHECK_NUMBER (pid);
3909 #define handle_signal(NAME, VALUE) \
3910 else if (!strcmp (name, NAME)) \
3911 XSETINT (sigcode, VALUE)
3913 if (INTEGERP (sigcode))
3915 else
3917 unsigned char *name;
3919 CHECK_SYMBOL (sigcode);
3920 name = XSYMBOL (sigcode)->name->data;
3922 if (0)
3924 #ifdef SIGHUP
3925 handle_signal ("SIGHUP", SIGHUP);
3926 #endif
3927 #ifdef SIGINT
3928 handle_signal ("SIGINT", SIGINT);
3929 #endif
3930 #ifdef SIGQUIT
3931 handle_signal ("SIGQUIT", SIGQUIT);
3932 #endif
3933 #ifdef SIGILL
3934 handle_signal ("SIGILL", SIGILL);
3935 #endif
3936 #ifdef SIGABRT
3937 handle_signal ("SIGABRT", SIGABRT);
3938 #endif
3939 #ifdef SIGEMT
3940 handle_signal ("SIGEMT", SIGEMT);
3941 #endif
3942 #ifdef SIGKILL
3943 handle_signal ("SIGKILL", SIGKILL);
3944 #endif
3945 #ifdef SIGFPE
3946 handle_signal ("SIGFPE", SIGFPE);
3947 #endif
3948 #ifdef SIGBUS
3949 handle_signal ("SIGBUS", SIGBUS);
3950 #endif
3951 #ifdef SIGSEGV
3952 handle_signal ("SIGSEGV", SIGSEGV);
3953 #endif
3954 #ifdef SIGSYS
3955 handle_signal ("SIGSYS", SIGSYS);
3956 #endif
3957 #ifdef SIGPIPE
3958 handle_signal ("SIGPIPE", SIGPIPE);
3959 #endif
3960 #ifdef SIGALRM
3961 handle_signal ("SIGALRM", SIGALRM);
3962 #endif
3963 #ifdef SIGTERM
3964 handle_signal ("SIGTERM", SIGTERM);
3965 #endif
3966 #ifdef SIGURG
3967 handle_signal ("SIGURG", SIGURG);
3968 #endif
3969 #ifdef SIGSTOP
3970 handle_signal ("SIGSTOP", SIGSTOP);
3971 #endif
3972 #ifdef SIGTSTP
3973 handle_signal ("SIGTSTP", SIGTSTP);
3974 #endif
3975 #ifdef SIGCONT
3976 handle_signal ("SIGCONT", SIGCONT);
3977 #endif
3978 #ifdef SIGCHLD
3979 handle_signal ("SIGCHLD", SIGCHLD);
3980 #endif
3981 #ifdef SIGTTIN
3982 handle_signal ("SIGTTIN", SIGTTIN);
3983 #endif
3984 #ifdef SIGTTOU
3985 handle_signal ("SIGTTOU", SIGTTOU);
3986 #endif
3987 #ifdef SIGIO
3988 handle_signal ("SIGIO", SIGIO);
3989 #endif
3990 #ifdef SIGXCPU
3991 handle_signal ("SIGXCPU", SIGXCPU);
3992 #endif
3993 #ifdef SIGXFSZ
3994 handle_signal ("SIGXFSZ", SIGXFSZ);
3995 #endif
3996 #ifdef SIGVTALRM
3997 handle_signal ("SIGVTALRM", SIGVTALRM);
3998 #endif
3999 #ifdef SIGPROF
4000 handle_signal ("SIGPROF", SIGPROF);
4001 #endif
4002 #ifdef SIGWINCH
4003 handle_signal ("SIGWINCH", SIGWINCH);
4004 #endif
4005 #ifdef SIGINFO
4006 handle_signal ("SIGINFO", SIGINFO);
4007 #endif
4008 #ifdef SIGUSR1
4009 handle_signal ("SIGUSR1", SIGUSR1);
4010 #endif
4011 #ifdef SIGUSR2
4012 handle_signal ("SIGUSR2", SIGUSR2);
4013 #endif
4014 else
4015 error ("Undefined signal name %s", name);
4018 #undef handle_signal
4020 return make_number (kill (XINT (pid), XINT (sigcode)));
4023 DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
4024 doc: /* Make PROCESS see end-of-file in its input.
4025 EOF comes after any text already sent to it.
4026 PROCESS may be a process, a buffer, the name of a process or buffer, or
4027 nil, indicating the current buffer's process.
4028 If PROCESS is a network connection, or is a process communicating
4029 through a pipe (as opposed to a pty), then you cannot send any more
4030 text to PROCESS after you call this function. */)
4031 (process)
4032 Lisp_Object process;
4034 Lisp_Object proc;
4035 struct coding_system *coding;
4037 proc = get_process (process);
4038 coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
4040 /* Make sure the process is really alive. */
4041 if (! NILP (XPROCESS (proc)->raw_status_low))
4042 update_status (XPROCESS (proc));
4043 if (! EQ (XPROCESS (proc)->status, Qrun))
4044 error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
4046 if (CODING_REQUIRE_FLUSHING (coding))
4048 coding->mode |= CODING_MODE_LAST_BLOCK;
4049 send_process (proc, "", 0, Qnil);
4052 #ifdef VMS
4053 send_process (proc, "\032", 1, Qnil); /* ^z */
4054 #else
4055 if (!NILP (XPROCESS (proc)->pty_flag))
4056 send_process (proc, "\004", 1, Qnil);
4057 else
4059 int old_outfd, new_outfd;
4061 #ifdef HAVE_SHUTDOWN
4062 /* If this is a network connection, or socketpair is used
4063 for communication with the subprocess, call shutdown to cause EOF.
4064 (In some old system, shutdown to socketpair doesn't work.
4065 Then we just can't win.) */
4066 if (NILP (XPROCESS (proc)->pid)
4067 || XINT (XPROCESS (proc)->outfd) == XINT (XPROCESS (proc)->infd))
4068 shutdown (XINT (XPROCESS (proc)->outfd), 1);
4069 /* In case of socketpair, outfd == infd, so don't close it. */
4070 if (XINT (XPROCESS (proc)->outfd) != XINT (XPROCESS (proc)->infd))
4071 emacs_close (XINT (XPROCESS (proc)->outfd));
4072 #else /* not HAVE_SHUTDOWN */
4073 emacs_close (XINT (XPROCESS (proc)->outfd));
4074 #endif /* not HAVE_SHUTDOWN */
4075 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
4076 old_outfd = XINT (XPROCESS (proc)->outfd);
4078 if (!proc_encode_coding_system[new_outfd])
4079 proc_encode_coding_system[new_outfd]
4080 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
4081 bcopy (proc_encode_coding_system[old_outfd],
4082 proc_encode_coding_system[new_outfd],
4083 sizeof (struct coding_system));
4084 bzero (proc_encode_coding_system[old_outfd],
4085 sizeof (struct coding_system));
4087 XSETINT (XPROCESS (proc)->outfd, new_outfd);
4089 #endif /* VMS */
4090 return process;
4093 /* Kill all processes associated with `buffer'.
4094 If `buffer' is nil, kill all processes */
4096 void
4097 kill_buffer_processes (buffer)
4098 Lisp_Object buffer;
4100 Lisp_Object tail, proc;
4102 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
4104 proc = XCDR (XCAR (tail));
4105 if (GC_PROCESSP (proc)
4106 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
4108 if (NETCONN_P (proc))
4109 Fdelete_process (proc);
4110 else if (XINT (XPROCESS (proc)->infd) >= 0)
4111 process_send_signal (proc, SIGHUP, Qnil, 1);
4116 /* On receipt of a signal that a child status has changed, loop asking
4117 about children with changed statuses until the system says there
4118 are no more.
4120 All we do is change the status; we do not run sentinels or print
4121 notifications. That is saved for the next time keyboard input is
4122 done, in order to avoid timing errors.
4124 ** WARNING: this can be called during garbage collection.
4125 Therefore, it must not be fooled by the presence of mark bits in
4126 Lisp objects.
4128 ** USG WARNING: Although it is not obvious from the documentation
4129 in signal(2), on a USG system the SIGCLD handler MUST NOT call
4130 signal() before executing at least one wait(), otherwise the
4131 handler will be called again, resulting in an infinite loop. The
4132 relevant portion of the documentation reads "SIGCLD signals will be
4133 queued and the signal-catching function will be continually
4134 reentered until the queue is empty". Invoking signal() causes the
4135 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
4136 Inc. */
4138 SIGTYPE
4139 sigchld_handler (signo)
4140 int signo;
4142 int old_errno = errno;
4143 Lisp_Object proc;
4144 register struct Lisp_Process *p;
4145 extern EMACS_TIME *input_available_clear_time;
4147 #ifdef BSD4_1
4148 extern int sigheld;
4149 sigheld |= sigbit (SIGCHLD);
4150 #endif
4152 while (1)
4154 register int pid;
4155 WAITTYPE w;
4156 Lisp_Object tail;
4158 #ifdef WNOHANG
4159 #ifndef WUNTRACED
4160 #define WUNTRACED 0
4161 #endif /* no WUNTRACED */
4162 /* Keep trying to get a status until we get a definitive result. */
4165 errno = 0;
4166 pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
4168 while (pid < 0 && errno == EINTR);
4170 if (pid <= 0)
4172 /* PID == 0 means no processes found, PID == -1 means a real
4173 failure. We have done all our job, so return. */
4175 /* USG systems forget handlers when they are used;
4176 must reestablish each time */
4177 #if defined (USG) && !defined (POSIX_SIGNALS)
4178 signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
4179 #endif
4180 #ifdef BSD4_1
4181 sigheld &= ~sigbit (SIGCHLD);
4182 sigrelse (SIGCHLD);
4183 #endif
4184 errno = old_errno;
4185 return;
4187 #else
4188 pid = wait (&w);
4189 #endif /* no WNOHANG */
4191 /* Find the process that signaled us, and record its status. */
4193 p = 0;
4194 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
4196 proc = XCDR (XCAR (tail));
4197 p = XPROCESS (proc);
4198 if (GC_EQ (p->childp, Qt) && XINT (p->pid) == pid)
4199 break;
4200 p = 0;
4203 /* Look for an asynchronous process whose pid hasn't been filled
4204 in yet. */
4205 if (p == 0)
4206 for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
4208 proc = XCDR (XCAR (tail));
4209 p = XPROCESS (proc);
4210 if (GC_INTEGERP (p->pid) && XINT (p->pid) == -1)
4211 break;
4212 p = 0;
4215 /* Change the status of the process that was found. */
4216 if (p != 0)
4218 union { int i; WAITTYPE wt; } u;
4219 int clear_desc_flag = 0;
4221 XSETINT (p->tick, ++process_tick);
4222 u.wt = w;
4223 XSETINT (p->raw_status_low, u.i & 0xffff);
4224 XSETINT (p->raw_status_high, u.i >> 16);
4226 /* If process has terminated, stop waiting for its output. */
4227 if ((WIFSIGNALED (w) || WIFEXITED (w))
4228 && XINT (p->infd) >= 0)
4229 clear_desc_flag = 1;
4231 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
4232 if (clear_desc_flag)
4234 FD_CLR (XINT (p->infd), &input_wait_mask);
4235 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
4238 /* Tell wait_reading_process_input that it needs to wake up and
4239 look around. */
4240 if (input_available_clear_time)
4241 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
4244 /* There was no asynchronous process found for that id. Check
4245 if we have a synchronous process. */
4246 else
4248 synch_process_alive = 0;
4250 /* Report the status of the synchronous process. */
4251 if (WIFEXITED (w))
4252 synch_process_retcode = WRETCODE (w);
4253 else if (WIFSIGNALED (w))
4255 int code = WTERMSIG (w);
4256 char *signame;
4258 synchronize_system_messages_locale ();
4259 signame = strsignal (code);
4261 if (signame == 0)
4262 signame = "unknown";
4264 synch_process_death = signame;
4267 /* Tell wait_reading_process_input that it needs to wake up and
4268 look around. */
4269 if (input_available_clear_time)
4270 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
4273 /* On some systems, we must return right away.
4274 If any more processes want to signal us, we will
4275 get another signal.
4276 Otherwise (on systems that have WNOHANG), loop around
4277 to use up all the processes that have something to tell us. */
4278 #if (defined WINDOWSNT \
4279 || (defined USG && !defined GNU_LINUX \
4280 && !(defined HPUX && defined WNOHANG)))
4281 #if defined (USG) && ! defined (POSIX_SIGNALS)
4282 signal (signo, sigchld_handler);
4283 #endif
4284 errno = old_errno;
4285 return;
4286 #endif /* USG, but not HPUX with WNOHANG */
4291 static Lisp_Object
4292 exec_sentinel_unwind (data)
4293 Lisp_Object data;
4295 XPROCESS (XCAR (data))->sentinel = XCDR (data);
4296 return Qnil;
4299 static Lisp_Object
4300 exec_sentinel_error_handler (error)
4301 Lisp_Object error;
4303 cmd_error_internal (error, "error in process sentinel: ");
4304 Vinhibit_quit = Qt;
4305 update_echo_area ();
4306 Fsleep_for (make_number (2), Qnil);
4307 return Qt;
4310 static void
4311 exec_sentinel (proc, reason)
4312 Lisp_Object proc, reason;
4314 Lisp_Object sentinel, obuffer, odeactivate, okeymap;
4315 register struct Lisp_Process *p = XPROCESS (proc);
4316 int count = specpdl_ptr - specpdl;
4317 int outer_running_asynch_code = running_asynch_code;
4318 int waiting = waiting_for_user_input_p;
4320 /* No need to gcpro these, because all we do with them later
4321 is test them for EQness, and none of them should be a string. */
4322 odeactivate = Vdeactivate_mark;
4323 XSETBUFFER (obuffer, current_buffer);
4324 okeymap = current_buffer->keymap;
4326 sentinel = p->sentinel;
4327 if (NILP (sentinel))
4328 return;
4330 /* Zilch the sentinel while it's running, to avoid recursive invocations;
4331 assure that it gets restored no matter how the sentinel exits. */
4332 p->sentinel = Qnil;
4333 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
4334 /* Inhibit quit so that random quits don't screw up a running filter. */
4335 specbind (Qinhibit_quit, Qt);
4336 specbind (Qlast_nonmenu_event, Qt);
4338 /* In case we get recursively called,
4339 and we already saved the match data nonrecursively,
4340 save the same match data in safely recursive fashion. */
4341 if (outer_running_asynch_code)
4343 Lisp_Object tem;
4344 tem = Fmatch_data (Qnil, Qnil);
4345 restore_match_data ();
4346 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
4347 Fset_match_data (tem);
4350 /* For speed, if a search happens within this code,
4351 save the match data in a special nonrecursive fashion. */
4352 running_asynch_code = 1;
4354 internal_condition_case_1 (read_process_output_call,
4355 Fcons (sentinel,
4356 Fcons (proc, Fcons (reason, Qnil))),
4357 !NILP (Vdebug_on_error) ? Qnil : Qerror,
4358 exec_sentinel_error_handler);
4360 /* If we saved the match data nonrecursively, restore it now. */
4361 restore_match_data ();
4362 running_asynch_code = outer_running_asynch_code;
4364 Vdeactivate_mark = odeactivate;
4366 /* Restore waiting_for_user_input_p as it was
4367 when we were called, in case the filter clobbered it. */
4368 waiting_for_user_input_p = waiting;
4370 #if 0
4371 if (! EQ (Fcurrent_buffer (), obuffer)
4372 || ! EQ (current_buffer->keymap, okeymap))
4373 #endif
4374 /* But do it only if the caller is actually going to read events.
4375 Otherwise there's no need to make him wake up, and it could
4376 cause trouble (for example it would make Fsit_for return). */
4377 if (waiting_for_user_input_p == -1)
4378 record_asynch_buffer_change ();
4380 unbind_to (count, Qnil);
4383 /* Report all recent events of a change in process status
4384 (either run the sentinel or output a message).
4385 This is done while Emacs is waiting for keyboard input. */
4387 void
4388 status_notify ()
4390 register Lisp_Object proc, buffer;
4391 Lisp_Object tail, msg;
4392 struct gcpro gcpro1, gcpro2;
4394 tail = Qnil;
4395 msg = Qnil;
4396 /* We need to gcpro tail; if read_process_output calls a filter
4397 which deletes a process and removes the cons to which tail points
4398 from Vprocess_alist, and then causes a GC, tail is an unprotected
4399 reference. */
4400 GCPRO2 (tail, msg);
4402 /* Set this now, so that if new processes are created by sentinels
4403 that we run, we get called again to handle their status changes. */
4404 update_tick = process_tick;
4406 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
4408 Lisp_Object symbol;
4409 register struct Lisp_Process *p;
4411 proc = Fcdr (Fcar (tail));
4412 p = XPROCESS (proc);
4414 if (XINT (p->tick) != XINT (p->update_tick))
4416 XSETINT (p->update_tick, XINT (p->tick));
4418 /* If process is still active, read any output that remains. */
4419 while (! EQ (p->filter, Qt)
4420 && XINT (p->infd) >= 0
4421 && read_process_output (proc, XINT (p->infd)) > 0);
4423 buffer = p->buffer;
4425 /* Get the text to use for the message. */
4426 if (!NILP (p->raw_status_low))
4427 update_status (p);
4428 msg = status_message (p->status);
4430 /* If process is terminated, deactivate it or delete it. */
4431 symbol = p->status;
4432 if (CONSP (p->status))
4433 symbol = XCAR (p->status);
4435 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
4436 || EQ (symbol, Qclosed))
4438 if (delete_exited_processes)
4439 remove_process (proc);
4440 else
4441 deactivate_process (proc);
4444 /* The actions above may have further incremented p->tick.
4445 So set p->update_tick again
4446 so that an error in the sentinel will not cause
4447 this code to be run again. */
4448 XSETINT (p->update_tick, XINT (p->tick));
4449 /* Now output the message suitably. */
4450 if (!NILP (p->sentinel))
4451 exec_sentinel (proc, msg);
4452 /* Don't bother with a message in the buffer
4453 when a process becomes runnable. */
4454 else if (!EQ (symbol, Qrun) && !NILP (buffer))
4456 Lisp_Object ro, tem;
4457 struct buffer *old = current_buffer;
4458 int opoint, opoint_byte;
4459 int before, before_byte;
4461 ro = XBUFFER (buffer)->read_only;
4463 /* Avoid error if buffer is deleted
4464 (probably that's why the process is dead, too) */
4465 if (NILP (XBUFFER (buffer)->name))
4466 continue;
4467 Fset_buffer (buffer);
4469 opoint = PT;
4470 opoint_byte = PT_BYTE;
4471 /* Insert new output into buffer
4472 at the current end-of-output marker,
4473 thus preserving logical ordering of input and output. */
4474 if (XMARKER (p->mark)->buffer)
4475 Fgoto_char (p->mark);
4476 else
4477 SET_PT_BOTH (ZV, ZV_BYTE);
4479 before = PT;
4480 before_byte = PT_BYTE;
4482 tem = current_buffer->read_only;
4483 current_buffer->read_only = Qnil;
4484 insert_string ("\nProcess ");
4485 Finsert (1, &p->name);
4486 insert_string (" ");
4487 Finsert (1, &msg);
4488 current_buffer->read_only = tem;
4489 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
4491 if (opoint >= before)
4492 SET_PT_BOTH (opoint + (PT - before),
4493 opoint_byte + (PT_BYTE - before_byte));
4494 else
4495 SET_PT_BOTH (opoint, opoint_byte);
4497 set_buffer_internal (old);
4500 } /* end for */
4502 update_mode_lines++; /* in case buffers use %s in mode-line-format */
4503 redisplay_preserve_echo_area (13);
4505 UNGCPRO;
4509 DEFUN ("set-process-coding-system", Fset_process_coding_system,
4510 Sset_process_coding_system, 1, 3, 0,
4511 doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
4512 DECODING will be used to decode subprocess output and ENCODING to
4513 encode subprocess input. */)
4514 (proc, decoding, encoding)
4515 register Lisp_Object proc, decoding, encoding;
4517 register struct Lisp_Process *p;
4519 CHECK_PROCESS (proc);
4520 p = XPROCESS (proc);
4521 if (XINT (p->infd) < 0)
4522 error ("Input file descriptor of %s closed", XSTRING (p->name)->data);
4523 if (XINT (p->outfd) < 0)
4524 error ("Output file descriptor of %s closed", XSTRING (p->name)->data);
4526 p->decode_coding_system = Fcheck_coding_system (decoding);
4527 p->encode_coding_system = Fcheck_coding_system (encoding);
4528 setup_coding_system (decoding,
4529 proc_decode_coding_system[XINT (p->infd)]);
4530 setup_coding_system (encoding,
4531 proc_encode_coding_system[XINT (p->outfd)]);
4533 return Qnil;
4536 DEFUN ("process-coding-system",
4537 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
4538 doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
4539 (proc)
4540 register Lisp_Object proc;
4542 CHECK_PROCESS (proc);
4543 return Fcons (XPROCESS (proc)->decode_coding_system,
4544 XPROCESS (proc)->encode_coding_system);
4547 /* The first time this is called, assume keyboard input comes from DESC
4548 instead of from where we used to expect it.
4549 Subsequent calls mean assume input keyboard can come from DESC
4550 in addition to other places. */
4552 static int add_keyboard_wait_descriptor_called_flag;
4554 void
4555 add_keyboard_wait_descriptor (desc)
4556 int desc;
4558 if (! add_keyboard_wait_descriptor_called_flag)
4559 FD_CLR (0, &input_wait_mask);
4560 add_keyboard_wait_descriptor_called_flag = 1;
4561 FD_SET (desc, &input_wait_mask);
4562 FD_SET (desc, &non_process_wait_mask);
4563 if (desc > max_keyboard_desc)
4564 max_keyboard_desc = desc;
4567 /* From now on, do not expect DESC to give keyboard input. */
4569 void
4570 delete_keyboard_wait_descriptor (desc)
4571 int desc;
4573 int fd;
4574 int lim = max_keyboard_desc;
4576 FD_CLR (desc, &input_wait_mask);
4577 FD_CLR (desc, &non_process_wait_mask);
4579 if (desc == max_keyboard_desc)
4580 for (fd = 0; fd < lim; fd++)
4581 if (FD_ISSET (fd, &input_wait_mask)
4582 && !FD_ISSET (fd, &non_keyboard_wait_mask))
4583 max_keyboard_desc = fd;
4586 /* Return nonzero if *MASK has a bit set
4587 that corresponds to one of the keyboard input descriptors. */
4590 keyboard_bit_set (mask)
4591 SELECT_TYPE *mask;
4593 int fd;
4595 for (fd = 0; fd <= max_keyboard_desc; fd++)
4596 if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask)
4597 && !FD_ISSET (fd, &non_keyboard_wait_mask))
4598 return 1;
4600 return 0;
4603 void
4604 init_process ()
4606 register int i;
4608 #ifdef SIGCHLD
4609 #ifndef CANNOT_DUMP
4610 if (! noninteractive || initialized)
4611 #endif
4612 signal (SIGCHLD, sigchld_handler);
4613 #endif
4615 FD_ZERO (&input_wait_mask);
4616 FD_ZERO (&non_keyboard_wait_mask);
4617 FD_ZERO (&non_process_wait_mask);
4618 max_process_desc = 0;
4620 FD_SET (0, &input_wait_mask);
4622 Vprocess_alist = Qnil;
4623 for (i = 0; i < MAXDESC; i++)
4625 chan_process[i] = Qnil;
4626 proc_buffered_char[i] = -1;
4628 bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
4629 bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
4632 void
4633 syms_of_process ()
4635 Qprocessp = intern ("processp");
4636 staticpro (&Qprocessp);
4637 Qrun = intern ("run");
4638 staticpro (&Qrun);
4639 Qstop = intern ("stop");
4640 staticpro (&Qstop);
4641 Qsignal = intern ("signal");
4642 staticpro (&Qsignal);
4644 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
4645 here again.
4647 Qexit = intern ("exit");
4648 staticpro (&Qexit); */
4650 Qopen = intern ("open");
4651 staticpro (&Qopen);
4652 Qclosed = intern ("closed");
4653 staticpro (&Qclosed);
4655 Qlast_nonmenu_event = intern ("last-nonmenu-event");
4656 staticpro (&Qlast_nonmenu_event);
4658 staticpro (&Vprocess_alist);
4660 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
4661 doc: /* *Non-nil means delete processes immediately when they exit.
4662 nil means don't delete them until `list-processes' is run. */);
4664 delete_exited_processes = 1;
4666 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
4667 doc: /* Control type of device used to communicate with subprocesses.
4668 Values are nil to use a pipe, or t or `pty' to use a pty.
4669 The value has no effect if the system has no ptys or if all ptys are busy:
4670 then a pipe is used in any case.
4671 The value takes effect when `start-process' is called. */);
4672 Vprocess_connection_type = Qt;
4674 defsubr (&Sprocessp);
4675 defsubr (&Sget_process);
4676 defsubr (&Sget_buffer_process);
4677 defsubr (&Sdelete_process);
4678 defsubr (&Sprocess_status);
4679 defsubr (&Sprocess_exit_status);
4680 defsubr (&Sprocess_id);
4681 defsubr (&Sprocess_name);
4682 defsubr (&Sprocess_tty_name);
4683 defsubr (&Sprocess_command);
4684 defsubr (&Sset_process_buffer);
4685 defsubr (&Sprocess_buffer);
4686 defsubr (&Sprocess_mark);
4687 defsubr (&Sset_process_filter);
4688 defsubr (&Sprocess_filter);
4689 defsubr (&Sset_process_sentinel);
4690 defsubr (&Sprocess_sentinel);
4691 defsubr (&Sset_process_window_size);
4692 defsubr (&Sset_process_inherit_coding_system_flag);
4693 defsubr (&Sprocess_inherit_coding_system_flag);
4694 defsubr (&Sprocess_kill_without_query);
4695 defsubr (&Sprocess_contact);
4696 defsubr (&Slist_processes);
4697 defsubr (&Sprocess_list);
4698 defsubr (&Sstart_process);
4699 #ifdef HAVE_SOCKETS
4700 defsubr (&Sopen_network_stream);
4701 #endif /* HAVE_SOCKETS */
4702 defsubr (&Saccept_process_output);
4703 defsubr (&Sprocess_send_region);
4704 defsubr (&Sprocess_send_string);
4705 defsubr (&Sinterrupt_process);
4706 defsubr (&Skill_process);
4707 defsubr (&Squit_process);
4708 defsubr (&Sstop_process);
4709 defsubr (&Scontinue_process);
4710 defsubr (&Sprocess_running_child_p);
4711 defsubr (&Sprocess_send_eof);
4712 defsubr (&Ssignal_process);
4713 defsubr (&Swaiting_for_user_input_p);
4714 /* defsubr (&Sprocess_connection); */
4715 defsubr (&Sset_process_coding_system);
4716 defsubr (&Sprocess_coding_system);
4720 #else /* not subprocesses */
4722 #include <sys/types.h>
4723 #include <errno.h>
4725 #include "lisp.h"
4726 #include "systime.h"
4727 #include "character.h"
4728 #include "coding.h"
4729 #include "termopts.h"
4730 #include "sysselect.h"
4732 extern int frame_garbaged;
4734 extern EMACS_TIME timer_check ();
4735 extern int timers_run;
4737 /* As described above, except assuming that there are no subprocesses:
4739 Wait for timeout to elapse and/or keyboard input to be available.
4741 time_limit is:
4742 timeout in seconds, or
4743 zero for no limit, or
4744 -1 means gobble data immediately available but don't wait for any.
4746 read_kbd is a Lisp_Object:
4747 0 to ignore keyboard input, or
4748 1 to return when input is available, or
4749 -1 means caller will actually read the input, so don't throw to
4750 the quit handler.
4751 a cons cell, meaning wait until its car is non-nil
4752 (and gobble terminal input into the buffer if any arrives), or
4753 We know that read_kbd will never be a Lisp_Process, since
4754 `subprocesses' isn't defined.
4756 do_display != 0 means redisplay should be done to show subprocess
4757 output that arrives.
4759 Return true iff we received input from any process. */
4762 wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
4763 int time_limit, microsecs;
4764 Lisp_Object read_kbd;
4765 int do_display;
4767 register int nfds;
4768 EMACS_TIME end_time, timeout;
4769 SELECT_TYPE waitchannels;
4770 int xerrno;
4771 /* Either nil or a cons cell, the car of which is of interest and
4772 may be changed outside of this routine. */
4773 Lisp_Object wait_for_cell = Qnil;
4775 /* If waiting for non-nil in a cell, record where. */
4776 if (CONSP (read_kbd))
4778 wait_for_cell = read_kbd;
4779 XSETFASTINT (read_kbd, 0);
4782 /* What does time_limit really mean? */
4783 if (time_limit || microsecs)
4785 EMACS_GET_TIME (end_time);
4786 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
4787 EMACS_ADD_TIME (end_time, end_time, timeout);
4790 /* Turn off periodic alarms (in case they are in use)
4791 because the select emulator uses alarms. */
4792 turn_on_atimers (0);
4794 while (1)
4796 int timeout_reduced_for_timers = 0;
4798 /* If calling from keyboard input, do not quit
4799 since we want to return C-g as an input character.
4800 Otherwise, do pending quit if requested. */
4801 if (XINT (read_kbd) >= 0)
4802 QUIT;
4804 /* Exit now if the cell we're waiting for became non-nil. */
4805 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
4806 break;
4808 /* Compute time from now till when time limit is up */
4809 /* Exit if already run out */
4810 if (time_limit == -1)
4812 /* -1 specified for timeout means
4813 gobble output available now
4814 but don't wait at all. */
4816 EMACS_SET_SECS_USECS (timeout, 0, 0);
4818 else if (time_limit || microsecs)
4820 EMACS_GET_TIME (timeout);
4821 EMACS_SUB_TIME (timeout, end_time, timeout);
4822 if (EMACS_TIME_NEG_P (timeout))
4823 break;
4825 else
4827 EMACS_SET_SECS_USECS (timeout, 100000, 0);
4830 /* If our caller will not immediately handle keyboard events,
4831 run timer events directly.
4832 (Callers that will immediately read keyboard events
4833 call timer_delay on their own.) */
4834 if (NILP (wait_for_cell))
4836 EMACS_TIME timer_delay;
4840 int old_timers_run = timers_run;
4841 timer_delay = timer_check (1);
4842 if (timers_run != old_timers_run && do_display)
4843 /* We must retry, since a timer may have requeued itself
4844 and that could alter the time delay. */
4845 redisplay_preserve_echo_area (14);
4846 else
4847 break;
4849 while (!detect_input_pending ());
4851 /* If there is unread keyboard input, also return. */
4852 if (XINT (read_kbd) != 0
4853 && requeued_events_pending_p ())
4854 break;
4856 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
4858 EMACS_TIME difference;
4859 EMACS_SUB_TIME (difference, timer_delay, timeout);
4860 if (EMACS_TIME_NEG_P (difference))
4862 timeout = timer_delay;
4863 timeout_reduced_for_timers = 1;
4868 /* Cause C-g and alarm signals to take immediate action,
4869 and cause input available signals to zero out timeout. */
4870 if (XINT (read_kbd) < 0)
4871 set_waiting_for_input (&timeout);
4873 /* Wait till there is something to do. */
4875 if (! XINT (read_kbd) && NILP (wait_for_cell))
4876 FD_ZERO (&waitchannels);
4877 else
4878 FD_SET (0, &waitchannels);
4880 /* If a frame has been newly mapped and needs updating,
4881 reprocess its display stuff. */
4882 if (frame_garbaged && do_display)
4884 clear_waiting_for_input ();
4885 redisplay_preserve_echo_area (15);
4886 if (XINT (read_kbd) < 0)
4887 set_waiting_for_input (&timeout);
4890 if (XINT (read_kbd) && detect_input_pending ())
4892 nfds = 0;
4893 FD_ZERO (&waitchannels);
4895 else
4896 nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
4897 &timeout);
4899 xerrno = errno;
4901 /* Make C-g and alarm signals set flags again */
4902 clear_waiting_for_input ();
4904 /* If we woke up due to SIGWINCH, actually change size now. */
4905 do_pending_window_change (0);
4907 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
4908 /* We waited the full specified time, so return now. */
4909 break;
4911 if (nfds == -1)
4913 /* If the system call was interrupted, then go around the
4914 loop again. */
4915 if (xerrno == EINTR)
4916 FD_ZERO (&waitchannels);
4917 else
4918 error ("select error: %s", emacs_strerror (xerrno));
4920 #ifdef sun
4921 else if (nfds > 0 && (waitchannels & 1) && interrupt_input)
4922 /* System sometimes fails to deliver SIGIO. */
4923 kill (getpid (), SIGIO);
4924 #endif
4925 #ifdef SIGIO
4926 if (XINT (read_kbd) && interrupt_input && (waitchannels & 1))
4927 kill (getpid (), SIGIO);
4928 #endif
4930 /* Check for keyboard input */
4932 if ((XINT (read_kbd) != 0)
4933 && detect_input_pending_run_timers (do_display))
4935 swallow_events (do_display);
4936 if (detect_input_pending_run_timers (do_display))
4937 break;
4940 /* If there is unread keyboard input, also return. */
4941 if (XINT (read_kbd) != 0
4942 && requeued_events_pending_p ())
4943 break;
4945 /* If wait_for_cell. check for keyboard input
4946 but don't run any timers.
4947 ??? (It seems wrong to me to check for keyboard
4948 input at all when wait_for_cell, but the code
4949 has been this way since July 1994.
4950 Try changing this after version 19.31.) */
4951 if (! NILP (wait_for_cell)
4952 && detect_input_pending ())
4954 swallow_events (do_display);
4955 if (detect_input_pending ())
4956 break;
4959 /* Exit now if the cell we're waiting for became non-nil. */
4960 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
4961 break;
4964 start_polling ();
4966 return 0;
4970 /* Don't confuse make-docfile by having two doc strings for this function.
4971 make-docfile does not pay attention to #if, for good reason! */
4972 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
4974 (name)
4975 register Lisp_Object name;
4977 return Qnil;
4980 /* Don't confuse make-docfile by having two doc strings for this function.
4981 make-docfile does not pay attention to #if, for good reason! */
4982 DEFUN ("process-inherit-coding-system-flag",
4983 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
4984 1, 1, 0,
4986 (process)
4987 register Lisp_Object process;
4989 /* Ignore the argument and return the value of
4990 inherit-process-coding-system. */
4991 return inherit_process_coding_system ? Qt : Qnil;
4994 /* Kill all processes associated with `buffer'.
4995 If `buffer' is nil, kill all processes.
4996 Since we have no subprocesses, this does nothing. */
4998 void
4999 kill_buffer_processes (buffer)
5000 Lisp_Object buffer;
5004 void
5005 init_process ()
5009 void
5010 syms_of_process ()
5012 defsubr (&Sget_buffer_process);
5013 defsubr (&Sprocess_inherit_coding_system_flag);
5017 #endif /* not subprocesses */