aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorJim Blandy1992-03-14 20:40:04 +0000
committerJim Blandy1992-03-14 20:40:04 +0000
commitd0d6b7c506eb0f93e80db38d6c2affe0a2b49b4c (patch)
tree2eb201bbcb3906f9d002f5fe289250b19e08db5a /src
parent956ace37a8ec4df40a07940c08d5aa6d10e8b073 (diff)
downloademacs-d0d6b7c506eb0f93e80db38d6c2affe0a2b49b4c.tar.gz
emacs-d0d6b7c506eb0f93e80db38d6c2affe0a2b49b4c.zip
Initial revision
Diffstat (limited to 'src')
-rw-r--r--src/process.c2887
-rw-r--r--src/systty.h267
2 files changed, 3154 insertions, 0 deletions
diff --git a/src/process.c b/src/process.c
new file mode 100644
index 00000000000..8ddfe240eb6
--- /dev/null
+++ b/src/process.c
@@ -0,0 +1,2887 @@
1/* Asynchronous subprocess control for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 1, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21#include <signal.h>
22
23#include "config.h"
24
25#ifdef subprocesses
26/* The entire file is within this conditional */
27
28#include <stdio.h>
29#include <errno.h>
30#include <setjmp.h>
31#include <sys/types.h> /* some typedefs are used in sys/file.h */
32#include <sys/file.h>
33#include <sys/stat.h>
34
35#ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
36#include <sys/socket.h>
37#include <netdb.h>
38#include <netinet/in.h>
39#include <arpa/inet.h>
40#endif /* HAVE_SOCKETS */
41
42#if defined(BSD) || defined(STRIDE)
43#include <sys/ioctl.h>
44#if !defined (O_NDELAY) && defined (HAVE_PTYS)
45#include <fcntl.h>
46#endif /* HAVE_PTYS and no O_NDELAY */
47#endif /* BSD or STRIDE */
48#ifdef USG
49#ifdef HAVE_TERMIOS
50#include <termios.h>
51#else
52#include <termio.h>
53#endif
54#include <fcntl.h>
55#endif /* USG */
56
57#ifdef NEED_BSDTTY
58#include <bsdtty.h>
59#endif
60
61#ifdef HPUX
62#undef TIOCGPGRP
63#endif
64
65#ifdef IRIS
66#include <sys/sysmacros.h> /* for "minor" */
67#endif /* not IRIS */
68
69#include "systime.h"
70
71#if defined (HPUX) && defined (HAVE_PTYS)
72#include <sys/ptyio.h>
73#endif
74
75#ifdef AIX
76#include <sys/pty.h>
77#include <unistd.h>
78#endif
79
80#ifdef SYSV_PTYS
81#include <sys/tty.h>
82#ifdef titan
83#include <sys/ttyhw.h>
84#include <sys/stream.h>
85#endif
86#include <sys/pty.h>
87#endif
88
89#ifdef XENIX
90#undef TIOCGETC /* Avoid confusing some conditionals that test this. */
91#endif
92
93#ifdef BROKEN_TIOCGETC
94#undef TIOCGETC
95#endif
96
97#include "lisp.h"
98#include "window.h"
99#include "buffer.h"
100#include "process.h"
101#include "termhooks.h"
102#include "termopts.h"
103#include "commands.h"
104
105extern int screen_garbaged;
106
107Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed;
108/* Qexit is declared and initialized in eval.c. */
109
110/* a process object is a network connection when its childp field is neither
111 Qt nor Qnil but is instead a string (name of foreign host we
112 are connected to + name of port we are connected to) */
113
114#ifdef HAVE_SOCKETS
115static Lisp_Object stream_process;
116
117#define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String)
118#else
119#define NETCONN_P(p) 0
120#endif /* HAVE_SOCKETS */
121
122/* Define first descriptor number available for subprocesses. */
123#ifdef VMS
124#define FIRST_PROC_DESC 1
125#else /* Not VMS */
126#define FIRST_PROC_DESC 3
127#endif
128
129/* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
130 testing SIGCHLD. */
131
132#if !defined (SIGCHLD) && defined (SIGCLD)
133#define SIGCHLD SIGCLD
134#endif /* SIGCLD */
135
136#include "syssignal.h"
137
138/* Define the structure that the wait system call stores.
139 On many systems, there is a structure defined for this.
140 But on vanilla-ish USG systems there is not. */
141
142#ifndef VMS
143#ifndef WAITTYPE
144#if !defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE) && !(defined (HPUX) && !defined (NOMULTIPLEJOBS)) && !defined (HAVE_WAIT_HEADER)
145mis;tak-+;;:
146#define WAITTYPE int
147#define WIFSTOPPED(w) ((w&0377) == 0177)
148#define WIFSIGNALED(w) ((w&0377) != 0177 && (w&~0377) == 0)
149#define WIFEXITED(w) ((w&0377) == 0)
150#define WRETCODE(w) (w >> 8)
151#define WSTOPSIG(w) (w >> 8)
152#define WCOREDUMP(w) ((w&0200) != 0)
153#define WTERMSIG(w) (w & 0377)
154#else
155#ifdef BSD4_1
156#include <wait.h>
157#else
158#include <sys/wait.h>
159#endif /* not BSD 4.1 */
160
161#define WAITTYPE union wait
162#define WRETCODE(w) w.w_retcode
163#define WCOREDUMP(w) w.w_coredump
164
165#ifdef HPUX
166/* HPUX version 7 has broken definitions of these. */
167#undef WTERMSIG
168#undef WSTOPSIG
169#undef WIFSTOPPED
170#undef WIFSIGNALED
171#undef WIFEXITED
172#endif
173
174#ifndef WTERMSIG
175#define WTERMSIG(w) w.w_termsig
176#endif
177#ifndef WSTOPSIG
178#define WSTOPSIG(w) w.w_stopsig
179#endif
180#ifndef WIFSTOPPED
181#define WIFSTOPPED(w) (WTERMSIG (w) == 0177)
182#endif
183#ifndef WIFSIGNALED
184#define WIFSIGNALED(w) (WTERMSIG (w) != 0177 && (WSTOPSIG (w)) == 0)
185#endif
186#ifndef WIFEXITED
187#define WIFEXITED(w) (WTERMSIG (w) == 0)
188#endif
189#endif /* BSD or UNIPLUS or STRIDE */
190#endif /* no WAITTYPE */
191#else /* VMS */
192
193/* For the CMU PTY driver + */
194#define DCL_PROMPT "$ "
195
196#include <ssdef.h>
197#include <iodef.h>
198#include <clidef.h>
199#include "vmsproc.h"
200#endif /* VMS */
201
202extern errno;
203extern sys_nerr;
204extern char *sys_errlist[];
205
206#ifndef VMS
207#ifndef BSD4_1
208extern char *sys_siglist[];
209#else
210char *sys_siglist[] =
211 {
212 "bum signal!!",
213 "hangup",
214 "interrupt",
215 "quit",
216 "illegal instruction",
217 "trace trap",
218 "iot instruction",
219 "emt instruction",
220 "floating point exception",
221 "kill",
222 "bus error",
223 "segmentation violation",
224 "bad argument to system call",
225 "write on a pipe with no one to read it",
226 "alarm clock",
227 "software termination signal from kill",
228 "status signal",
229 "sendable stop signal not from tty",
230 "stop signal from tty",
231 "continue a stopped process",
232 "child status has changed",
233 "background read attempted from control tty",
234 "background write attempted from control tty",
235 "input record available at control tty",
236 "exceeded CPU time limit",
237 "exceeded file size limit"
238 };
239#endif
240#endif /* VMS */
241
242#ifdef vipc
243
244#include "vipc.h"
245extern int comm_server;
246extern int net_listen_address;
247#endif /* vipc */
248
249/* t means use pty, nil means use a pipe,
250 maybe other values to come. */
251Lisp_Object Vprocess_connection_type;
252
253#ifdef SKTPAIR
254#ifndef HAVE_SOCKETS
255#include <sys/socket.h>
256#endif
257#endif /* SKTPAIR */
258
259/* Number of events of change of status of a process. */
260int process_tick;
261
262/* Number of events for which the user or sentinel has been notified. */
263int update_tick;
264
265#ifdef FD_SET
266/* We could get this from param.h, but better not to depend on finding that.
267 And better not to risk that it might define other symbols used in this
268 file. */
269#define MAXDESC 64
270#define SELECT_TYPE fd_set
271#else /* no FD_SET */
272#define MAXDESC 32
273#define SELECT_TYPE int
274
275/* Define the macros to access a single-int bitmap of descriptors. */
276#define FD_SET(n, p) (*(p) |= (1 << (n)))
277#define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
278#define FD_ISSET(n, p) (*(p) & (1 << (n)))
279#define FD_ZERO(p) (*(p) = 0)
280#endif /* no FD_SET */
281
282/* Mask of bits indicating the descriptors that we wait for input on */
283
284SELECT_TYPE input_wait_mask;
285
286int delete_exited_processes;
287
288/* Indexed by descriptor, gives the process (if any) for that descriptor */
289Lisp_Object chan_process[MAXDESC];
290
291/* Alist of elements (NAME . PROCESS) */
292Lisp_Object Vprocess_alist;
293
294Lisp_Object Qprocessp;
295
296Lisp_Object get_process ();
297
298/* Buffered-ahead input char from process, indexed by channel.
299 -1 means empty (no char is buffered).
300 Used on sys V where the only way to tell if there is any
301 output from the process is to read at least one char.
302 Always -1 on systems that support FIONREAD. */
303
304int proc_buffered_char[MAXDESC];
305
306/* Compute the Lisp form of the process status, p->status, from
307 the numeric status that was returned by `wait'. */
308
309update_status (p)
310 struct Lisp_Process *p;
311{
312 union { int i; WAITTYPE wt; } u;
313 u.i = XFASTINT (p->raw_status_low) + (XFASTINT (p->raw_status_high) << 16);
314 p->status = status_convert (u.wt);
315 p->raw_status_low = Qnil;
316 p->raw_status_high = Qnil;
317}
318
319/* Convert a process status work in Unix format to
320 the list that we use internally. */
321
322Lisp_Object
323status_convert (w)
324 WAITTYPE w;
325{
326 if (WIFSTOPPED (w))
327 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
328 else if (WIFEXITED (w))
329 return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
330 WCOREDUMP (w) ? Qt : Qnil));
331 else if (WIFSIGNALED (w))
332 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
333 WCOREDUMP (w) ? Qt : Qnil));
334 else
335 return Qrun;
336}
337
338/* Given a status-list, extract the three pieces of information
339 and store them individually through the three pointers. */
340
341void
342decode_status (l, symbol, code, coredump)
343 Lisp_Object l;
344 Lisp_Object *symbol;
345 int *code;
346 int *coredump;
347{
348 Lisp_Object tem;
349
350 if (XTYPE (l) == Lisp_Symbol)
351 {
352 *symbol = l;
353 *code = 0;
354 *coredump = 0;
355 }
356 else
357 {
358 *symbol = XCONS (l)->car;
359 tem = XCONS (l)->cdr;
360 *code = XFASTINT (XCONS (tem)->car);
361 tem = XFASTINT (XCONS (tem)->cdr);
362 *coredump = !NILP (tem);
363 }
364}
365
366/* Return a string describing a process status list. */
367
368Lisp_Object
369status_message (status)
370 Lisp_Object status;
371{
372 Lisp_Object symbol;
373 int code, coredump;
374 Lisp_Object string, string2;
375
376 decode_status (status, &symbol, &code, &coredump);
377
378 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
379 {
380 string = build_string (code < NSIG ? sys_siglist[code] : "unknown");
381 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
382 XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
383 return concat2 (string, string2);
384 }
385 else if (EQ (symbol, Qexit))
386 {
387 if (code == 0)
388 return build_string ("finished\n");
389 string = Fint_to_string (make_number (code));
390 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
391 return concat2 (build_string ("exited abnormally with code "),
392 concat2 (string, string2));
393 }
394 else
395 return Fcopy_sequence (Fsymbol_name (symbol));
396}
397
398#ifdef HAVE_PTYS
399static pty_process;
400
401/* Open an available pty, returning a file descriptor.
402 Return -1 on failure.
403 The file name of the terminal corresponding to the pty
404 is left in the variable pty_name. */
405
406char pty_name[24];
407
408int
409allocate_pty ()
410{
411 struct stat stb;
412 register c, i;
413 int fd;
414
415#ifdef PTY_ITERATION
416 PTY_ITERATION
417#else
418 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
419 for (i = 0; i < 16; i++)
420#endif
421 {
422#ifdef PTY_NAME_SPRINTF
423 PTY_NAME_SPRINTF
424#else
425#ifdef HPUX
426 sprintf (pty_name, "/dev/ptym/pty%c%x", c, i);
427#else
428#ifdef RTU
429 sprintf (pty_name, "/dev/pty%x", i);
430#else
431 sprintf (pty_name, "/dev/pty%c%x", c, i);
432#endif /* not RTU */
433#endif /* not HPUX */
434#endif /* no PTY_NAME_SPRINTF */
435
436#ifndef IRIS
437 if (stat (pty_name, &stb) < 0)
438 return -1;
439#ifdef O_NONBLOCK
440 fd = open (pty_name, O_RDWR | O_NONBLOCK, 0);
441#else
442 fd = open (pty_name, O_RDWR | O_NDELAY, 0);
443#endif
444#else /* Unusual IRIS code */
445 *ptyv = open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
446 if (fd < 0)
447 return -1;
448 if (fstat (fd, &stb) < 0)
449 return -1;
450#endif /* IRIS */
451
452 if (fd >= 0)
453 {
454 /* check to make certain that both sides are available
455 this avoids a nasty yet stupid bug in rlogins */
456#ifdef PTY_TTY_NAME_SPRINTF
457 PTY_TTY_NAME_SPRINTF
458#else
459 /* TODO: In version 19, make these special cases use the macro above. */
460#ifdef HPUX
461 sprintf (pty_name, "/dev/pty/tty%c%x", c, i);
462#else
463#ifdef RTU
464 sprintf (pty_name, "/dev/ttyp%x", i);
465#else
466#ifdef IRIS
467 sprintf (pty_name, "/dev/ttyq%d", minor (stb.st_rdev));
468#else
469 sprintf (pty_name, "/dev/tty%c%x", c, i);
470#endif /* not IRIS */
471#endif /* not RTU */
472#endif /* not HPUX */
473#endif /* no PTY_TTY_NAME_SPRINTF */
474#ifndef UNIPLUS
475 if (access (pty_name, 6) != 0)
476 {
477 close (fd);
478#ifndef IRIS
479 continue;
480#else
481 return -1;
482#endif /* IRIS */
483 }
484#endif /* not UNIPLUS */
485 setup_pty (fd);
486 return fd;
487 }
488 }
489 return -1;
490}
491#endif /* HAVE_PTYS */
492
493Lisp_Object
494make_process (name)
495 Lisp_Object name;
496{
497 register Lisp_Object val, tem, name1;
498 register struct Lisp_Process *p;
499 char suffix[10];
500 register int i;
501
502 /* size of process structure includes the vector header,
503 so deduct for that. But struct Lisp_Vector includes the first
504 element, thus deducts too much, so add it back. */
505 val = Fmake_vector (make_number ((sizeof (struct Lisp_Process)
506 - sizeof (struct Lisp_Vector)
507 + sizeof (Lisp_Object))
508 / sizeof (Lisp_Object)),
509 Qnil);
510 XSETTYPE (val, Lisp_Process);
511
512 p = XPROCESS (val);
513 XFASTINT (p->infd) = 0;
514 XFASTINT (p->outfd) = 0;
515 XFASTINT (p->pid) = 0;
516 XFASTINT (p->tick) = 0;
517 XFASTINT (p->update_tick) = 0;
518 p->raw_status_low = Qnil;
519 p->raw_status_high = Qnil;
520 p->status = Qrun;
521 p->mark = Fmake_marker ();
522
523 /* If name is already in use, modify it until it is unused. */
524
525 name1 = name;
526 for (i = 1; ; i++)
527 {
528 tem = Fget_process (name1);
529 if (NILP (tem)) break;
530 sprintf (suffix, "<%d>", i);
531 name1 = concat2 (name, build_string (suffix));
532 }
533 name = name1;
534 p->name = name;
535 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
536 return val;
537}
538
539remove_process (proc)
540 register Lisp_Object proc;
541{
542 register Lisp_Object pair;
543
544 pair = Frassq (proc, Vprocess_alist);
545 Vprocess_alist = Fdelq (pair, Vprocess_alist);
546 Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil);
547
548 deactivate_process (proc);
549}
550
551DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
552 "Return t if OBJECT is a process.")
553 (obj)
554 Lisp_Object obj;
555{
556 return XTYPE (obj) == Lisp_Process ? Qt : Qnil;
557}
558
559DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
560 "Return the process named NAME, or nil if there is none.")
561 (name)
562 register Lisp_Object name;
563{
564 if (XTYPE (name) == Lisp_Process)
565 return name;
566 CHECK_STRING (name, 0);
567 return Fcdr (Fassoc (name, Vprocess_alist));
568}
569
570DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
571 "Return the (or, a) process associated with BUFFER.\n\
572BUFFER may be a buffer or the name of one.")
573 (name)
574 register Lisp_Object name;
575{
576 register Lisp_Object buf, tail, proc;
577
578 if (NILP (name)) return Qnil;
579 buf = Fget_buffer (name);
580 if (NILP (buf)) return Qnil;
581
582 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
583 {
584 proc = Fcdr (Fcar (tail));
585 if (XTYPE (proc) == Lisp_Process && EQ (XPROCESS (proc)->buffer, buf))
586 return proc;
587 }
588 return Qnil;
589}
590
591/* This is how commands for the user decode process arguments */
592
593Lisp_Object
594get_process (name)
595 register Lisp_Object name;
596{
597 register Lisp_Object proc;
598 if (NILP (name))
599 proc = Fget_buffer_process (Fcurrent_buffer ());
600 else
601 {
602 proc = Fget_process (name);
603 if (NILP (proc))
604 proc = Fget_buffer_process (Fget_buffer (name));
605 }
606
607 if (!NILP (proc))
608 return proc;
609
610 if (NILP (name))
611 error ("Current buffer has no process");
612 else
613 error ("Process %s does not exist", XSTRING (name)->data);
614 /* NOTREACHED */
615}
616
617DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
618 "Delete PROCESS: kill it and forget about it immediately.\n\
619PROCESS may be a process or the name of one, or a buffer name.")
620 (proc)
621 register Lisp_Object proc;
622{
623 proc = get_process (proc);
624 XPROCESS (proc)->raw_status_low = Qnil;
625 XPROCESS (proc)->raw_status_high = Qnil;
626 if (NETCONN_P (proc))
627 {
628 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
629 XSETINT (XPROCESS (proc)->tick, ++process_tick);
630 }
631 else if (XFASTINT (XPROCESS (proc)->infd))
632 {
633 Fkill_process (proc, Qnil);
634 /* Do this now, since remove_process will make sigchld_handler do nothing. */
635 XPROCESS (proc)->status
636 = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
637 XSETINT (XPROCESS (proc)->tick, ++process_tick);
638 status_notify ();
639 }
640 remove_process (proc);
641 return Qnil;
642}
643
644DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
645 "Return the status of PROCESS: a symbol, one of these:\n\
646run -- for a process that is running.\n\
647stop -- for a process stopped but continuable.\n\
648exit -- for a process that has exited.\n\
649signal -- for a process that has got a fatal signal.\n\
650open -- for a network stream connection that is open.\n\
651closed -- for a network stream connection that is closed.\n\
652nil -- if arg is a process name and no such process exists.")
653/* command -- for a command channel opened to Emacs by another process.\n\
654 external -- for an i/o channel opened to Emacs by another process.\n\ */
655 (proc)
656 register Lisp_Object proc;
657{
658 register struct Lisp_Process *p;
659 register Lisp_Object status;
660 proc = Fget_process (proc);
661 if (NILP (proc))
662 return proc;
663 p = XPROCESS (proc);
664 if (!NILP (p->raw_status_low))
665 update_status (p);
666 status = p->status;
667 if (XTYPE (status) == Lisp_Cons)
668 status = XCONS (status)->car;
669 if (NETCONN_P (proc))
670 {
671 if (EQ (status, Qrun))
672 status = Qopen;
673 else if (EQ (status, Qexit))
674 status = Qclosed;
675 }
676 return status;
677}
678
679DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
680 1, 1, 0,
681 "Return the exit status of PROCESS or the signal number that killed it.\n\
682If PROCESS has not yet exited or died, return 0.")
683 (proc)
684 register Lisp_Object proc;
685{
686 CHECK_PROCESS (proc, 0);
687 if (!NILP (XPROCESS (proc)->raw_status_low))
688 update_status (XPROCESS (proc));
689 if (XTYPE (XPROCESS (proc)->status) == Lisp_Cons)
690 return XCONS (XCONS (XPROCESS (proc)->status)->cdr)->car;
691 return make_number (0);
692}
693
694DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
695 "Return the process id of PROCESS.\n\
696This is the pid of the Unix process which PROCESS uses or talks to.\n\
697For a network connection, this value is nil.")
698 (proc)
699 register Lisp_Object proc;
700{
701 CHECK_PROCESS (proc, 0);
702 return XPROCESS (proc)->pid;
703}
704
705DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
706 "Return the name of PROCESS, as a string.\n\
707This is the name of the program invoked in PROCESS,\n\
708possibly modified to make it unique among process names.")
709 (proc)
710 register Lisp_Object proc;
711{
712 CHECK_PROCESS (proc, 0);
713 return XPROCESS (proc)->name;
714}
715
716DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
717 "Return the command that was executed to start PROCESS.\n\
718This is a list of strings, the first string being the program executed\n\
719and the rest of the strings being the arguments given to it.\n\
720For a non-child channel, this is nil.")
721 (proc)
722 register Lisp_Object proc;
723{
724 CHECK_PROCESS (proc, 0);
725 return XPROCESS (proc)->command;
726}
727
728DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
729 2, 2, 0,
730 "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
731 (proc, buffer)
732 register Lisp_Object proc, buffer;
733{
734 CHECK_PROCESS (proc, 0);
735 if (!NILP (buffer))
736 CHECK_BUFFER (buffer, 1);
737 XPROCESS (proc)->buffer = buffer;
738 return buffer;
739}
740
741DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
742 1, 1, 0,
743 "Return the buffer PROCESS is associated with.\n\
744Output from PROCESS is inserted in this buffer\n\
745unless PROCESS has a filter.")
746 (proc)
747 register Lisp_Object proc;
748{
749 CHECK_PROCESS (proc, 0);
750 return XPROCESS (proc)->buffer;
751}
752
753DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
754 1, 1, 0,
755 "Return the marker for the end of the last output from PROCESS.")
756 (proc)
757 register Lisp_Object proc;
758{
759 CHECK_PROCESS (proc, 0);
760 return XPROCESS (proc)->mark;
761}
762
763DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
764 2, 2, 0,
765 "Give PROCESS the filter function FILTER; nil means no filter.\n\
766When a process has a filter, each time it does output\n\
767the entire string of output is passed to the filter.\n\
768The filter gets two arguments: the process and the string of output.\n\
769If the process has a filter, its buffer is not used for output.")
770 (proc, filter)
771 register Lisp_Object proc, filter;
772{
773 CHECK_PROCESS (proc, 0);
774 XPROCESS (proc)->filter = filter;
775 return filter;
776}
777
778DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
779 1, 1, 0,
780 "Returns the filter function of PROCESS; nil if none.\n\
781See `set-process-filter' for more info on filter functions.")
782 (proc)
783 register Lisp_Object proc;
784{
785 CHECK_PROCESS (proc, 0);
786 return XPROCESS (proc)->filter;
787}
788
789DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
790 2, 2, 0,
791 "Give PROCESS the sentinel SENTINEL; nil for none.\n\
792The sentinel is called as a function when the process changes state.\n\
793It gets two arguments: the process, and a string describing the change.")
794 (proc, sentinel)
795 register Lisp_Object proc, sentinel;
796{
797 CHECK_PROCESS (proc, 0);
798 XPROCESS (proc)->sentinel = sentinel;
799 return sentinel;
800}
801
802DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
803 1, 1, 0,
804 "Return the sentinel of PROCESS; nil if none.\n\
805See `set-process-sentinel' for more info on sentinels.")
806 (proc)
807 register Lisp_Object proc;
808{
809 CHECK_PROCESS (proc, 0);
810 return XPROCESS (proc)->sentinel;
811}
812
813DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
814 Sprocess_kill_without_query, 1, 2, 0,
815 "Say no query needed if PROCESS is running when Emacs is exited.\n\
816Optional second argument if non-nill says to require a query.\n\
817Value is t if a query was formerly required.")
818 (proc, value)
819 register Lisp_Object proc, value;
820{
821 Lisp_Object tem;
822
823 CHECK_PROCESS (proc, 0);
824 tem = XPROCESS (proc)->kill_without_query;
825 XPROCESS (proc)->kill_without_query = Fnull (value);
826
827 return Fnull (tem);
828}
829
830Lisp_Object
831list_processes_1 ()
832{
833 register Lisp_Object tail, tem;
834 Lisp_Object proc, minspace, tem1;
835 register struct buffer *old = current_buffer;
836 register struct Lisp_Process *p;
837 register int state;
838 char tembuf[80];
839
840 XFASTINT (minspace) = 1;
841
842 set_buffer_internal (XBUFFER (Vstandard_output));
843 Fbuffer_disable_undo (Vstandard_output);
844
845 current_buffer->truncate_lines = Qt;
846
847 write_string ("\
848Proc Status Buffer Command\n\
849---- ------ ------ -------\n", -1);
850
851 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
852 {
853 Lisp_Object symbol;
854
855 proc = Fcdr (Fcar (tail));
856 p = XPROCESS (proc);
857 if (NILP (p->childp))
858 continue;
859
860 Finsert (1, &p->name);
861 Findent_to (make_number (13), minspace);
862
863 if (!NILP (p->raw_status_low))
864 update_status (p);
865 symbol = p->status;
866 if (XTYPE (p->status) == Lisp_Cons)
867 symbol = XCONS (p->status)->car;
868
869
870 if (EQ (symbol, Qsignal))
871 {
872 Lisp_Object tem;
873 tem = Fcar (Fcdr (p->status));
874#ifdef VMS
875 if (XINT (tem) < NSIG)
876 write_string (sys_siglist [XINT (tem)], -1);
877 else
878#endif
879 Fprinc (symbol, Qnil);
880 }
881 else if (NETCONN_P (proc))
882 {
883 if (EQ (symbol, Qrun))
884 write_string ("open", -1);
885 else if (EQ (symbol, Qexit))
886 write_string ("closed", -1);
887 else
888 Fprinc (symbol, Qnil);
889 }
890 else
891 Fprinc (symbol, Qnil);
892
893 if (EQ (symbol, Qexit))
894 {
895 Lisp_Object tem;
896 tem = Fcar (Fcdr (p->status));
897 if (XFASTINT (tem))
898 {
899 sprintf (tembuf, " %d", XFASTINT (tem));
900 write_string (tembuf, -1);
901 }
902 }
903
904 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
905 remove_process (proc);
906
907 Findent_to (make_number (22), minspace);
908 if (NILP (p->buffer))
909 insert_string ("(none)");
910 else if (NILP (XBUFFER (p->buffer)->name))
911 insert_string ("(Killed)");
912 else
913 Finsert (1, &XBUFFER (p->buffer)->name);
914
915 Findent_to (make_number (37), minspace);
916
917 if (NETCONN_P (proc))
918 {
919 sprintf (tembuf, "(network stream connection to %s)\n",
920 XSTRING (p->childp)->data);
921 insert_string (tembuf);
922 }
923 else
924 {
925 tem = p->command;
926 while (1)
927 {
928 tem1 = Fcar (tem);
929 Finsert (1, &tem1);
930 tem = Fcdr (tem);
931 if (NILP (tem))
932 break;
933 insert_string (" ");
934 }
935 insert_string ("\n");
936 }
937 }
938 return Qnil;
939}
940
941DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
942 "Display a list of all processes.\n\
943\(Any processes listed as Exited or Signaled are actually eliminated\n\
944after the listing is made.)")
945 ()
946{
947 internal_with_output_to_temp_buffer ("*Process List*",
948 list_processes_1, Qnil);
949 return Qnil;
950}
951
952DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
953 "Return a list of all processes.")
954 ()
955{
956 return Fmapcar (Qcdr, Vprocess_alist);
957}
958
959DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
960 "Start a program in a subprocess. Return the process object for it.\n\
961Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
962NAME is name for process. It is modified if necessary to make it unique.\n\
963BUFFER is the buffer or (buffer-name) to associate with the process.\n\
964 Process output goes at end of that buffer, unless you specify\n\
965 an output stream or filter function to handle the output.\n\
966 BUFFER may be also nil, meaning that this process is not associated\n\
967 with any buffer\n\
968Third arg is program file name. It is searched for as in the shell.\n\
969Remaining arguments are strings to give program as arguments.")
970 (nargs, args)
971 int nargs;
972 register Lisp_Object *args;
973{
974 Lisp_Object buffer, name, program, proc, tem;
975#ifdef VMS
976 register unsigned char *new_argv;
977 int len;
978#else
979 register unsigned char **new_argv;
980#endif
981 register int i;
982
983 buffer = args[1];
984 if (!NILP (buffer))
985 buffer = Fget_buffer_create (buffer);
986
987 name = args[0];
988 CHECK_STRING (name, 0);
989
990 program = args[2];
991
992 CHECK_STRING (program, 2);
993
994#ifdef VMS
995 /* Make a one member argv with all args concatenated
996 together separated by a blank. */
997 len = XSTRING (program)->size + 2;
998 for (i = 3; i < nargs; i++)
999 {
1000 tem = args[i];
1001 CHECK_STRING (tem, i);
1002 len += XSTRING (tem)->size + 1; /* count the blank */
1003 }
1004 new_argv = (unsigned char *) alloca (len);
1005 strcpy (new_argv, XSTRING (program)->data);
1006 for (i = 3; i < nargs; i++)
1007 {
1008 tem = args[i];
1009 CHECK_STRING (tem, i);
1010 strcat (new_argv, " ");
1011 strcat (new_argv, XSTRING (tem)->data);
1012 }
1013#else /* not VMS */
1014 new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
1015
1016 for (i = 3; i < nargs; i++)
1017 {
1018 tem = args[i];
1019 CHECK_STRING (tem, i);
1020 new_argv[i - 2] = XSTRING (tem)->data;
1021 }
1022 new_argv[i - 2] = 0;
1023 new_argv[0] = XSTRING (program)->data;
1024
1025 /* If program file name is not absolute, search our path for it */
1026 if (new_argv[0][0] != '/')
1027 {
1028 tem = Qnil;
1029 openp (Vexec_path, program, "", &tem, 1);
1030 if (NILP (tem))
1031 report_file_error ("Searching for program", Fcons (program, Qnil));
1032 new_argv[0] = XSTRING (tem)->data;
1033 }
1034#endif /* not VMS */
1035
1036 proc = make_process (name);
1037
1038 XPROCESS (proc)->childp = Qt;
1039 XPROCESS (proc)->command_channel_p = Qnil;
1040 XPROCESS (proc)->buffer = buffer;
1041 XPROCESS (proc)->sentinel = Qnil;
1042 XPROCESS (proc)->filter = Qnil;
1043 XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
1044
1045 create_process (proc, new_argv);
1046
1047 return proc;
1048}
1049
1050SIGTYPE
1051create_process_1 (signo)
1052 int signo;
1053{
1054#ifdef USG
1055 /* USG systems forget handlers when they are used;
1056 must reestablish each time */
1057 signal (signo, create_process_1);
1058#endif /* USG */
1059}
1060
1061#if 0 /* This doesn't work; see the note before sigchld_handler. */
1062#ifdef USG
1063#ifdef SIGCHLD
1064/* Mimic blocking of signals on system V, which doesn't really have it. */
1065
1066/* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
1067int sigchld_deferred;
1068
1069SIGTYPE
1070create_process_sigchld ()
1071{
1072 signal (SIGCHLD, create_process_sigchld);
1073
1074 sigchld_deferred = 1;
1075}
1076#endif
1077#endif
1078#endif
1079
1080#ifndef VMS /* VMS version of this function is in vmsproc.c. */
1081create_process (process, new_argv)
1082 Lisp_Object process;
1083 char **new_argv;
1084{
1085 int pid, inchannel, outchannel, forkin, forkout;
1086 int sv[2];
1087#ifdef SIGCHLD
1088 SIGTYPE (*sigchld)();
1089#endif
1090 int pty_flag = 0;
1091 Lisp_Object current_dir;
1092 char **env;
1093 extern char **environ;
1094
1095 env = environ;
1096
1097 inchannel = outchannel = -1;
1098
1099#ifdef HAVE_PTYS
1100 if (EQ (Vprocess_connection_type, Qt))
1101 outchannel = inchannel = allocate_pty ();
1102
1103 /* Make sure that the child will be able to chdir to the current
1104 buffer's current directory. We can't just have the child check
1105 for an error when it does the chdir, since it's in a vfork. */
1106 current_dir = expand_and_dir_to_file (current_buffer->directory, Qnil);
1107 if (NILP (Ffile_accessible_directory_p (current_dir)))
1108 report_file_error ("Setting current directory",
1109 Fcons (current_buffer->directory, Qnil));
1110
1111 if (inchannel >= 0)
1112 {
1113#ifndef USG
1114 /* On USG systems it does not work to open the pty's tty here
1115 and then close and reopen it in the child. */
1116#ifdef O_NOCTTY
1117 /* Don't let this terminal become our controlling terminal
1118 (in case we don't have one). */
1119 forkout = forkin = open (pty_name, O_RDWR | O_NOCTTY, 0);
1120#else
1121 forkout = forkin = open (pty_name, O_RDWR, 0);
1122#endif
1123 if (forkin < 0)
1124 report_file_error ("Opening pty", Qnil);
1125#else
1126 forkin = forkout = -1;
1127#endif /* not USG */
1128 pty_flag = 1;
1129 }
1130 else
1131#endif /* HAVE_PTYS */
1132#ifdef SKTPAIR
1133 {
1134 if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
1135 report_file_error ("Opening socketpair", Qnil);
1136 outchannel = inchannel = sv[0];
1137 forkout = forkin = sv[1];
1138 }
1139#else /* not SKTPAIR */
1140 {
1141 pipe (sv);
1142 inchannel = sv[0];
1143 forkout = sv[1];
1144 pipe (sv);
1145 outchannel = sv[1];
1146 forkin = sv[0];
1147 }
1148#endif /* not SKTPAIR */
1149
1150#if 0
1151 /* Replaced by close_process_descs */
1152 set_exclusive_use (inchannel);
1153 set_exclusive_use (outchannel);
1154#endif
1155
1156/* Stride people say it's a mystery why this is needed
1157 as well as the O_NDELAY, but that it fails without this. */
1158#if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
1159 {
1160 int one = 1;
1161 ioctl (inchannel, FIONBIO, &one);
1162 }
1163#endif
1164
1165#ifdef O_NONBLOCK
1166 fcntl (inchannel, F_SETFL, O_NONBLOCK);
1167#else
1168#ifdef O_NDELAY
1169 fcntl (inchannel, F_SETFL, O_NDELAY);
1170#endif
1171#endif
1172
1173 /* Record this as an active process, with its channels.
1174 As a result, child_setup will close Emacs's side of the pipes. */
1175 chan_process[inchannel] = process;
1176 XFASTINT (XPROCESS (process)->infd) = inchannel;
1177 XFASTINT (XPROCESS (process)->outfd) = outchannel;
1178 /* Record the tty descriptor used in the subprocess. */
1179 if (forkin < 0)
1180 XPROCESS (process)->subtty = Qnil;
1181 else
1182 XFASTINT (XPROCESS (process)->subtty) = forkin;
1183 XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
1184 XPROCESS (process)->status = Qrun;
1185
1186 /* Delay interrupts until we have a chance to store
1187 the new fork's pid in its process structure */
1188#ifdef SIGCHLD
1189#ifdef BSD4_1
1190 sighold (SIGCHLD);
1191#else /* not BSD4_1 */
1192#if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1193 sigsetmask (sigmask (SIGCHLD));
1194#else /* ordinary USG */
1195#if 0
1196 sigchld_deferred = 0;
1197 sigchld = signal (SIGCHLD, create_process_sigchld);
1198#endif
1199#endif /* ordinary USG */
1200#endif /* not BSD4_1 */
1201#endif /* SIGCHLD */
1202
1203 /* Until we store the proper pid, enable sigchld_handler
1204 to recognize an unknown pid as standing for this process.
1205 It is very important not to let this `marker' value stay
1206 in the table after this function has returned; if it does
1207 it might cause call-process to hang and subsequent asynchronous
1208 processes to get their return values scrambled. */
1209 XSETINT (XPROCESS (process)->pid, -1);
1210
1211 {
1212 /* child_setup must clobber environ on systems with true vfork.
1213 Protect it from permanent change. */
1214 char **save_environ = environ;
1215
1216 pid = vfork ();
1217 if (pid == 0)
1218 {
1219 int xforkin = forkin;
1220 int xforkout = forkout;
1221
1222#if 0 /* This was probably a mistake--it duplicates code later on,
1223 but fails to handle all the cases. */
1224 /* Make sure SIGCHLD is not blocked in the child. */
1225 sigsetmask (SIGEMPTYMASK);
1226#endif
1227
1228 /* Make the pty be the controlling terminal of the process. */
1229#ifdef HAVE_PTYS
1230 /* First, disconnect its current controlling terminal. */
1231#ifdef HAVE_SETSID
1232 setsid ();
1233#else /* not HAVE_SETSID */
1234#ifdef USG
1235 /* It's very important to call setpgrp() here and no time
1236 afterwards. Otherwise, we lose our controlling tty which
1237 is set when we open the pty. */
1238 setpgrp ();
1239#endif /* USG */
1240#endif /* not HAVE_SETSID */
1241#ifdef TIOCNOTTY
1242 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1243 can do TIOCSPGRP only to the process's controlling tty. */
1244 if (pty_flag)
1245 {
1246 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1247 I can't test it since I don't have 4.3. */
1248 int j = open ("/dev/tty", O_RDWR, 0);
1249 ioctl (j, TIOCNOTTY, 0);
1250 close (j);
1251#ifndef USG
1252 /* In order to get a controlling terminal on some versions
1253 of BSD, it is necessary to put the process in pgrp 0
1254 before it opens the terminal. */
1255 setpgrp (0, 0);
1256#endif
1257 }
1258#endif /* TIOCNOTTY */
1259
1260#if !defined (RTU) && !defined (UNIPLUS)
1261/*** There is a suggestion that this ought to be a
1262 conditional on TIOCSPGRP. */
1263 /* Now close the pty (if we had it open) and reopen it.
1264 This makes the pty the controlling terminal of the subprocess. */
1265 if (pty_flag)
1266 {
1267 /* I wonder if close (open (pty_name, ...)) would work? */
1268 if (xforkin >= 0)
1269 close (xforkin);
1270 xforkout = xforkin = open (pty_name, O_RDWR, 0);
1271
1272 if (xforkin < 0)
1273 abort ();
1274 }
1275#endif /* not UNIPLUS and not RTU */
1276#ifdef SETUP_SLAVE_PTY
1277 SETUP_SLAVE_PTY;
1278#endif /* SETUP_SLAVE_PTY */
1279#ifdef AIX
1280 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1281 Now reenable it in the child, so it will die when we want it to. */
1282 if (pty_flag)
1283 signal (SIGHUP, SIG_DFL);
1284#endif
1285#endif /* HAVE_PTYS */
1286
1287#ifdef SIGCHLD
1288#ifdef BSD4_1
1289 sigrelse (SIGCHLD);
1290#else /* not BSD4_1 */
1291#if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1292 sigsetmask (SIGEMPTYMASK);
1293#else /* ordinary USG */
1294 signal (SIGCHLD, sigchld);
1295#endif /* ordinary USG */
1296#endif /* not BSD4_1 */
1297#endif /* SIGCHLD */
1298
1299 child_setup_tty (xforkout);
1300 child_setup (xforkin, xforkout, xforkout,
1301 new_argv, env, 1, current_dir);
1302 }
1303 environ = save_environ;
1304 }
1305
1306 if (pid < 0)
1307 {
1308 remove_process (process);
1309 report_file_error ("Doing vfork", Qnil);
1310 }
1311
1312 XFASTINT (XPROCESS (process)->pid) = pid;
1313
1314 FD_SET (inchannel, &input_wait_mask);
1315
1316 /* If the subfork execv fails, and it exits,
1317 this close hangs. I don't know why.
1318 So have an interrupt jar it loose. */
1319 stop_polling ();
1320 signal (SIGALRM, create_process_1);
1321 alarm (1);
1322#ifdef SYSV4_PTYS
1323 /* OK to close only if it's not a pty. Otherwise we need to leave
1324 it open for ioctl to get pgrp when signals are sent, or to send
1325 the interrupt characters through if that's how we're signalling
1326 subprocesses. Alternately if you are concerned about running out
1327 of file descriptors, you could just save the tty name and open
1328 just to do the ioctl. */
1329 if (NILP (XFASTINT (XPROCESS (process)->pty_flag)))
1330#endif
1331 {
1332 XPROCESS (process)->subtty = Qnil;
1333 if (forkin >= 0)
1334 close (forkin);
1335 }
1336 alarm (0);
1337 start_polling ();
1338 if (forkin != forkout && forkout >= 0)
1339 close (forkout);
1340
1341#ifdef SIGCHLD
1342#ifdef BSD4_1
1343 sigrelse (SIGCHLD);
1344#else /* not BSD4_1 */
1345#if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
1346 sigsetmask (SIGEMPTYMASK);
1347#else /* ordinary USG */
1348#if 0
1349 signal (SIGCHLD, sigchld);
1350 /* Now really handle any of these signals
1351 that came in during this function. */
1352 if (sigchld_deferred)
1353 kill (getpid (), SIGCHLD);
1354#endif
1355#endif /* ordinary USG */
1356#endif /* not BSD4_1 */
1357#endif /* SIGCHLD */
1358}
1359#endif /* not VMS */
1360
1361#ifdef HAVE_SOCKETS
1362
1363/* open a TCP network connection to a given HOST/SERVICE. Treated
1364 exactly like a normal process when reading and writing. Only
1365 differences are in status display and process deletion. A network
1366 connection has no PID; you cannot signal it. All you can do is
1367 deactivate and close it via delete-process */
1368
1369DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
1370 4, 4, 0,
1371 "Open a TCP connection for a service to a host.\n\
1372Returns a subprocess-object to represent the connection.\n\
1373Input and output work as for subprocesses; `delete-process' closes it.\n\
1374Args are NAME BUFFER HOST SERVICE.\n\
1375NAME is name for process. It is modified if necessary to make it unique.\n\
1376BUFFER is the buffer (or buffer-name) to associate with the process.\n\
1377 Process output goes at end of that buffer, unless you specify\n\
1378 an output stream or filter function to handle the output.\n\
1379 BUFFER may be also nil, meaning that this process is not associated\n\
1380 with any buffer\n\
1381Third arg is name of the host to connect to, or its IP address.\n\
1382Fourth arg SERVICE is name of the service desired, or an integer\n\
1383 specifying a port number to connect to.")
1384 (name, buffer, host, service)
1385 Lisp_Object name, buffer, host, service;
1386{
1387 Lisp_Object proc;
1388 register int i;
1389 struct sockaddr_in address;
1390 struct servent *svc_info;
1391 struct hostent *host_info_ptr, host_info;
1392 char *(addr_list[2]);
1393 unsigned long numeric_addr;
1394 int s, outch, inch;
1395 char errstring[80];
1396 int port;
1397 struct hostent host_info_fixed;
1398 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1399
1400 GCPRO4 (name, buffer, host, service);
1401 CHECK_STRING (name, 0);
1402 CHECK_STRING (host, 0);
1403 if (XTYPE(service) == Lisp_Int)
1404 port = htons ((unsigned short) XINT (service));
1405 else
1406 {
1407 CHECK_STRING (service, 0);
1408 svc_info = getservbyname (XSTRING (service)->data, "tcp");
1409 if (svc_info == 0)
1410 error ("Unknown service \"%s\"", XSTRING (service)->data);
1411 port = svc_info->s_port;
1412 }
1413
1414 host_info_ptr = gethostbyname (XSTRING (host)->data);
1415 if (host_info_ptr == 0)
1416 /* Attempt to interpret host as numeric inet address */
1417 {
1418 numeric_addr = inet_addr (XSTRING (host)->data);
1419 if (numeric_addr == -1)
1420 error ("Unknown host \"%s\"", XSTRING (host)->data);
1421
1422 host_info_ptr = &host_info;
1423 host_info.h_name = 0;
1424 host_info.h_aliases = 0;
1425 host_info.h_addrtype = AF_INET;
1426 host_info.h_addr_list = &(addr_list[0]);
1427 addr_list[0] = (char*)(&numeric_addr);
1428 addr_list[1] = 0;
1429 host_info.h_length = strlen (addr_list[0]);
1430 }
1431
1432 bzero (&address, sizeof address);
1433 bcopy (host_info_ptr->h_addr, (char *) &address.sin_addr,
1434 host_info_ptr->h_length);
1435 address.sin_family = host_info_ptr->h_addrtype;
1436 address.sin_port = port;
1437
1438 s = socket (host_info_ptr->h_addrtype, SOCK_STREAM, 0);
1439 if (s < 0)
1440 report_file_error ("error creating socket", Fcons (name, Qnil));
1441
1442 loop:
1443 if (connect (s, &address, sizeof address) == -1)
1444 {
1445 int xerrno = errno;
1446 if (errno == EINTR)
1447 goto loop;
1448 close (s);
1449 errno = xerrno;
1450 report_file_error ("connection failed",
1451 Fcons (host, Fcons (name, Qnil)));
1452 }
1453
1454 inch = s;
1455 outch = dup (s);
1456 if (outch < 0)
1457 report_file_error ("error duplicating socket", Fcons (name, Qnil));
1458
1459 if (!NILP (buffer))
1460 buffer = Fget_buffer_create (buffer);
1461 proc = make_process (name);
1462
1463 chan_process[inch] = proc;
1464
1465#ifdef O_NONBLOCK
1466 fcntl (inch, F_SETFL, O_NONBLOCK);
1467#else
1468#ifdef O_NDELAY
1469 fcntl (inch, F_SETFL, O_NDELAY);
1470#endif
1471#endif
1472
1473 XPROCESS (proc)->childp = host;
1474 XPROCESS (proc)->command_channel_p = Qnil;
1475 XPROCESS (proc)->buffer = buffer;
1476 XPROCESS (proc)->sentinel = Qnil;
1477 XPROCESS (proc)->filter = Qnil;
1478 XPROCESS (proc)->command = Qnil;
1479 XPROCESS (proc)->pid = Qnil;
1480 XFASTINT (XPROCESS (proc)->infd) = s;
1481 XFASTINT (XPROCESS (proc)->outfd) = outch;
1482 XPROCESS (proc)->status = Qrun;
1483 FD_SET (inch, &input_wait_mask);
1484
1485 UNGCPRO;
1486 return proc;
1487}
1488#endif /* HAVE_SOCKETS */
1489
1490deactivate_process (proc)
1491 Lisp_Object proc;
1492{
1493 register int inchannel, outchannel;
1494 register struct Lisp_Process *p = XPROCESS (proc);
1495
1496 inchannel = XFASTINT (p->infd);
1497 outchannel = XFASTINT (p->outfd);
1498
1499 if (inchannel)
1500 {
1501 /* Beware SIGCHLD hereabouts. */
1502 flush_pending_output (inchannel);
1503#ifdef VMS
1504 {
1505 VMS_PROC_STUFF *get_vms_process_pointer (), *vs;
1506 sys$dassgn (outchannel);
1507 vs = get_vms_process_pointer (p->pid)
1508 if (vs)
1509 give_back_vms_process_stuff (vs);
1510 }
1511#else
1512 close (inchannel);
1513 if (outchannel && outchannel != inchannel)
1514 close (outchannel);
1515#endif
1516
1517 XFASTINT (p->infd) = 0;
1518 XFASTINT (p->outfd) = 0;
1519 chan_process[inchannel] = Qnil;
1520 FD_CLR (inchannel, &input_wait_mask);
1521 }
1522}
1523
1524/* Close all descriptors currently in use for communication
1525 with subprocess. This is used in a newly-forked subprocess
1526 to get rid of irrelevant descriptors. */
1527
1528close_process_descs ()
1529{
1530 int i;
1531 for (i = 0; i < MAXDESC; i++)
1532 {
1533 Lisp_Object process;
1534 process = chan_process[i];
1535 if (!NILP (process))
1536 {
1537 int in = XFASTINT (XPROCESS (process)->infd);
1538 int out = XFASTINT (XPROCESS (process)->outfd);
1539 if (in)
1540 close (in);
1541 if (out && in != out)
1542 close (out);
1543 }
1544 }
1545}
1546
1547DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
1548 0, 3, 0,
1549 "Allow any pending output from subprocesses to be read by Emacs.\n\
1550It is read into the process' buffers or given to their filter functions.\n\
1551Non-nil arg PROCESS means do not return until some output has been received\n\
1552from PROCESS.\n\
1553Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\
1554seconds and microseconds to wait; return after that much time whether\n\
1555or not there is input.\n\
1556Return non-nil iff we received any output before the timeout expired.")
1557 (proc, timeout, timeout_msecs)
1558 register Lisp_Object proc, timeout, timeout_msecs;
1559{
1560 int seconds;
1561 int useconds;
1562
1563 if (! NILP (timeout_msecs))
1564 {
1565 CHECK_NUMBER (timeout_msecs, 2);
1566 useconds = XINT (timeout_msecs);
1567 if (XTYPE (timeout) != Lisp_Int)
1568 XSET (timeout, Lisp_Int, 0);
1569
1570 {
1571 int carry = useconds / 1000000;
1572
1573 XSETINT (timeout, XINT (timeout) + carry);
1574 useconds -= carry * 1000000;
1575
1576 /* I think this clause is necessary because C doesn't
1577 guarantee a particular rounding direction for negative
1578 integers. */
1579 if (useconds < 0)
1580 {
1581 XSETINT (timeout, XINT (timeout) - 1);
1582 useconds += 1000000;
1583 }
1584 }
1585 }
1586
1587 if (! NILP (timeout))
1588 {
1589 CHECK_NUMBER (timeout, 1);
1590 seconds = XINT (timeout);
1591 if (seconds <= 0)
1592 seconds = -1;
1593 }
1594 else
1595 {
1596 if (NILP (proc))
1597 seconds = -1;
1598 else
1599 seconds = 0;
1600 }
1601
1602 return
1603 (wait_reading_process_input (seconds, useconds,
1604 (NILP (proc)
1605 ? XPROCESS (get_process (proc)) : 0), 0)
1606 ? Qt : Qnil);
1607}
1608
1609/* This variable is different from waiting_for_input in keyboard.c.
1610 It is used to communicate to a lisp process-filter/sentinel (via the
1611 function Fwaiting_for_user_input_p below) whether emacs was waiting
1612 for user-input when that process-filter was called.
1613 waiting_for_input cannot be used as that is by definition 0 when
1614 lisp code is being evalled */
1615static int waiting_for_user_input_p;
1616
1617/* Read and dispose of subprocess output while waiting for timeout to
1618 elapse and/or keyboard input to be available.
1619
1620 time_limit is:
1621 timeout in seconds, or
1622 zero for no limit, or
1623 -1 means gobble data immediately available but don't wait for any.
1624
1625 read_kbd is:
1626 0 to ignore keyboard input, or
1627 1 to return when input is available, or
1628 -1 means caller will actually read the input, so don't throw to
1629 the quit handler, or
1630 a pointer to a struct Lisp_Process, meaning wait until something
1631 arrives from that process. The return value is true iff we read
1632 some input from that process.
1633
1634 do_display != 0 means redisplay should be done to show subprocess
1635 output that arrives.
1636
1637 If read_kbd is a pointer to a struct Lisp_Process, then the
1638 function returns true iff we received input from that process
1639 before the timeout elapsed.
1640 Otherwise, return true iff we recieved input from any process. */
1641
1642wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
1643 int time_limit, microsecs, read_kbd, do_display;
1644{
1645 register int channel, nfds, m;
1646 static SELECT_TYPE Available;
1647 int xerrno;
1648 Lisp_Object proc;
1649 EMACS_TIME timeout, end_time, garbage;
1650 SELECT_TYPE Atemp;
1651 int wait_channel = 0;
1652 struct Lisp_Process *wait_proc = 0;
1653 int got_some_input = 0;
1654
1655 FD_ZERO (&Available);
1656
1657 /* Detect when read_kbd is really the address of a Lisp_Process. */
1658 if (read_kbd > 10 || read_kbd < -1)
1659 {
1660 wait_proc = (struct Lisp_Process *) read_kbd;
1661 wait_channel = XFASTINT (wait_proc->infd);
1662 read_kbd = 0;
1663 }
1664
1665 waiting_for_user_input_p = read_kbd;
1666
1667 /* Since we may need to wait several times,
1668 compute the absolute time to return at. */
1669 if (time_limit || microsecs)
1670 {
1671 EMACS_GET_TIME (end_time);
1672 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
1673 EMACS_ADD_TIME (end_time, end_time, timeout);
1674 }
1675
1676 /* Turn off periodic alarms (in case they are in use)
1677 because the select emulator uses alarms. */
1678 stop_polling ();
1679
1680 while (1)
1681 {
1682 /* If calling from keyboard input, do not quit
1683 since we want to return C-g as an input character.
1684 Otherwise, do pending quit if requested. */
1685 if (read_kbd >= 0)
1686 QUIT;
1687
1688 /* If status of something has changed, and no input is available,
1689 notify the user of the change right away */
1690 if (update_tick != process_tick && do_display)
1691 {
1692 Atemp = input_wait_mask;
1693 EMACS_SET_SECS_USECS (timeout, 0, 0);
1694 if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
1695 status_notify ();
1696 }
1697
1698 /* Don't wait for output from a non-running process. */
1699 if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
1700 update_status (wait_proc);
1701 if (wait_proc != 0
1702 && ! EQ (wait_proc->status, Qrun))
1703 break;
1704
1705 /* Compute time from now till when time limit is up */
1706 /* Exit if already run out */
1707 if (time_limit == -1)
1708 {
1709 /* -1 specified for timeout means
1710 gobble output available now
1711 but don't wait at all. */
1712
1713 EMACS_SET_SECS_USECS (timeout, 0, 0);
1714 }
1715 else if (time_limit || microsecs)
1716 {
1717 EMACS_GET_TIME (timeout);
1718 EMACS_SUB_TIME (timeout, end_time, timeout);
1719 if (EMACS_TIME_NEG_P (timeout))
1720 break;
1721 }
1722 else
1723 {
1724 EMACS_SET_SECS_USECS (timeout, 100000, 0);
1725 }
1726
1727 /* Cause C-g and alarm signals to take immediate action,
1728 and cause input available signals to zero out timeout */
1729 if (read_kbd < 0)
1730 set_waiting_for_input (&timeout);
1731
1732 /* Wait till there is something to do */
1733
1734 Available = input_wait_mask;
1735 if (!read_kbd)
1736 FD_CLR (0, &Available);
1737
1738 /* If a screen has been newly mapped and needs updating,
1739 reprocess its display stuff. */
1740 if (screen_garbaged)
1741 redisplay_preserve_echo_area ();
1742
1743 if (read_kbd && detect_input_pending ())
1744 nfds = 0;
1745 else
1746#ifdef AIX
1747 nfds = select (MAXDESC, &Available, 0, 0, &timeout);
1748#else
1749#ifdef HPUX
1750 nfds = select (MAXDESC, &Available, 0, 0, &timeout);
1751#else
1752 nfds = select (MAXDESC, &Available, 0, 0, &timeout);
1753#endif
1754#endif
1755 xerrno = errno;
1756
1757 /* Make C-g and alarm signals set flags again */
1758 clear_waiting_for_input ();
1759
1760 /* If we woke up due to SIGWINCH, actually change size now. */
1761 do_pending_window_change ();
1762
1763 if (time_limit && nfds == 0) /* timeout elapsed */
1764 break;
1765 if (nfds < 0)
1766 {
1767 if (xerrno == EINTR)
1768 FD_ZERO (&Available);
1769#ifdef ALLIANT
1770 /* This happens for no known reason on ALLIANT.
1771 I am guessing that this is the right response. -- RMS. */
1772 else if (xerrno == EFAULT)
1773 FD_ZERO (&Available);
1774#endif
1775 else if (xerrno == EBADF)
1776 {
1777#ifdef AIX
1778 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
1779 the child's closure of the pts gives the parent a SIGHUP, and
1780 the ptc file descriptor is automatically closed,
1781 yielding EBADF here or at select() call above.
1782 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
1783 in m-ibmrt-aix.h), and here we just ignore the select error.
1784 Cleanup occurs c/o status_notify after SIGCLD. */
1785 FD_ZERO (&Available); /* Cannot depend on values returned */
1786#else
1787 abort ();
1788#endif
1789 }
1790 else
1791 error("select error: %s", sys_errlist[xerrno]);
1792 }
1793#ifdef sun
1794 else if (nfds > 0 && FD_ISSET (0, &Available) && interrupt_input)
1795 /* System sometimes fails to deliver SIGIO. */
1796 kill (getpid (), SIGIO);
1797#endif
1798
1799 /* Check for keyboard input */
1800 /* If there is any, return immediately
1801 to give it higher priority than subprocesses */
1802
1803 if (read_kbd && detect_input_pending ())
1804 break;
1805
1806 /* If we think we have keyboard input waiting, but didn't get SIGIO
1807 go read it. This can happen with X on BSD after logging out.
1808 In that case, there really is no input and no SIGIO,
1809 but select says there is input. */
1810
1811 /*
1812 if (read_kbd && interrupt_input && (Available & fileno (stdin)))
1813 */
1814 if (read_kbd && interrupt_input && (FD_ISSET (fileno (stdin), &Available)))
1815 kill (0, SIGIO);
1816
1817#ifdef vipc
1818 /* Check for connection from other process */
1819
1820 if (Available & ChannelMask (comm_server))
1821 {
1822 Available &= ~(ChannelMask (comm_server));
1823 create_commchan ();
1824 }
1825#endif vipc
1826
1827 if (! wait_proc)
1828 got_some_input |= nfds > 0;
1829
1830 /* Check for data from a process or a command channel */
1831 for (channel = FIRST_PROC_DESC; channel < MAXDESC; channel++)
1832 {
1833 if (FD_ISSET (channel, &Available))
1834 {
1835 int nread;
1836
1837 /* If waiting for this channel, arrange to return as
1838 soon as no more input to be processed. No more
1839 waiting. */
1840 if (wait_channel == channel)
1841 {
1842 wait_channel = 0;
1843 time_limit = -1;
1844 got_some_input = 1;
1845 }
1846 proc = chan_process[channel];
1847 if (NILP (proc))
1848 continue;
1849
1850#ifdef vipc
1851 /* It's a command channel */
1852 if (!NILP (XPROCESS (proc)->command_channel_p))
1853 {
1854 ProcessCommChan (channel, proc);
1855 if (NILP (XPROCESS (proc)->command_channel_p))
1856 {
1857 /* It has ceased to be a command channel! */
1858 int bytes_available;
1859 if (ioctl (channel, FIONREAD, &bytes_available) < 0)
1860 bytes_available = 0;
1861 if (bytes_available)
1862 FD_SET (channel, &Available);
1863 }
1864 continue;
1865 }
1866#endif /* vipc */
1867
1868 /* Read data from the process, starting with our
1869 buffered-ahead character if we have one. */
1870
1871 nread = read_process_output (proc, channel);
1872 if (nread > 0)
1873 {
1874 /* Since read_process_output can run a filter,
1875 which can call accept-process-output,
1876 don't try to read from any other processes
1877 before doing the select again. */
1878 FD_ZERO (&Available);
1879
1880 if (do_display)
1881 redisplay_preserve_echo_area ();
1882 }
1883#ifdef EWOULDBLOCK
1884 else if (nread == -1 && errno == EWOULDBLOCK)
1885 ;
1886#else
1887#ifdef O_NONBLOCK
1888 else if (nread == -1 && errno == EAGAIN)
1889 ;
1890#else
1891#ifdef O_NDELAY
1892 else if (nread == -1 && errno == EAGAIN)
1893 ;
1894 /* Note that we cannot distinguish between no input
1895 available now and a closed pipe.
1896 With luck, a closed pipe will be accompanied by
1897 subprocess termination and SIGCHLD. */
1898 else if (nread == 0 && !NETCONN_P (proc))
1899 ;
1900#endif /* O_NDELAY */
1901#endif /* O_NONBLOCK */
1902#endif /* EWOULDBLOCK */
1903#ifdef HAVE_PTYS
1904 /* On some OSs with ptys, when the process on one end of
1905 a pty exits, the other end gets an error reading with
1906 errno = EIO instead of getting an EOF (0 bytes read).
1907 Therefore, if we get an error reading and errno =
1908 EIO, just continue, because the child process has
1909 exited and should clean itself up soon (e.g. when we
1910 get a SIGCHLD). */
1911 else if (nread == -1 && errno == EIO)
1912 ;
1913#endif /* HAVE_PTYS */
1914/* If we can detect process termination, don't consider the process
1915 gone just because its pipe is closed. */
1916#ifdef SIGCHLD
1917 else if (nread == 0 && !NETCONN_P (proc))
1918 ;
1919#endif
1920 else
1921 {
1922 /* Preserve status of processes already terminated. */
1923 XSETINT (XPROCESS (proc)->tick, ++process_tick);
1924 deactivate_process (proc);
1925 if (!NILP (XPROCESS (proc)->raw_status_low))
1926 update_status (XPROCESS (proc));
1927 if (EQ (XPROCESS (proc)->status, Qrun))
1928 XPROCESS (proc)->status
1929 = Fcons (Qexit, Fcons (make_number (256), Qnil));
1930 }
1931 }
1932 } /* end for each file descriptor */
1933 } /* end while exit conditions not met */
1934
1935 /* Resume periodic signals to poll for input, if necessary. */
1936 start_polling ();
1937
1938 return got_some_input;
1939}
1940
1941/* Read pending output from the process channel,
1942 starting with our buffered-ahead character if we have one.
1943 Yield number of characters read.
1944
1945 This function reads at most 1024 characters.
1946 If you want to read all available subprocess output,
1947 you must call it repeatedly until it returns zero. */
1948
1949read_process_output (proc, channel)
1950 Lisp_Object proc;
1951 register int channel;
1952{
1953 register int nchars;
1954#ifdef VMS
1955 char *chars;
1956#else
1957 char chars[1024];
1958#endif
1959 register Lisp_Object outstream;
1960 register struct buffer *old = current_buffer;
1961 register struct Lisp_Process *p = XPROCESS (proc);
1962 register int opoint;
1963
1964#ifdef VMS
1965 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
1966
1967 vs = get_vms_process_pointer (p->pid);
1968 if (vs)
1969 {
1970 if (!vs->iosb[0])
1971 return(0); /* Really weird if it does this */
1972 if (!(vs->iosb[0] & 1))
1973 return -1; /* I/O error */
1974 }
1975 else
1976 error ("Could not get VMS process pointer");
1977 chars = vs->inputBuffer;
1978 nchars = clean_vms_buffer (chars, vs->iosb[1]);
1979 if (nchars <= 0)
1980 {
1981 start_vms_process_read (vs); /* Crank up the next read on the process */
1982 return 1; /* Nothing worth printing, say we got 1 */
1983 }
1984#else /* not VMS */
1985
1986 if (proc_buffered_char[channel] < 0)
1987 nchars = read (channel, chars, sizeof chars);
1988 else
1989 {
1990 chars[0] = proc_buffered_char[channel];
1991 proc_buffered_char[channel] = -1;
1992 nchars = read (channel, chars + 1, sizeof chars - 1);
1993 if (nchars < 0)
1994 nchars = 1;
1995 else
1996 nchars = nchars + 1;
1997 }
1998#endif /* not VMS */
1999
2000 if (nchars <= 0) return nchars;
2001
2002 outstream = p->filter;
2003 if (!NILP (outstream))
2004 {
2005 /* We inhibit quit here instead of just catching it so that
2006 hitting ^G when a filter happens to be running won't screw
2007 it up. */
2008 int count = specpdl_ptr - specpdl;
2009 specbind (Qinhibit_quit, Qt);
2010 call2 (outstream, proc, make_string (chars, nchars));
2011
2012#ifdef VMS
2013 start_vms_process_read (vs);
2014#endif
2015 unbind_to (count);
2016 return nchars;
2017 }
2018
2019 /* If no filter, write into buffer if it isn't dead. */
2020 if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
2021 {
2022 Lisp_Object tem;
2023
2024 Fset_buffer (p->buffer);
2025 opoint = point;
2026
2027 /* Insert new output into buffer
2028 at the current end-of-output marker,
2029 thus preserving logical ordering of input and output. */
2030 if (XMARKER (p->mark)->buffer)
2031 SET_PT (marker_position (p->mark));
2032 else
2033 SET_PT (ZV);
2034 if (point <= opoint)
2035 opoint += nchars;
2036
2037 tem = current_buffer->read_only;
2038 current_buffer->read_only = Qnil;
2039 /* Insert before markers in case we are inserting where
2040 the buffer's mark is, and the user's next command is Meta-y. */
2041 insert_before_markers (chars, nchars);
2042 current_buffer->read_only = tem;
2043 Fset_marker (p->mark, make_number (point), p->buffer);
2044 update_mode_lines++;
2045
2046 SET_PT (opoint);
2047 set_buffer_internal (old);
2048 }
2049#ifdef VMS
2050 start_vms_process_read (vs);
2051#endif
2052 return nchars;
2053}
2054
2055DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
2056 0, 0, 0,
2057 "Returns non-NIL if emacs is waiting for input from the user.\n\
2058This is intended for use by asynchronous process output filters and sentinels.")
2059 ()
2060{
2061 return ((waiting_for_user_input_p) ? Qt : Qnil);
2062}
2063
2064/* Sending data to subprocess */
2065
2066jmp_buf send_process_frame;
2067
2068SIGTYPE
2069send_process_trap ()
2070{
2071#ifdef BSD4_1
2072 sigrelse (SIGPIPE);
2073 sigrelse (SIGALRM);
2074#endif /* BSD4_1 */
2075 longjmp (send_process_frame, 1);
2076}
2077
2078send_process (proc, buf, len)
2079 Lisp_Object proc;
2080 char *buf;
2081 int len;
2082{
2083 /* Don't use register vars; longjmp can lose them. */
2084 int rv;
2085 unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
2086
2087
2088#ifdef VMS
2089 struct Lisp_Process *p = XPROCESS (proc);
2090 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
2091#endif /* VMS */
2092
2093 if (! NILP (XPROCESS (proc)->raw_status_low))
2094 update_status (XPROCESS (proc));
2095 if (! EQ (XPROCESS (proc)->status, Qrun))
2096 error ("Process %s not running", procname);
2097
2098#ifdef VMS
2099 vs = get_vms_process_pointer (p->pid);
2100 if (vs == 0)
2101 error ("Could not find this process: %x", p->pid);
2102 else if (write_to_vms_process (vs, buf, len))
2103 ;
2104#else
2105 if (!setjmp (send_process_frame))
2106 while (len > 0)
2107 {
2108 int this = len;
2109 /* Don't send more than 500 bytes at a time. */
2110 if (this > 500)
2111 this = 500;
2112 signal (SIGPIPE, send_process_trap);
2113 rv = write (XFASTINT (XPROCESS (proc)->outfd), buf, this);
2114 signal (SIGPIPE, SIG_DFL);
2115 if (rv < 0)
2116 {
2117 if (0
2118#ifdef EWOULDBLOCK
2119 || errno == EWOULDBLOCK
2120#endif
2121#ifdef EAGAIN
2122 || errno == EAGAIN
2123#endif
2124 )
2125 {
2126 /* It would be nice to accept process output here,
2127 but that is difficult. For example, it could
2128 garbage what we are sending if that is from a buffer. */
2129 immediate_quit = 1;
2130 QUIT;
2131 sleep (1);
2132 immediate_quit = 0;
2133 continue;
2134 }
2135 report_file_error ("writing to process", Fcons (proc, Qnil));
2136 }
2137 buf += rv;
2138 len -= rv;
2139 /* Allow input from processes between bursts of sending.
2140 Otherwise things may get stopped up. */
2141 if (len > 0)
2142 wait_reading_process_input (-1, 0, 0, 0);
2143 }
2144#endif
2145 else
2146 {
2147 XPROCESS (proc)->raw_status_low = Qnil;
2148 XPROCESS (proc)->raw_status_high = Qnil;
2149 XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
2150 XSETINT (XPROCESS (proc)->tick, ++process_tick);
2151 deactivate_process (proc);
2152#ifdef VMS
2153 error ("Error writing to process %s; closed it", procname);
2154#else
2155 error ("SIGPIPE raised on process %s; closed it", procname);
2156#endif
2157 }
2158}
2159
2160DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
2161 3, 3, 0,
2162 "Send current contents of region as input to PROCESS.\n\
2163PROCESS may be a process name or an actual process.\n\
2164Called from program, takes three arguments, PROCESS, START and END.\n\
2165If the region is more than 500 characters long,\n\
2166it is sent in several bunches. This may happen even for shorter regions.\n\
2167Output from processes can arrive in between bunches.")
2168 (process, start, end)
2169 Lisp_Object process, start, end;
2170{
2171 Lisp_Object proc;
2172 int start1;
2173
2174 proc = get_process (process);
2175 validate_region (&start, &end);
2176
2177 if (XINT (start) < GPT && XINT (end) > GPT)
2178 move_gap (start);
2179
2180 start1 = XINT (start);
2181 send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start));
2182
2183 return Qnil;
2184}
2185
2186DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
2187 2, 2, 0,
2188 "Send PROCESS the contents of STRING as input.\n\
2189PROCESS may be a process name or an actual process.\n\
2190If STRING is more than 500 characters long,\n\
2191it is sent in several bunches. This may happen even for shorter strings.\n\
2192Output from processes can arrive in between bunches.")
2193 (process, string)
2194 Lisp_Object process, string;
2195{
2196 Lisp_Object proc;
2197 CHECK_STRING (string, 1);
2198 proc = get_process (process);
2199 send_process (proc, XSTRING (string)->data, XSTRING (string)->size);
2200 return Qnil;
2201}
2202
2203/* send a signal number SIGNO to PROCESS.
2204 CURRENT_GROUP means send to the process group that currently owns
2205 the terminal being used to communicate with PROCESS.
2206 This is used for various commands in shell mode.
2207 If NOMSG is zero, insert signal-announcements into process's buffers
2208 right away. */
2209
2210process_send_signal (process, signo, current_group, nomsg)
2211 Lisp_Object process;
2212 int signo;
2213 Lisp_Object current_group;
2214 int nomsg;
2215{
2216 Lisp_Object proc;
2217 register struct Lisp_Process *p;
2218 int gid;
2219 int no_pgrp = 0;
2220
2221 proc = get_process (process);
2222 p = XPROCESS (proc);
2223
2224 if (!EQ (p->childp, Qt))
2225 error ("Process %s is not a subprocess",
2226 XSTRING (p->name)->data);
2227 if (!XFASTINT (p->infd))
2228 error ("Process %s is not active",
2229 XSTRING (p->name)->data);
2230
2231 if (NILP (p->pty_flag))
2232 current_group = Qnil;
2233
2234#ifdef TIOCGPGRP /* Not sure about this! (fnf) */
2235 /* If we are using pgrps, get a pgrp number and make it negative. */
2236 if (!NILP (current_group))
2237 {
2238 /* If possible, send signals to the entire pgrp
2239 by sending an input character to it. */
2240#if defined (TIOCGLTC) && defined (TIOCGETC)
2241 struct tchars c;
2242 struct ltchars lc;
2243
2244 switch (signo)
2245 {
2246 case SIGINT:
2247 ioctl (XFASTINT (p->infd), TIOCGETC, &c);
2248 send_process (proc, &c.t_intrc, 1);
2249 return Qnil;
2250 case SIGQUIT:
2251 ioctl (XFASTINT (p->infd), TIOCGETC, &c);
2252 send_process (proc, &c.t_quitc, 1);
2253 return Qnil;
2254 case SIGTSTP:
2255 ioctl (XFASTINT (p->infd), TIOCGLTC, &lc);
2256 send_process (proc, &lc.t_suspc, 1);
2257 return Qnil;
2258 }
2259#endif /* have TIOCGLTC and have TIOCGETC */
2260 /* It is possible that the following code would work
2261 on other kinds of USG systems, not just on the IRIS.
2262 This should be tried in Emacs 19. */
2263#if defined (IRIS) && defined (HAVE_SETSID) /* Check for Irix, not older
2264 systems. */
2265 struct termio t;
2266 switch (signo)
2267 {
2268 case SIGINT:
2269 ioctl (XFASTINT (p->infd), TCGETA, &t);
2270 send_process (proc, &t.c_cc[VINTR], 1);
2271 return Qnil;
2272 case SIGQUIT:
2273 ioctl (XFASTINT (p->infd), TCGETA, &t);
2274 send_process (proc, &t.c_cc[VQUIT], 1);
2275 return Qnil;
2276 case SIGTSTP:
2277 ioctl (XFASTINT (p->infd), TCGETA, &t);
2278 send_process (proc, &t.c_cc[VSWTCH], 1);
2279 return Qnil;
2280 }
2281#endif /* IRIS and HAVE_SETSID */
2282
2283 /* Get the pgrp using the tty itself, if we have that.
2284 Otherwise, use the pty to get the pgrp.
2285 On pfa systems, saka@pfu.fujitsu.co.JP writes:
2286 "TICGPGRP symbol defined in sys/ioctl.h at E50.
2287 But, TIOCGPGRP donot work on E50 ;-P work fine on E60"
2288 His patch indicates that if TIOCGPGRP returns an error, then
2289 we should just assume that p->pid is also the process group id. */
2290 {
2291 int err;
2292
2293 if (!NILP (p->subtty))
2294 err = ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
2295 else
2296 err = ioctl (XFASTINT (p->infd), TIOCGPGRP, &gid);
2297
2298#ifdef pfa
2299 if (err == -1)
2300 gid = - XFASTINT (p->pid);
2301#endif
2302 }
2303 if (gid == -1)
2304 no_pgrp = 1;
2305 else
2306 gid = - gid;
2307 }
2308 else
2309 gid = - XFASTINT (p->pid);
2310#else /* not using pgrps */
2311 /* Can't select pgrps on this system, so we know that
2312 the child itself heads the pgrp. */
2313 gid = - XFASTINT (p->pid);
2314#endif /* not using pgrps */
2315
2316 switch (signo)
2317 {
2318#ifdef SIGCONT
2319 case SIGCONT:
2320 p->raw_status_low = Qnil;
2321 p->raw_status_high = Qnil;
2322 p->status = Qrun;
2323 XSETINT (p->tick, ++process_tick);
2324 if (!nomsg)
2325 status_notify ();
2326 break;
2327#endif
2328 case SIGINT:
2329#ifdef VMS
2330 send_process (proc, "\003", 1); /* ^C */
2331 goto whoosh;
2332#endif
2333 case SIGQUIT:
2334#ifdef VMS
2335 send_process (proc, "\031", 1); /* ^Y */
2336 goto whoosh;
2337#endif
2338 case SIGKILL:
2339#ifdef VMS
2340 sys$forcex (&(XFASTINT (p->pid)), 0, 1);
2341 whoosh:
2342#endif
2343 flush_pending_output (XFASTINT (p->infd));
2344 break;
2345 }
2346
2347 /* If we don't have process groups, send the signal to the immediate
2348 subprocess. That isn't really right, but it's better than any
2349 obvious alternative. */
2350 if (no_pgrp)
2351 {
2352 kill (XFASTINT (p->pid), signo);
2353 return;
2354 }
2355
2356 /* gid may be a pid, or minus a pgrp's number */
2357#ifdef TIOCSIGSEND
2358 if (!NILP (current_group))
2359 ioctl (XFASTINT (p->infd), TIOCSIGSEND, signo);
2360 else
2361 {
2362 gid = - XFASTINT (p->pid);
2363 kill (gid, signo);
2364 }
2365#else /* no TIOCSIGSEND */
2366 EMACS_KILLPG (-gid, signo);
2367#endif
2368}
2369
2370DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
2371 "Interrupt process PROCESS. May be process or name of one.\n\
2372Nil or no arg means current buffer's process.\n\
2373Second arg CURRENT-GROUP non-nil means send signal to\n\
2374the current process-group of the process's controlling terminal\n\
2375rather than to the process's own process group.\n\
2376If the process is a shell, this means interrupt current subjob\n\
2377rather than the shell.")
2378 (process, current_group)
2379 Lisp_Object process, current_group;
2380{
2381 process_send_signal (process, SIGINT, current_group, 0);
2382 return process;
2383}
2384
2385DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
2386 "Kill process PROCESS. May be process or name of one.\n\
2387See function `interrupt-process' for more details on usage.")
2388 (process, current_group)
2389 Lisp_Object process, current_group;
2390{
2391 process_send_signal (process, SIGKILL, current_group, 0);
2392 return process;
2393}
2394
2395DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
2396 "Send QUIT signal to process PROCESS. May be process or name of one.\n\
2397See function `interrupt-process' for more details on usage.")
2398 (process, current_group)
2399 Lisp_Object process, current_group;
2400{
2401 process_send_signal (process, SIGQUIT, current_group, 0);
2402 return process;
2403}
2404
2405DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
2406 "Stop process PROCESS. May be process or name of one.\n\
2407See function `interrupt-process' for more details on usage.")
2408 (process, current_group)
2409 Lisp_Object process, current_group;
2410{
2411#ifndef SIGTSTP
2412 error ("no SIGTSTP support");
2413#else
2414 process_send_signal (process, SIGTSTP, current_group, 0);
2415#endif
2416 return process;
2417}
2418
2419DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
2420 "Continue process PROCESS. May be process or name of one.\n\
2421See function `interrupt-process' for more details on usage.")
2422 (process, current_group)
2423 Lisp_Object process, current_group;
2424{
2425#ifdef SIGCONT
2426 process_send_signal (process, SIGCONT, current_group, 0);
2427#else
2428 error ("no SIGCONT support");
2429#endif
2430 return process;
2431}
2432
2433DEFUN ("signal-process", Fsignal_process, Ssignal_process,
2434 2, 2, "nProcess number: \nnSignal code: ",
2435 "Send the process with number PID the signal with code CODE.\n\
2436Both PID and CODE are integers.")
2437 (pid, sig)
2438 Lisp_Object pid, sig;
2439{
2440 CHECK_NUMBER (pid, 0);
2441 CHECK_NUMBER (sig, 1);
2442 return make_number (kill (XINT (pid), XINT (sig)));
2443}
2444
2445DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
2446 "Make PROCESS see end-of-file in its input.\n\
2447Eof comes after any text already sent to it.\n\
2448nil or no arg means current buffer's process.")
2449 (process)
2450 Lisp_Object process;
2451{
2452 Lisp_Object proc;
2453
2454 proc = get_process (process);
2455 /* Sending a zero-length record is supposed to mean eof
2456 when TIOCREMOTE is turned on. */
2457#ifdef DID_REMOTE
2458 {
2459 char buf[1];
2460 write (XFASTINT (XPROCESS (proc)->outfd), buf, 0);
2461 }
2462#else /* did not do TOICREMOTE */
2463#ifdef VMS
2464 send_process (proc, "\032", 1); /* ^z */
2465#else
2466 if (!NILP (XPROCESS (proc)->pty_flag))
2467 send_process (proc, "\004", 1);
2468 else
2469 {
2470 close (XPROCESS (proc)->outfd);
2471 XFASTINT (XPROCESS (proc)->outfd) = open ("/dev/null", O_WRONLY);
2472 }
2473#endif /* VMS */
2474#endif /* did not do TOICREMOTE */
2475 return process;
2476}
2477
2478/* Kill all processes associated with `buffer'.
2479 If `buffer' is nil, kill all processes */
2480
2481kill_buffer_processes (buffer)
2482 Lisp_Object buffer;
2483{
2484 Lisp_Object tail, proc;
2485
2486 for (tail = Vprocess_alist; XGCTYPE (tail) == Lisp_Cons;
2487 tail = XCONS (tail)->cdr)
2488 {
2489 proc = XCONS (XCONS (tail)->car)->cdr;
2490 if (XGCTYPE (proc) == Lisp_Process
2491 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
2492 {
2493 if (NETCONN_P (proc))
2494 deactivate_process (proc);
2495 else if (XFASTINT (XPROCESS (proc)->infd))
2496 process_send_signal (proc, SIGHUP, Qnil, 1);
2497 }
2498 }
2499}
2500
2501/* On receipt of a signal that a child status has changed,
2502 loop asking about children with changed statuses until
2503 the system says there are no more.
2504 All we do is change the status;
2505 we do not run sentinels or print notifications.
2506 That is saved for the next time keyboard input is done,
2507 in order to avoid timing errors. */
2508
2509/** WARNING: this can be called during garbage collection.
2510 Therefore, it must not be fooled by the presence of mark bits in
2511 Lisp objects. */
2512
2513/** USG WARNING: Although it is not obvious from the documentation
2514 in signal(2), on a USG system the SIGCLD handler MUST NOT call
2515 signal() before executing at least one wait(), otherwise the handler
2516 will be called again, resulting in an infinite loop. The relevant
2517 portion of the documentation reads "SIGCLD signals will be queued
2518 and the signal-catching function will be continually reentered until
2519 the queue is empty". Invoking signal() causes the kernel to reexamine
2520 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
2521
2522SIGTYPE
2523sigchld_handler (signo)
2524 int signo;
2525{
2526 int old_errno = errno;
2527 Lisp_Object proc;
2528 register struct Lisp_Process *p;
2529
2530#ifdef BSD4_1
2531 extern int sigheld;
2532 sigheld |= sigbit (SIGCHLD);
2533#endif
2534
2535 while (1)
2536 {
2537 register int pid;
2538 WAITTYPE w;
2539 Lisp_Object tail;
2540
2541#ifdef WNOHANG
2542#ifndef WUNTRACED
2543#define WUNTRACED 0
2544#endif /* no WUNTRACED */
2545 /* Keep trying to get a status until we get a definitive result. */
2546 do
2547 {
2548 errno = 0;
2549 pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
2550 }
2551 while (pid <= 0 && errno == EINTR);
2552
2553 if (pid <= 0)
2554 {
2555 /* A real failure. We have done all our job, so return. */
2556
2557 /* USG systems forget handlers when they are used;
2558 must reestablish each time */
2559#ifdef USG
2560 signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
2561#endif
2562#ifdef BSD4_1
2563 sigheld &= ~sigbit (SIGCHLD);
2564 sigrelse (SIGCHLD);
2565#endif
2566 errno = old_errno;
2567 return;
2568 }
2569#else
2570 pid = wait (&w);
2571#endif /* no WNOHANG */
2572
2573 /* Find the process that signaled us, and record its status. */
2574
2575 p = 0;
2576 for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
2577 {
2578 proc = XCONS (XCONS (tail)->car)->cdr;
2579 p = XPROCESS (proc);
2580 if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
2581 break;
2582 p = 0;
2583 }
2584
2585 /* Look for an asynchronous process whose pid hasn't been filled
2586 in yet. */
2587 if (p == 0)
2588 for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
2589 {
2590 proc = XCONS (XCONS (tail)->car)->cdr;
2591 p = XPROCESS (proc);
2592 if (XTYPE (p->pid) == Lisp_Int && XINT (p->pid) == -1)
2593 break;
2594 p = 0;
2595 }
2596
2597 /* Change the status of the process that was found. */
2598 if (p != 0)
2599 {
2600 union { int i; WAITTYPE wt; } u;
2601
2602 XSETINT (p->tick, ++process_tick);
2603 u.wt = w;
2604 XFASTINT (p->raw_status_low) = u.i & 0xffff;
2605 XFASTINT (p->raw_status_high) = u.i >> 16;
2606
2607 /* If process has terminated, stop waiting for its output. */
2608 if (WIFSIGNALED (w) || WIFEXITED (w))
2609 if (p->infd)
2610 FD_CLR (p->infd, &input_wait_mask);
2611 }
2612
2613 /* There was no asynchronous process found for that id. Check
2614 if we have a synchronous process. */
2615 else
2616 {
2617 synch_process_alive = 0;
2618
2619 /* Report the status of the synchronous process. */
2620 if (WIFEXITED (w))
2621 synch_process_retcode = WRETCODE (w);
2622 else if (WIFSIGNALED (w))
2623 synch_process_death = sys_siglist[WTERMSIG (w)];
2624 }
2625
2626 /* On some systems, we must return right away.
2627 If any more processes want to signal us, we will
2628 get another signal.
2629 Otherwise (on systems that have WNOHANG), loop around
2630 to use up all the processes that have something to tell us. */
2631#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
2632#ifdef USG
2633 signal (signo, sigchld_handler);
2634#endif
2635 errno = old_errno;
2636 return;
2637#endif /* USG, but not HPUX with WNOHANG */
2638 }
2639}
2640
2641
2642static Lisp_Object
2643exec_sentinel_unwind (data)
2644 Lisp_Object data;
2645{
2646 XPROCESS (XCONS (data)->car)->sentinel = XCONS (data)->cdr;
2647 return Qnil;
2648}
2649
2650static void
2651exec_sentinel (proc, reason)
2652 Lisp_Object proc, reason;
2653{
2654 Lisp_Object sentinel;
2655 register struct Lisp_Process *p = XPROCESS (proc);
2656 int count = specpdl_ptr - specpdl;
2657
2658 sentinel = p->sentinel;
2659 if (NILP (sentinel))
2660 return;
2661
2662 /* Zilch the sentinel while it's running, to avoid recursive invocations;
2663 assure that it gets restored no matter how the sentinel exits. */
2664 p->sentinel = Qnil;
2665 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
2666 /* Inhibit quit so that random quits don't screw up a running filter. */
2667 specbind (Qinhibit_quit, Qt);
2668 call2 (sentinel, proc, reason);
2669 unbind_to (count);
2670}
2671
2672/* Report all recent events of a change in process status
2673 (either run the sentinel or output a message).
2674 This is done while Emacs is waiting for keyboard input. */
2675
2676status_notify ()
2677{
2678 register Lisp_Object proc, buffer;
2679 Lisp_Object tail = Qnil;
2680 Lisp_Object msg = Qnil;
2681 struct gcpro gcpro1, gcpro2;
2682
2683 /* We need to gcpro tail; if read_process_output calls a filter
2684 which deletes a process and removes the cons to which tail points
2685 from Vprocess_alist, and then causes a GC, tail is an unprotected
2686 reference. */
2687 GCPRO2 (tail, msg);
2688
2689 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
2690 {
2691 Lisp_Object symbol;
2692 register struct Lisp_Process *p;
2693
2694 proc = Fcdr (Fcar (tail));
2695 p = XPROCESS (proc);
2696
2697 if (XINT (p->tick) != XINT (p->update_tick))
2698 {
2699 XSETINT (p->update_tick, XINT (p->tick));
2700
2701 /* If process is still active, read any output that remains. */
2702 if (XFASTINT (p->infd))
2703 while (read_process_output (proc, XFASTINT (p->infd)) > 0);
2704
2705 buffer = p->buffer;
2706
2707 /* Get the text to use for the message. */
2708 if (!NILP (p->raw_status_low))
2709 update_status (p);
2710 msg = status_message (p->status);
2711
2712 /* If process is terminated, deactivate it or delete it. */
2713 symbol = p->status;
2714 if (XTYPE (p->status) == Lisp_Cons)
2715 symbol = XCONS (p->status)->car;
2716
2717 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
2718 || EQ (symbol, Qclosed))
2719 {
2720 if (delete_exited_processes)
2721 remove_process (proc);
2722 else
2723 deactivate_process (proc);
2724 }
2725
2726 /* Now output the message suitably. */
2727 if (!NILP (p->sentinel))
2728 exec_sentinel (proc, msg);
2729 /* Don't bother with a message in the buffer
2730 when a process becomes runnable. */
2731 else if (!EQ (symbol, Qrun) && !NILP (buffer))
2732 {
2733 Lisp_Object ro = XBUFFER (buffer)->read_only;
2734 Lisp_Object tem;
2735 struct buffer *old = current_buffer;
2736 int opoint;
2737
2738 /* Avoid error if buffer is deleted
2739 (probably that's why the process is dead, too) */
2740 if (NILP (XBUFFER (buffer)->name))
2741 continue;
2742 Fset_buffer (buffer);
2743 opoint = point;
2744 /* Insert new output into buffer
2745 at the current end-of-output marker,
2746 thus preserving logical ordering of input and output. */
2747 if (XMARKER (p->mark)->buffer)
2748 SET_PT (marker_position (p->mark));
2749 else
2750 SET_PT (ZV);
2751 if (point <= opoint)
2752 opoint += XSTRING (msg)->size + XSTRING (p->name)->size + 10;
2753
2754 tem = current_buffer->read_only;
2755 current_buffer->read_only = Qnil;
2756 insert_string ("\nProcess ");
2757 Finsert (1, &p->name);
2758 insert_string (" ");
2759 Finsert (1, &msg);
2760 current_buffer->read_only = tem;
2761 Fset_marker (p->mark, make_number (point), p->buffer);
2762
2763 SET_PT (opoint);
2764 set_buffer_internal (old);
2765 }
2766 }
2767 } /* end for */
2768
2769 update_mode_lines++; /* in case buffers use %s in mode-line-format */
2770 redisplay_preserve_echo_area ();
2771
2772 update_tick = process_tick;
2773
2774 UNGCPRO;
2775}
2776
2777init_process ()
2778{
2779 register int i;
2780
2781#ifdef SIGCHLD
2782#ifndef CANNOT_DUMP
2783 if (! noninteractive || initialized)
2784#endif
2785 signal (SIGCHLD, sigchld_handler);
2786#endif
2787
2788 FD_ZERO (&input_wait_mask);
2789 FD_SET (0, &input_wait_mask);
2790 Vprocess_alist = Qnil;
2791 for (i = 0; i < MAXDESC; i++)
2792 {
2793 chan_process[i] = Qnil;
2794 proc_buffered_char[i] = -1;
2795 }
2796}
2797#ifdef 0
2798DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 0, 1, 0,
2799 "Return the connection type of `PROCESS'. This can be nil (pipe),\n\
2800t or pty (pty) or stream (socket connection).")
2801 (process)
2802 Lisp_Object process;
2803{
2804 return XPROCESS (process)->type;
2805}
2806#endif
2807syms_of_process ()
2808{
2809#ifdef HAVE_PTYS
2810 pty_process = intern ("pty");
2811#endif
2812#ifdef HAVE_SOCKETS
2813 stream_process = intern ("stream");
2814#endif
2815 Qprocessp = intern ("processp");
2816 staticpro (&Qprocessp);
2817 Qrun = intern ("run");
2818 staticpro (&Qrun);
2819 Qstop = intern ("stop");
2820 staticpro (&Qstop);
2821 Qsignal = intern ("signal");
2822 staticpro (&Qsignal);
2823
2824 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
2825 here again.
2826
2827 Qexit = intern ("exit");
2828 staticpro (&Qexit); */
2829
2830 Qopen = intern ("open");
2831 staticpro (&Qopen);
2832 Qclosed = intern ("closed");
2833 staticpro (&Qclosed);
2834
2835 staticpro (&Vprocess_alist);
2836
2837 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
2838 "*Non-nil means delete processes immediately when they exit.\n\
2839nil means don't delete them until `list-processes' is run.");
2840
2841 delete_exited_processes = 1;
2842
2843 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
2844 "Control type of device used to communicate with subprocesses.\n\
2845Values are nil to use a pipe, and t or 'pty for a pty. Note that if\n\
2846pty's are not available, this variable will be ignored. The value takes\n\
2847effect when `start-process' is called.");
2848 Vprocess_connection_type = Qt;
2849
2850 defsubr (&Sprocessp);
2851 defsubr (&Sget_process);
2852 defsubr (&Sget_buffer_process);
2853 defsubr (&Sdelete_process);
2854 defsubr (&Sprocess_status);
2855 defsubr (&Sprocess_exit_status);
2856 defsubr (&Sprocess_id);
2857 defsubr (&Sprocess_name);
2858 defsubr (&Sprocess_command);
2859 defsubr (&Sset_process_buffer);
2860 defsubr (&Sprocess_buffer);
2861 defsubr (&Sprocess_mark);
2862 defsubr (&Sset_process_filter);
2863 defsubr (&Sprocess_filter);
2864 defsubr (&Sset_process_sentinel);
2865 defsubr (&Sprocess_sentinel);
2866 defsubr (&Sprocess_kill_without_query);
2867 defsubr (&Slist_processes);
2868 defsubr (&Sprocess_list);
2869 defsubr (&Sstart_process);
2870#ifdef HAVE_SOCKETS
2871 defsubr (&Sopen_network_stream);
2872#endif /* HAVE_SOCKETS */
2873 defsubr (&Saccept_process_output);
2874 defsubr (&Sprocess_send_region);
2875 defsubr (&Sprocess_send_string);
2876 defsubr (&Sinterrupt_process);
2877 defsubr (&Skill_process);
2878 defsubr (&Squit_process);
2879 defsubr (&Sstop_process);
2880 defsubr (&Scontinue_process);
2881 defsubr (&Sprocess_send_eof);
2882 defsubr (&Ssignal_process);
2883 defsubr (&Swaiting_for_user_input_p);
2884/* defsubr (&Sprocess_connection); */
2885}
2886
2887#endif /* subprocesses */
diff --git a/src/systty.h b/src/systty.h
new file mode 100644
index 00000000000..07f12eb33d1
--- /dev/null
+++ b/src/systty.h
@@ -0,0 +1,267 @@
1/* systerm.h - System-dependent definitions for terminals.
2 Copyright (C) 1992 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 1, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21/* Include the proper files. */
22#ifdef HAVE_TERMIO
23#include <termio.h>
24#include <fcntl.h>
25#else
26#ifdef HAVE_TERMIOS
27#include <termio.h>
28#include <termios.h>
29#else /* neither HAVE_TERMIO nor HAVE_TERMIOS */
30#ifndef VMS
31#include <sgtty.h>
32#endif /* not VMS */
33#endif /* not HAVE_TERMIOS */
34#endif /* not HAVE_TERMIO */
35
36
37/* Special cases - inhibiting the use of certain features. */
38
39#ifdef APOLLO
40#undef TIOCSTART
41#endif
42
43#ifdef BROKEN_TIOCGETC
44#undef TIOCGETC /* Avoid confusing some conditionals that test this. */
45#endif
46
47/* UNIPLUS systems may have FIONREAD. */
48#ifdef UNIPLUS
49#include <sys.ioctl.h>
50#endif
51
52/* Allow m- file to inhibit use of FIONREAD. */
53#ifdef BROKEN_FIONREAD
54#undef FIONREAD
55#undef ASYNC
56#endif
57
58/* Interupt input is not used if there is no FIONREAD. */
59#ifndef FIONREAD
60#undef SIGIO
61#endif
62
63
64/* Get the number of characters queued for output. */
65
66/* EMACS_OUTQSIZE(FD, int *SIZE) stores the number of characters
67 queued for output to the terminal FD in *SIZE, if FD is a tty.
68 Returns -1 if there was an error (i.e. FD is not a tty), 0
69 otherwise. */
70#ifdef TIOCOUTQ
71#define EMACS_OUTQSIZE(fd, size) (ioctl ((fd), TIOCOUTQ, (size)))
72#endif
73
74#ifdef HAVE_TERMIO
75#ifdef TCOUTQ
76#undef EMACS_OUTQSIZE
77#define EMACS_OUTQSIZE(fd, size) (ioctl ((fd), TCOUTQ, (size)))
78#endif
79#endif
80
81
82/* Manipulate a terminal's current process group. */
83
84/* EMACS_HAVE_TTY_PGRP is true if we can get and set the tty's current
85 controlling process group.
86
87 EMACS_GET_TTY_PGRP(int FD, int *PGID) sets *PGID the terminal FD's
88 current process group. Return -1 if there is an error.
89
90 EMACS_SET_TTY_PGRP(int FD, int *PGID) sets the terminal FD's
91 current process group to *PGID. Return -1 if there is an error. */
92
93#ifdef TIOCGPGRP
94#define EMACS_HAVE_TTY_PGRP
95#else
96#ifdef HAVE_TERMIOS
97#define EMACS_HAVE_TTY_PGRP
98#endif
99#endif
100
101#ifdef EMACS_HAVE_TTY_PGRP
102
103#ifdef HAVE_TERMIOS
104
105#define EMACS_GET_TTY_PGRP(fd, pgid) (*(pgid) = tcgetpgrp ((fd)))
106#define EMACS_SET_TTY_PGRP(fd, pgid) (*(pgid) = tcsetpgrp ((fd)))
107
108#else
109#ifdef TIOCSPGRP
110
111#define EMACS_GET_TTY_PGRP(fd, pgid) (ioctl ((fd), TIOCGPGRP, (pgid)))
112#define EMACS_SET_TTY_PGRP(fd, pgid) (ioctl ((fd), TIOCSPGRP, (pgid)))
113
114#endif
115#endif
116
117#else
118
119/* Just ignore this for now and hope for the best */
120#define EMACS_GET_TTY_PGRP(fd, pgid) 0
121
122#endif
123
124
125/* Manipulate a TTY's input/output processing parameters. */
126
127/* struct emacs_tty is a structure used to hold the current tty
128 parameters. If the terminal has several structures describing its
129 state, for example a struct tchars, a struct sgttyb, a struct
130 tchars, a struct ltchars, and a struct pagechars, struct
131 emacs_tty should contain an element for each parameter struct
132 that Emacs may change.
133
134 EMACS_GET_TTY (int FD, struct emacs_tty *P) stores the
135 parameters of the tty on FD in *P.
136
137 EMACS_SET_TTY (int FD, struct emacs_tty *P, int waitp)
138 sets the parameters of the tty on FD according to the contents of
139 *P. If waitp is non-zero, we wait for all queued output to be
140 written before making the change; otherwise, we forget any queued
141 input and make the change immediately.
142
143 EMACS_TTY_TABS_OK (struct emacs_tty *P) is false iff the kernel
144 expands tabs to spaces upon output; in that case, there is no
145 advantage to using tabs over spaces. */
146
147
148
149/* For each tty parameter structure that Emacs might want to save and restore,
150 - include an element for it in this structure,
151 - define a pair of numbered macros to get and set it and return
152 true iff the call succeeded,
153 - give alternative definitions for when the component is not implemented
154 which always succeed, and
155 - extend the definition of EMACS_{GET,SET}_TTY_CHARS to include the
156 new macros. */
157
158struct emacs_tty {
159
160/* There is always one of the following elements, so there is no need
161 for dummy get and set definitions. */
162#ifdef HAVE_TERMIOS
163 struct termios main;
164#else
165#ifdef HAVE_TERMIO
166 struct termio main;
167#else
168#ifdef VMS
169 struct sensemode main;
170#else
171 struct sgttyb main;
172#endif
173#endif
174#endif
175
176#ifdef HAVE_TERMIOS
177#define HAVE_TCATTR
178#endif
179
180#ifdef HAVE_TCATTR
181
182#define EMACS_GET_TTY_1(fd, p) (tcgetattr ((fd), &(p)->main) != -1)
183#define EMACS_SET_TTY_1(fd, p, waitp) \
184 (tcsetattr ((fd), (waitp) ? TCSAFLUSH : TCSADRAIN, &(p)->main) != -1)
185
186#else
187#ifdef VMS
188
189/* These definitions will really only work in sysdep.c, because of their
190 use of input_iosb. I don't know enough about VMS QIO to fix this. */
191#define EMACS_GET_TTY_1(fd, p) \
192 SYS$QIOW (0, (fd), IO$_SENSEMODE, (p), 0, 0, \
193 &(p)->main.class, 12, 0, 0, 0, 0);
194#define EMACS_SET_TTY_1(fd, p, waitp) \
195 SYS$QIOW (0, (fd), IO$_SETMODE, &input_iosb, 0, 0, \
196 &(p)->main.class, 12, 0, 0, 0, 0);
197
198#else
199
200#define EMACS_GET_TTY_1(fd, p) (ioctl ((fd), TIOCGETP, &(p)->main) != -1)
201#define EMACS_SET_TTY_1(fd, p, waitp) \
202 (ioctl ((fd), (waitp) ? TIOCSETP : TIOCSETN, &(p)->main) != -1)
203
204#endif
205#endif
206
207#ifdef TIOCGLTC
208 struct ltchars ltchars;
209#define EMACS_GET_TTY_2(fd, p) \
210 (ioctl ((fd), TIOCGLTC, &(p)->ltchars) != -1)
211#define EMACS_SET_TTY_2(fd, p, waitp) \
212 (ioctl ((fd), TIOCSLTC, &(p)->ltchars) != -1)
213#else
214#define EMACS_GET_TTY_2(fd, p) 1
215#define EMACS_SET_TTY_2(fd, p, waitp) 1
216#endif /* TIOCGLTC */
217
218#ifdef TIOCGETC
219 struct tchars tchars;
220 int lmode;
221#define EMACS_GET_TTY_3(fd, p) \
222 (ioctl ((fd), TIOCGETC, &(p)->tchars) != -1 \
223 && ioctl ((fd), TIOCLGET, &(p)->lmode) != -1)
224#define EMACS_SET_TTY_3(fd, p, waitp) \
225 (ioctl ((fd), TIOCSETC, &(p)->tchars) != -1 \
226 && ioctl ((fd), TIOCLSET, &(p)->lmode) != -1)
227#else
228#define EMACS_GET_TTY_3(fd, p) 1
229#define EMACS_SET_TTY_3(fd, p, waitp) 1
230#endif /* TIOCGLTC */
231
232};
233
234/* Define these to be a concatenation of all the EMACS_{GET,SET}_TTY
235 macros. */
236#define EMACS_GET_TTY(fd, tc) \
237 (EMACS_GET_TTY_1 (fd, tc) \
238 && EMACS_GET_TTY_2 (fd, tc) \
239 && EMACS_GET_TTY_3 (fd, tc))
240
241#define EMACS_SET_TTY(fd, tc, waitp) \
242 (EMACS_SET_TTY_1 (fd, tc, waitp) \
243 && EMACS_SET_TTY_2 (fd, tc, waitp) \
244 && EMACS_SET_TTY_3 (fd, tc, waitp))
245
246
247#ifdef HAVE_TERMIOS
248
249#define EMACS_TTY_TABS_OK(p) (((p)->main.c_oflag & TABDLY) != TAB3)
250
251#else /* not def HAVE_TERMIOS */
252#ifdef HAVE_TERMIO
253
254#define EMACS_TTY_TABS_OK(p) (((p)->main.c_oflag & TABDLY) != TAB3)
255
256#else /* neither HAVE_TERMIO nor HAVE_TERMIOS */
257#ifdef VMS
258
259#define EMACS_TTY_TABS_OK(p) (((p)->main.tt_char & TT$M_MECHTAB) != 0)
260
261#else
262
263#define EMACS_TTY_TABS_OK(p) (((p)->main.sg_flags & XTABS) != XTABS)
264
265#endif /* not def VMS */
266#endif /* not def HAVE_TERMIO */
267#endif /* not def HAVE_TERMIOS */
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-18 18:16:04 +0000