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