summaryrefslogtreecommitdiff
path: root/src/process.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/process.c')
-rw-r--r--src/process.c2769
1 files changed, 2769 insertions, 0 deletions
diff --git a/src/process.c b/src/process.c
new file mode 100644
index 00000000000..d968d5aa589
--- /dev/null
+++ b/src/process.c
@@ -0,0 +1,2769 @@
+/* Asynchronous subprocess control for GNU Emacs.
+ Copyright (C) 1985, 1986, 1987, 1988, 1990 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 1, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING. If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+/* This must precede sys/signal.h on certain machines. */
+#include <sys/types.h>
+#include <signal.h>
+
+#include "config.h"
+
+#ifdef VMS
+/* Prevent the file from being totally empty. */
+static dummy () {}
+#endif
+
+#ifdef subprocesses
+/* The entire file is within this conditional */
+
+#include <stdio.h>
+#include <errno.h>
+#include <setjmp.h>
+#include <sys/file.h>
+#include <sys/stat.h>
+
+#ifdef HAVE_SOCKETS /* TCP connection support, if kernel can do it */
+#include <sys/socket.h>
+#include <netdb.h>
+#include <netinet/in.h>
+#endif /* HAVE_SOCKETS */
+
+#if defined(BSD) || defined(STRIDE)
+#include <sys/ioctl.h>
+#if !defined (O_NDELAY) && defined (HAVE_PTYS)
+#include <fcntl.h>
+#endif /* HAVE_PTYS and no O_NDELAY */
+#endif /* BSD or STRIDE */
+#ifdef USG
+#ifndef NO_TERMIO
+#include <termio.h>
+#endif
+#include <fcntl.h>
+#endif /* USG */
+
+#ifdef NEED_BSDTTY
+#include <sys/bsdtty.h>
+#endif
+
+#ifdef NEED_TERMIOS
+#include <sys/termios.h>
+#endif
+
+#ifdef TRITON88 /* To make emacs send C-c correctly in shell */
+#define TIOCGPGRP FIOGETOWN
+#endif
+
+#ifdef HPUX
+#undef TIOCGPGRP
+#endif
+
+/* Include time.h or sys/time.h or both. */
+#include "gettime.h"
+
+#if defined (HPUX) && defined (HAVE_PTYS)
+#include <sys/ptyio.h>
+#endif
+
+#ifdef AIX
+#include <sys/pty.h>
+#include <unistd.h>
+#endif /* AIX */
+
+#ifdef SYSV_PTYS
+#include <sys/tty.h>
+#include <sys/pty.h>
+#endif
+
+#ifdef XENIX
+#undef TIOCGETC /* Avoid confusing some conditionals that test this. */
+#endif
+
+#ifdef BROKEN_TIOCGETC
+#undef TIOCGETC
+#endif
+
+#ifdef BROKEN_O_NONBLOCK
+#undef O_NONBLOCK
+#endif
+
+#undef NULL
+#include "lisp.h"
+#include "window.h"
+#include "buffer.h"
+#include "process.h"
+#include "termhooks.h"
+#include "termopts.h"
+#include "commands.h"
+#include "dispextern.h"
+
+Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed;
+extern Lisp_Object Qexit;
+
+/* a process object is a network connection when its childp field is neither
+ Qt nor Qnil but is instead a string (name of foreign host we
+ are connected to + name of port we are connected to) */
+
+#ifdef HAVE_SOCKETS
+#define NETCONN_P(p) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String)
+#else
+#define NETCONN_P(p) 0
+#endif /* HAVE_SOCKETS */
+
+/* Define SIGCHLD as an alias for SIGCLD. There are many conditionals
+ testing SIGCHLD. */
+
+#if !defined (SIGCHLD) && defined (SIGCLD)
+#define SIGCHLD SIGCLD
+#endif /* SIGCLD */
+
+#include "emacssignal.h"
+
+/* Define the structure that the wait system call stores.
+ On many systems, there is a structure defined for this.
+ But on vanilla-ish USG systems there is not. */
+
+#ifndef WAITTYPE
+#if !defined (BSD) && !defined (UNIPLUS) && !defined (STRIDE) && !(defined (HPUX) && !defined (NOMULTIPLEJOBS)) && !defined (HAVE_WAIT_HEADER)
+#define WAITTYPE int
+#define WIFSTOPPED(w) ((w&0377) == 0177)
+#define WIFSIGNALED(w) ((w&0377) != 0177 && (w&~0377) == 0)
+#define WIFEXITED(w) ((w&0377) == 0)
+#define WRETCODE(w) (w >> 8)
+#define WSTOPSIG(w) (w >> 8)
+#define WTERMSIG(w) (w & 0377)
+#ifndef WCOREDUMP
+#define WCOREDUMP(w) ((w&0200) != 0)
+#endif
+#else
+#ifdef BSD4_1
+#include <wait.h>
+#else
+#include <sys/wait.h>
+#endif /* not BSD 4.1 */
+
+#define WAITTYPE union wait
+#define WRETCODE(w) w.w_retcode
+#define WCOREDUMP(w) w.w_coredump
+
+#ifdef HPUX
+/* HPUX version 7 has broken definitions of these. */
+#undef WTERMSIG
+#undef WSTOPSIG
+#undef WIFSTOPPED
+#undef WIFSIGNALED
+#undef WIFEXITED
+#endif
+
+#ifndef WTERMSIG
+#define WTERMSIG(w) w.w_termsig
+#endif
+#ifndef WSTOPSIG
+#define WSTOPSIG(w) w.w_stopsig
+#endif
+#ifndef WIFSTOPPED
+#define WIFSTOPPED(w) (WTERMSIG (w) == 0177)
+#endif
+#ifndef WIFSIGNALED
+#define WIFSIGNALED(w) (WTERMSIG (w) != 0177 && (WSTOPSIG (w)) == 0)
+#endif
+#ifndef WIFEXITED
+#define WIFEXITED(w) (WTERMSIG (w) == 0)
+#endif
+#endif /* BSD or UNIPLUS or STRIDE */
+#endif /* no WAITTYPE */
+
+extern errno;
+extern sys_nerr;
+extern char *sys_errlist[];
+
+#ifndef BSD4_1
+extern char *sys_siglist[];
+#else
+char *sys_siglist[] =
+ {
+ "bum signal!!",
+ "hangup",
+ "interrupt",
+ "quit",
+ "illegal instruction",
+ "trace trap",
+ "iot instruction",
+ "emt instruction",
+ "floating point exception",
+ "kill",
+ "bus error",
+ "segmentation violation",
+ "bad argument to system call",
+ "write on a pipe with no one to read it",
+ "alarm clock",
+ "software termination signal from kill",
+ "status signal",
+ "sendable stop signal not from tty",
+ "stop signal from tty",
+ "continue a stopped process",
+ "child status has changed",
+ "background read attempted from control tty",
+ "background write attempted from control tty",
+ "input record available at control tty",
+ "exceeded CPU time limit",
+ "exceeded file size limit"
+ };
+#endif
+
+#ifdef vipc
+
+#include "vipc.h"
+extern int comm_server;
+extern int net_listen_address;
+#endif /* vipc */
+
+/* Communicate exit status of synch process to callproc.c. */
+extern int synch_process_retcode;
+extern char *synch_process_death;
+
+/* t means use pty, nil means use a pipe,
+ maybe other values to come. */
+Lisp_Object Vprocess_connection_type;
+
+#ifdef SKTPAIR
+#ifndef HAVE_SOCKETS
+#include <sys/socket.h>
+#endif
+#endif /* SKTPAIR */
+
+/* Number of events of change of status of a process. */
+int process_tick;
+
+/* Number of events for which the user or sentinel has been notified. */
+int update_tick;
+
+int delete_exited_processes;
+
+#ifdef FD_SET
+/* We could get this from param.h, but better not to depend on finding that.
+ And better not to risk that it might define other symbols used in this
+ file. */
+#define MAXDESC 64
+#define SELECT_TYPE fd_set
+#else /* no FD_SET */
+#define MAXDESC 32
+#define SELECT_TYPE int
+
+/* Define the macros to access a single-int bitmap of descriptors. */
+#define FD_SET(n, p) (*(p) |= (1 << (n)))
+#define FD_CLR(n, p) (*(p) &= ~(1 << (n)))
+#define FD_ISSET(n, p) (*(p) & (1 << (n)))
+#define FD_ZERO(p) (*(p) = 0)
+#endif /* no FD_SET */
+
+/* Mask of bits indicating the descriptors that we wait for input on */
+
+SELECT_TYPE input_wait_mask;
+
+/* Indexed by descriptor, gives the process (if any) for that descriptor */
+Lisp_Object chan_process[MAXDESC];
+
+/* Alist of elements (NAME . PROCESS) */
+Lisp_Object Vprocess_alist;
+
+Lisp_Object Qprocessp;
+
+Lisp_Object get_process ();
+
+/* Buffered-ahead input char from process, indexed by channel.
+ -1 means empty (no char is buffered).
+ Used on sys V where the only way to tell if there is any
+ output from the process is to read at least one char.
+ Always -1 on systems that support FIONREAD. */
+
+int proc_buffered_char[MAXDESC];
+
+/* These variables hold the filter about to be run, and its args,
+ between read_process_output and run_filter.
+ Also used in exec_sentinel for sentinels. */
+Lisp_Object this_filter;
+Lisp_Object filter_process, filter_string;
+
+/* Compute the Lisp form of the process status, p->status,
+ from the numeric status that was returned by `wait'. */
+
+update_status (p)
+ struct Lisp_Process *p;
+{
+ union { int i; WAITTYPE wt; } u;
+ u.i = XFASTINT (p->raw_status_low) + (XFASTINT (p->raw_status_high) << 16);
+ p->status = status_convert (u.wt);
+ p->raw_status_low = Qnil;
+ p->raw_status_high = Qnil;
+}
+
+/* Convert a process status word in Unix format
+ to the list that we use internally. */
+
+Lisp_Object
+status_convert (w)
+ WAITTYPE w;
+{
+ if (WIFSTOPPED (w))
+ return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
+ else if (WIFEXITED (w))
+ return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
+ WCOREDUMP (w) ? Qt : Qnil));
+ else if (WIFSIGNALED (w))
+ return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
+ WCOREDUMP (w) ? Qt : Qnil));
+ else
+ return Qrun;
+}
+
+/* Given a status-list, extract the three pieces of information
+ and store them individually through the three pointers. */
+
+void
+decode_status (l, symbol, code, coredump)
+ Lisp_Object l;
+ Lisp_Object *symbol;
+ int *code;
+ int *coredump;
+{
+ Lisp_Object tem;
+
+ if (XTYPE (l) == Lisp_Symbol)
+ {
+ *symbol = l;
+ *code = 0;
+ *coredump = 0;
+ }
+ else
+ {
+ *symbol = XCONS (l)->car;
+ tem = XCONS (l)->cdr;
+ *code = XFASTINT (XCONS (tem)->car);
+ tem = XFASTINT (XCONS (tem)->cdr);
+ *coredump = !NULL (tem);
+ }
+}
+
+/* Return a string describing a process status list. */
+
+Lisp_Object
+status_message (status)
+ Lisp_Object status;
+{
+ Lisp_Object symbol;
+ int code, coredump;
+ Lisp_Object string, string2;
+
+ decode_status (status, &symbol, &code, &coredump);
+
+ if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
+ {
+ string = build_string (code < NSIG ? sys_siglist[code] : "unknown");
+ string2 = build_string (coredump ? " (core dumped)\n" : "\n");
+ XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
+ return concat2 (string, string2);
+ }
+ else if (EQ (symbol, Qexit))
+ {
+ if (code == 0)
+ return build_string ("finished\n");
+ string = Fint_to_string (make_number (code));
+ string2 = build_string (coredump ? " (core dumped)\n" : "\n");
+ return concat2 (build_string ("exited abnormally with code "),
+ concat2 (string, string2));
+ }
+ else
+ return Fcopy_sequence (Fsymbol_name (symbol));
+}
+
+#ifdef HAVE_PTYS
+
+/* Open an available pty, returning a file descriptor.
+ Return -1 on failure.
+ The file name of the terminal corresponding to the pty
+ is left in the variable pty_name. */
+
+char pty_name[24];
+
+int
+allocate_pty ()
+{
+ struct stat stb;
+ register c, i;
+ int fd;
+
+ /* Some systems name their pseudoterminals so that there are gaps in
+ the usual sequence - for example, on HP9000/S700 systems, there
+ are no pseudoterminals with names ending in 'f'. So we wait for
+ three failures in a row before deciding that we've reached the
+ end of the ptys. */
+ int failed_count = 0;
+
+#ifdef PTY_ITERATION
+ PTY_ITERATION
+#else
+ for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
+ for (i = 0; i < 16; i++)
+#endif
+ {
+#ifdef PTY_NAME_SPRINTF
+ PTY_NAME_SPRINTF
+#else
+#ifdef HPUX
+ sprintf (pty_name, "/dev/ptym/pty%c%x", c, i);
+#else
+#ifdef RTU
+ sprintf (pty_name, "/dev/pty%x", i);
+#else
+ sprintf (pty_name, "/dev/pty%c%x", c, i);
+#endif /* not RTU */
+#endif /* not HPUX */
+#endif /* no PTY_NAME_SPRINTF */
+
+#ifdef PTY_OPEN
+ PTY_OPEN;
+#else /* no PTY_OPEN */
+#ifndef IRIS
+ if (stat (pty_name, &stb) < 0)
+ {
+ failed_count++;
+ if (failed_count >= 3)
+ return -1;
+ }
+ else
+ failed_count = 0;
+#ifdef O_NONBLOCK
+ fd = open (pty_name, O_RDWR | O_NONBLOCK, 0);
+#else
+ fd = open (pty_name, O_RDWR | O_NDELAY, 0);
+#endif
+#else /* Unusual IRIS code */
+ fd = open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
+ if (fd < 0)
+ return -1;
+ if (fstat (fd, &stb) < 0)
+ return -1;
+#endif /* IRIS */
+#endif /* no PTY_OPEN */
+
+ if (fd >= 0)
+ {
+ /* check to make certain that both sides are available
+ this avoids a nasty yet stupid bug in rlogins */
+#ifdef PTY_TTY_NAME_SPRINTF
+ PTY_TTY_NAME_SPRINTF
+#else
+ /* In version 19, make these special cases use the macro above. */
+#ifdef HPUX
+ sprintf (pty_name, "/dev/pty/tty%c%x", c, i);
+#else
+#ifdef RTU
+ sprintf (pty_name, "/dev/ttyp%x", i);
+#else
+#ifdef IRIS
+ sprintf (pty_name, "/dev/ttyq%d", minor (stb.st_rdev));
+#else
+ sprintf (pty_name, "/dev/tty%c%x", c, i);
+#endif /* not IRIS */
+#endif /* not RTU */
+#endif /* not HPUX */
+#endif /* no PTY_TTY_NAME_SPRINTF */
+#ifndef UNIPLUS
+ if (access (pty_name, 6) != 0)
+ {
+ close (fd);
+#ifndef IRIS
+ continue;
+#else
+ return -1;
+#endif /* IRIS */
+ }
+#endif /* not UNIPLUS */
+ setup_pty (fd);
+ return fd;
+ }
+ }
+ return -1;
+}
+#endif /* HAVE_PTYS */
+
+Lisp_Object
+make_process (name)
+ Lisp_Object name;
+{
+ register Lisp_Object val, tem, name1;
+ register struct Lisp_Process *p;
+ char suffix[10];
+ register int i;
+
+ /* size of process structure includes the vector header,
+ so deduct for that. But struct Lisp_Vector includes the first
+ element, thus deducts too much, so add it back. */
+ val = Fmake_vector (make_number ((sizeof (struct Lisp_Process)
+ - sizeof (struct Lisp_Vector)
+ + sizeof (Lisp_Object))
+ / sizeof (Lisp_Object)),
+ Qnil);
+ XSETTYPE (val, Lisp_Process);
+
+ p = XPROCESS (val);
+ XFASTINT (p->infd) = 0;
+ XFASTINT (p->outfd) = 0;
+ XFASTINT (p->pid) = 0;
+ XFASTINT (p->tick) = 0;
+ XFASTINT (p->update_tick) = 0;
+ p->raw_status_low = Qnil;
+ p->raw_status_high = Qnil;
+ p->status = Qrun;
+ p->mark = Fmake_marker ();
+
+ /* If name is already in use, modify it until it is unused. */
+
+ name1 = name;
+ for (i = 1; ; i++)
+ {
+ tem = Fget_process (name1);
+ if (NULL (tem)) break;
+ sprintf (suffix, "<%d>", i);
+ name1 = concat2 (name, build_string (suffix));
+ }
+ name = name1;
+ p->name = name;
+ Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
+ return val;
+}
+
+remove_process (proc)
+ register Lisp_Object proc;
+{
+ register Lisp_Object pair;
+
+ pair = Frassq (proc, Vprocess_alist);
+ Vprocess_alist = Fdelq (pair, Vprocess_alist);
+ Fset_marker (XPROCESS (proc)->mark, Qnil, Qnil);
+
+ deactivate_process (proc);
+}
+
+DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
+ "Return t if OBJECT is a process.")
+ (obj)
+ Lisp_Object obj;
+{
+ return XTYPE (obj) == Lisp_Process ? Qt : Qnil;
+}
+
+DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
+ "Return the process named NAME, or nil if there is none.")
+ (name)
+ register Lisp_Object name;
+{
+ if (XTYPE (name) == Lisp_Process)
+ return name;
+ CHECK_STRING (name, 0);
+ return Fcdr (Fassoc (name, Vprocess_alist));
+}
+
+DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
+ "Return the (or, a) process associated with BUFFER.\n\
+BUFFER may be a buffer or the name of one.")
+ (name)
+ register Lisp_Object name;
+{
+ register Lisp_Object buf, tail, proc;
+
+ if (NULL (name)) return Qnil;
+ buf = Fget_buffer (name);
+ if (NULL (buf)) return Qnil;
+
+ for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
+ {
+ proc = Fcdr (Fcar (tail));
+ if (XTYPE (proc) == Lisp_Process && EQ (XPROCESS (proc)->buffer, buf))
+ return proc;
+ }
+ return Qnil;
+}
+
+/* This is how commands for the user decode process arguments */
+
+Lisp_Object
+get_process (name)
+ register Lisp_Object name;
+{
+ register Lisp_Object proc;
+ if (NULL (name))
+ proc = Fget_buffer_process (Fcurrent_buffer ());
+ else
+ {
+ proc = Fget_process (name);
+ if (NULL (proc))
+ proc = Fget_buffer_process (Fget_buffer (name));
+ }
+
+ if (!NULL (proc))
+ return proc;
+
+ if (NULL (name))
+ error ("Current buffer has no process");
+ else
+ error ("Process %s does not exist", XSTRING (name)->data);
+ /* NOTREACHED */
+}
+
+DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
+ "Delete PROCESS: kill it and forget about it immediately.\n\
+PROCESS may be a process or the name of one, or a buffer name.")
+ (proc)
+ register Lisp_Object proc;
+{
+ proc = get_process (proc);
+ XPROCESS (proc)->raw_status_low = Qnil;
+ XPROCESS (proc)->raw_status_high = Qnil;
+ if (NETCONN_P (proc))
+ {
+ XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
+ XSETINT (XPROCESS (proc)->tick, ++process_tick);
+ }
+ else if (XFASTINT (XPROCESS (proc)->infd))
+ {
+ Fkill_process (proc, Qnil);
+ /* Do this now, since remove_process will make sigchld_handler do nothing. */
+ XPROCESS (proc)->status
+ = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
+ XSETINT (XPROCESS (proc)->tick, ++process_tick);
+ status_notify ();
+ }
+ remove_process (proc);
+ return Qnil;
+}
+
+DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
+ "Return the status of PROCESS: a symbol, one of these:\n\
+run -- for a process that is running.\n\
+stop -- for a process stopped but continuable.\n\
+exit -- for a process that has exited.\n\
+signal -- for a process that has got a fatal signal.\n\
+open -- for a network stream connection that is open.\n\
+closed -- for a network stream connection that is closed.\n\
+nil -- if arg is a process name and no such process exists.")
+/* command -- for a command channel opened to Emacs by another process.\n\
+ external -- for an i/o channel opened to Emacs by another process.\n\ */
+ (proc)
+ register Lisp_Object proc;
+{
+ register struct Lisp_Process *p;
+ register Lisp_Object status;
+ proc = Fget_process (proc);
+ if (NULL (proc))
+ return proc;
+ p = XPROCESS (proc);
+ if (!NULL (p->raw_status_low))
+ update_status (p);
+ status = p->status;
+ if (XTYPE (status) == Lisp_Cons)
+ status = XCONS (status)->car;
+ if (NETCONN_P (proc))
+ {
+ if (EQ (status, Qrun))
+ status = Qopen;
+ else if (EQ (status, Qexit))
+ status = Qclosed;
+ }
+ return status;
+}
+
+DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
+ 1, 1, 0,
+ "Return the exit status of PROCESS or the signal number that killed it.\n\
+If PROCESS has not yet exited or died, return 0.\n\
+If PROCESS is a net connection that was closed remotely, return 256.")
+ (proc)
+ register Lisp_Object proc;
+{
+ CHECK_PROCESS (proc, 0);
+ if (!NULL (XPROCESS (proc)->raw_status_low))
+ update_status (XPROCESS (proc));
+ if (XTYPE (XPROCESS (proc)->status) == Lisp_Cons)
+ return XCONS (XCONS (XPROCESS (proc)->status)->cdr)->car;
+ return make_number (0);
+}
+
+DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
+ "Return the process id of PROCESS.\n\
+This is the pid of the Unix process which PROCESS uses or talks to.\n\
+For a network connection, this value is nil.")
+ (proc)
+ register Lisp_Object proc;
+{
+ CHECK_PROCESS (proc, 0);
+ return XPROCESS (proc)->pid;
+}
+
+DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
+ "Return the name of PROCESS, as a string.\n\
+This is the name of the program invoked in PROCESS,\n\
+possibly modified to make it unique among process names.")
+ (proc)
+ register Lisp_Object proc;
+{
+ CHECK_PROCESS (proc, 0);
+ return XPROCESS (proc)->name;
+}
+
+DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
+ "Return the command that was executed to start PROCESS.\n\
+This is a list of strings, the first string being the program executed\n\
+and the rest of the strings being the arguments given to it.\n\
+For a non-child channel, this is nil.")
+ (proc)
+ register Lisp_Object proc;
+{
+ CHECK_PROCESS (proc, 0);
+ return XPROCESS (proc)->command;
+}
+
+DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
+ 2, 2, 0,
+ "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).")
+ (proc, buffer)
+ register Lisp_Object proc, buffer;
+{
+ CHECK_PROCESS (proc, 0);
+ if (!NULL (buffer))
+ CHECK_BUFFER (buffer, 1);
+ XPROCESS (proc)->buffer = buffer;
+ return buffer;
+}
+
+DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
+ 1, 1, 0,
+ "Return the buffer PROCESS is associated with.\n\
+Output from PROCESS is inserted in this buffer\n\
+unless PROCESS has a filter.")
+ (proc)
+ register Lisp_Object proc;
+{
+ CHECK_PROCESS (proc, 0);
+ return XPROCESS (proc)->buffer;
+}
+
+DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
+ 1, 1, 0,
+ "Return the marker for the end of the last output from PROCESS.")
+ (proc)
+ register Lisp_Object proc;
+{
+ CHECK_PROCESS (proc, 0);
+ return XPROCESS (proc)->mark;
+}
+
+DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
+ 2, 2, 0,
+ "Give PROCESS the filter function FILTER; nil means no filter.\n\
+When a process has a filter, each time it does output\n\
+the entire string of output is passed to the filter.\n\
+The filter gets two arguments: the process and the string of output.\n\
+If the process has a filter, its buffer is not used for output.")
+ (proc, filter)
+ register Lisp_Object proc, filter;
+{
+ CHECK_PROCESS (proc, 0);
+ XPROCESS (proc)->filter = filter;
+ return filter;
+}
+
+DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
+ 1, 1, 0,
+ "Returns the filter function of PROCESS; nil if none.\n\
+See set-process-filter for more info on filter functions.")
+ (proc)
+ register Lisp_Object proc;
+{
+ CHECK_PROCESS (proc, 0);
+ return XPROCESS (proc)->filter;
+}
+
+DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
+ 2, 2, 0,
+ "Give PROCESS the sentinel SENTINEL; nil for none.\n\
+The sentinel is called as a function when the process changes state.\n\
+It gets two arguments: the process, and a string describing the change.")
+ (proc, sentinel)
+ register Lisp_Object proc, sentinel;
+{
+ CHECK_PROCESS (proc, 0);
+ XPROCESS (proc)->sentinel = sentinel;
+ return sentinel;
+}
+
+DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
+ 1, 1, 0,
+ "Return the sentinel of PROCESS; nil if none.\n\
+See set-process-sentinel for more info on sentinels.")
+ (proc)
+ register Lisp_Object proc;
+{
+ CHECK_PROCESS (proc, 0);
+ return XPROCESS (proc)->sentinel;
+}
+
+DEFUN ("process-kill-without-query", Fprocess_kill_without_query,
+ Sprocess_kill_without_query, 1, 2, 0,
+ "Say no query needed if PROCESS is running when Emacs is exited.\n\
+Optional second argument if non-nil says to require a query.\n\
+Value is t if a query was formerly required.")
+ (proc, value)
+ register Lisp_Object proc, value;
+{
+ Lisp_Object tem;
+ CHECK_PROCESS (proc, 0);
+ tem = XPROCESS (proc)->kill_without_query;
+ XPROCESS (proc)->kill_without_query = Fnull (value);
+ return Fnull (tem);
+}
+
+Lisp_Object
+list_processes_1 ()
+{
+ register Lisp_Object tail, tem;
+ Lisp_Object proc, minspace, tem1;
+ register struct buffer *old = current_buffer;
+ register struct Lisp_Process *p;
+ register int state;
+ char tembuf[80];
+
+ XFASTINT (minspace) = 1;
+
+ set_buffer_internal (XBUFFER (Vstandard_output));
+ Fbuffer_flush_undo (Vstandard_output);
+
+ current_buffer->truncate_lines = Qt;
+
+ write_string ("\
+Proc Status Buffer Command\n\
+---- ------ ------ -------\n", -1);
+
+ for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
+ {
+ Lisp_Object symbol;
+
+ proc = Fcdr (Fcar (tail));
+ p = XPROCESS (proc);
+ if (NULL (p->childp))
+ continue;
+
+ Finsert (1, &p->name);
+ Findent_to (make_number (13), minspace);
+
+ if (!NULL (p->raw_status_low))
+ update_status (p);
+ symbol = p->status;
+ if (XTYPE (p->status) == Lisp_Cons)
+ symbol = XCONS (p->status)->car;
+
+ if (EQ (symbol, Qsignal))
+ {
+ Lisp_Object tem;
+ tem = Fcar (Fcdr (p->status));
+ if (XINT (tem) < NSIG)
+ write_string (sys_siglist [XINT (tem)], -1);
+ else
+ Fprinc (symbol, Qnil);
+ }
+ else if (NETCONN_P (proc))
+ {
+ if (EQ (symbol, Qrun))
+ write_string ("open", -1);
+ else if (EQ (symbol, Qexit))
+ write_string ("closed", -1);
+ else
+ Fprinc (symbol, Qnil);
+ }
+ else
+ Fprinc (symbol, Qnil);
+
+ if (EQ (symbol, Qexit))
+ {
+ Lisp_Object tem;
+ tem = Fcar (Fcdr (p->status));
+ if (XFASTINT (tem))
+ {
+ sprintf (tembuf, " %d", XFASTINT (tem));
+ write_string (tembuf, -1);
+ }
+ }
+
+ if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
+ remove_process (proc);
+
+ Findent_to (make_number (22), minspace);
+ if (NULL (p->buffer))
+ InsStr ("(none)");
+ else if (NULL (XBUFFER (p->buffer)->name))
+ InsStr ("(Killed)");
+ else
+ Finsert (1, &XBUFFER (p->buffer)->name);
+
+ Findent_to (make_number (37), minspace);
+
+ if (NETCONN_P (proc))
+ {
+ sprintf (tembuf, "(network stream connection to %s)\n",
+ XSTRING (p->childp)->data);
+ InsStr (tembuf);
+ }
+ else
+ {
+ tem = p->command;
+ while (1)
+ {
+ tem1 = Fcar (tem);
+ Finsert (1, &tem1);
+ tem = Fcdr (tem);
+ if (NULL (tem))
+ break;
+ InsStr (" ");
+ }
+ InsStr ("\n");
+ }
+ }
+
+ return Qnil;
+}
+
+DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "",
+ "Display a list of all processes.\n\
+\(Any processes listed as Exited or Signaled are actually eliminated\n\
+after the listing is made.)")
+ ()
+{
+ internal_with_output_to_temp_buffer ("*Process List*",
+ list_processes_1, Qnil);
+ return Qnil;
+}
+
+DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
+ "Return a list of all processes.")
+ ()
+{
+ return Fmapcar (Qcdr, Vprocess_alist);
+}
+
+DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
+ "Start a program in a subprocess. Return the process object for it.\n\
+Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS\n\
+NAME is name for process. It is modified if necessary to make it unique.\n\
+BUFFER is the buffer or (buffer-name) to associate with the process.\n\
+ Process output goes at end of that buffer, unless you specify\n\
+ an output stream or filter function to handle the output.\n\
+ BUFFER may be also nil, meaning that this process is not associated\n\
+ with any buffer\n\
+Third arg is program file name. It is searched for as in the shell.\n\
+Remaining arguments are strings to give program as arguments.")
+ (nargs, args)
+ int nargs;
+ register Lisp_Object *args;
+{
+ Lisp_Object buffer, name, program, proc, tem;
+ register unsigned char **new_argv;
+ register int i;
+
+ buffer = args[1];
+ if (!NULL (buffer))
+ buffer = Fget_buffer_create (buffer);
+
+ name = args[0];
+ CHECK_STRING (name, 0);
+
+ program = args[2];
+
+ CHECK_STRING (program, 2);
+
+ new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
+
+ for (i = 3; i < nargs; i++)
+ {
+ tem = args[i];
+ CHECK_STRING (tem, i);
+ new_argv[i - 2] = XSTRING (tem)->data;
+ }
+ new_argv[i - 2] = 0;
+ new_argv[0] = XSTRING (program)->data;
+
+ /* If program file name is not absolute, search our path for it */
+ if (new_argv[0][0] != '/')
+ {
+ tem = Qnil;
+ openp (Vexec_path, program, "", &tem, 1);
+ if (NULL (tem))
+ report_file_error ("Searching for program", Fcons (program, Qnil));
+ new_argv[0] = XSTRING (tem)->data;
+ }
+
+ proc = make_process (name);
+
+ XPROCESS (proc)->childp = Qt;
+ XPROCESS (proc)->command_channel_p = Qnil;
+ XPROCESS (proc)->buffer = buffer;
+ XPROCESS (proc)->sentinel = Qnil;
+ XPROCESS (proc)->filter = Qnil;
+ XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
+
+ create_process (proc, new_argv);
+
+ return proc;
+}
+
+create_process_1 (signo)
+ int signo;
+{
+#ifdef USG
+ /* USG systems forget handlers when they are used;
+ must reestablish each time */
+ signal (signo, create_process_1);
+#endif /* USG */
+}
+
+#if 0 /* This doesn't work; see the note before sigchld_handler. */
+#ifdef USG
+#ifdef SIGCHLD
+/* Mimic blocking of signals on system V, which doesn't really have it. */
+
+/* Nonzero means we got a SIGCHLD when it was supposed to be blocked. */
+int sigchld_deferred;
+
+create_process_sigchld ()
+{
+ signal (SIGCHLD, create_process_sigchld);
+
+ sigchld_deferred = 1;
+}
+#endif
+#endif
+#endif
+
+create_process (process, new_argv)
+ Lisp_Object process;
+ char **new_argv;
+{
+ int pid, inchannel, outchannel, forkin, forkout;
+ int sv[2];
+#ifdef SIGCHLD
+ int (*sigchld)();
+#endif
+ char **env;
+ int pty_flag = 0;
+ extern char **environ;
+
+#ifdef MAINTAIN_ENVIRONMENT
+ env = (char **) alloca (size_of_current_environ ());
+ get_current_environ (env);
+#else
+ env = environ;
+#endif /* MAINTAIN_ENVIRONMENT */
+
+ inchannel = outchannel = -1;
+
+#ifdef HAVE_PTYS
+ if (EQ (Vprocess_connection_type, Qt))
+ outchannel = inchannel = allocate_pty ();
+
+ if (inchannel >= 0)
+ {
+#ifndef USG
+ /* On USG systems it does not work to open
+ the pty's tty here and then close and reopen it in the child. */
+#ifdef O_NOCTTY
+ /* Don't let this terminal become our controlling terminal
+ (in case we don't have one). */
+ forkout = forkin = open (pty_name, O_RDWR | O_NOCTTY, 0);
+#else
+ forkout = forkin = open (pty_name, O_RDWR, 0);
+#endif
+ if (forkin < 0)
+ report_file_error ("Opening pty", Qnil);
+#else
+ forkin = forkout = -1;
+#endif
+ pty_flag = 1;
+ }
+ else
+#endif /* HAVE_PTYS */
+#ifdef SKTPAIR
+ {
+ if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0)
+ report_file_error ("Opening socketpair", Qnil);
+ outchannel = inchannel = sv[0];
+ forkout = forkin = sv[1];
+ }
+#else /* not SKTPAIR */
+ {
+ int temp;
+ temp = pipe (sv);
+ if (temp < 0) goto io_failure;
+ inchannel = sv[0];
+ forkout = sv[1];
+ temp = pipe (sv);
+ if (temp < 0) goto io_failure;
+ outchannel = sv[1];
+ forkin = sv[0];
+ }
+#endif /* not SKTPAIR */
+
+#if 0
+ /* Replaced by close_process_descs */
+ set_exclusive_use (inchannel);
+ set_exclusive_use (outchannel);
+#endif
+
+/* Stride people say it's a mystery why this is needed
+ as well as the O_NDELAY, but that it fails without this. */
+#if defined (STRIDE) || (defined (pfa) && defined (HAVE_PTYS))
+ {
+ int one = 1;
+ ioctl (inchannel, FIONBIO, &one);
+ }
+#endif
+
+#ifdef O_NONBLOCK
+ fcntl (inchannel, F_SETFL, O_NONBLOCK);
+#else
+#ifdef O_NDELAY
+ fcntl (inchannel, F_SETFL, O_NDELAY);
+#endif
+#endif
+
+ XFASTINT (XPROCESS (process)->infd) = inchannel;
+ XFASTINT (XPROCESS (process)->outfd) = outchannel;
+ /* Record the tty descriptor used in the subprocess. */
+#ifdef SYSV4_PTYS
+ /* On system V.4, if using a pty, we need to keep a descriptor
+ for the tty that the inferior uses, in order to get the pgrp.
+ If this uses too many descriptors, we could instead save the tty name
+ and reopen it to send signals. */
+ if (pty_flag)
+ {
+ int temp = dup (forkin);
+ if (temp < 0) goto io_failure;
+ XFASTINT (XPROCESS (process)->subtty) = temp;
+ }
+ else
+#endif
+ XPROCESS (process)->subtty = Qnil;
+ XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
+ XPROCESS (process)->status = Qrun;
+ /* Record this as an active process, with its channels.
+ As a result, child_setup will close Emacs's side of the pipes. */
+ chan_process[inchannel] = process;
+
+ /* Delay interrupts until we have a chance to store
+ the new fork's pid in its process structure */
+#ifdef SIGCHLD
+#ifdef BSD4_1
+ sighold (SIGCHLD);
+#else /* not BSD4_1 */
+#ifdef HPUX
+ sigsetmask (sigmask (SIGCHLD));
+#else /* not HPUX */
+#if defined (BSD) || defined (UNIPLUS)
+ sigsetmask (sigmask (SIGCHLD));
+#else /* ordinary USG */
+#if 0
+ sigchld_deferred = 0;
+ sigchld = (int (*)()) signal (SIGCHLD, create_process_sigchld);
+#endif
+#endif /* ordinary USG */
+#endif /* not HPUX */
+#endif /* not BSD4_1 */
+#endif /* SIGCHLD */
+
+ /* Until we store the proper pid, enable sigchld_handler
+ to recognize an unknown pid as standing for this process. */
+ XSETINT (XPROCESS (process)->pid, -1);
+ /* Turn on the bit for our input from this process now,
+ so that even if the process terminates very soon,
+ we can clear the bit properly on termination.
+ If fork fails, remove_process will clear the bit. */
+ FD_SET (inchannel, &input_wait_mask);
+
+ {
+ /* child_setup must clobber environ on systems with true vfork.
+ Protect it from permanent change. */
+ char **save_environ = environ;
+
+ pid = vfork ();
+ if (pid == 0)
+ {
+ int xforkin = forkin;
+ int xforkout = forkout;
+
+#if 0 /* This was probably a mistake--it duplicates code later on,
+ but fails to handle all the cases. */
+ /* Make SIGCHLD work again in the child. */
+ sigsetmask (SIGEMPTYMASK);
+#endif
+
+ /* Make the pty be the controlling terminal of the process. */
+#ifdef HAVE_PTYS
+ /* First, disconnect its current controlling terminal. */
+#ifdef HAVE_SETSID
+ setsid ();
+#ifdef TIOCSCTTY
+ /* Make the pty's terminal the controlling terminal. */
+ if (pty_flag && (ioctl (xforkin, TIOCSCTTY, 0) < 0))
+ abort ();
+#endif
+#else /* not HAVE_SETSID */
+#ifdef USG
+ /* It's very important to call setpgrp() here and no time
+ afterwards. Otherwise, we lose our controlling tty which
+ is set when we open the pty. */
+ setpgrp ();
+#endif /* USG */
+#endif /* not HAVE_SETSID */
+#ifdef TIOCNOTTY
+ /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
+ can do TIOCSPGRP only to the process's controlling tty. */
+ if (pty_flag)
+ {
+ /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
+ I can't test it since I don't have 4.3. */
+ int j = open ("/dev/tty", O_RDWR, 0);
+ ioctl (j, TIOCNOTTY, 0);
+ close (j);
+#ifndef USG
+ /* In order to get a controlling terminal on some versions
+ of BSD, it is necessary to put the process in pgrp 0
+ before it opens the terminal. */
+ setpgrp (0, 0);
+#endif
+ }
+#endif /* TIOCNOTTY */
+
+#if !defined (RTU) && !defined (UNIPLUS)
+/*** There is a suggestion that this ought to be a
+ conditional on TIOCSPGRP. */
+ /* Now close the pty (if we had it open) and reopen it.
+ This makes the pty the controlling terminal of the subprocess. */
+ if (pty_flag)
+ {
+ /* I wonder if close (open (pty_name, ...)) would work? */
+ if (xforkin >= 0)
+ close (xforkin);
+ xforkout = xforkin = open (pty_name, O_RDWR, 0);
+
+ if (xforkin < 0)
+ abort ();
+ }
+#endif /* not UNIPLUS and not RTU */
+#ifdef SETUP_SLAVE_PTY
+ if (pty_flag)
+ {
+ SETUP_SLAVE_PTY;
+ }
+#endif /* SETUP_SLAVE_PTY */
+#ifdef AIX
+ /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
+ Now reenable it in the child, so it will die when we want it to. */
+ if (pty_flag)
+ signal (SIGHUP, SIG_DFL);
+#endif
+#endif /* HAVE_PTYS */
+#ifdef SIGCHLD
+#ifdef BSD4_1
+ sigrelse (SIGCHLD);
+#else /* not BSD4_1 */
+#if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
+ sigsetmask (SIGEMPTYMASK);
+#else /* ordinary USG */
+#if 0
+ signal (SIGCHLD, sigchld);
+#endif
+#endif /* ordinary USG */
+#endif /* not BSD4_1 */
+#endif /* SIGCHLD */
+ if (pty_flag)
+ child_setup_tty (xforkout);
+ child_setup (xforkin, xforkout, xforkout, new_argv, env);
+ }
+ environ = save_environ;
+ }
+
+ if (pid < 0)
+ {
+ remove_process (process);
+ report_file_error ("Doing vfork", Qnil);
+ }
+
+ XFASTINT (XPROCESS (process)->pid) = pid;
+
+ /* If the subfork execv fails, and it exits,
+ this close hangs. I don't know why.
+ So have an interrupt jar it loose. */
+ stop_polling ();
+ signal (SIGALRM, create_process_1);
+ alarm (1);
+ if (forkin >= 0)
+ close (forkin);
+ alarm (0);
+ start_polling ();
+ if (forkin != forkout && forkout >= 0)
+ close (forkout);
+
+#ifdef SIGCHLD
+#ifdef BSD4_1
+ sigrelse (SIGCHLD);
+#else /* not BSD4_1 */
+#if defined (BSD) || defined (UNIPLUS) || defined (HPUX)
+ sigsetmask (SIGEMPTYMASK);
+#else /* ordinary USG */
+#if 0
+ signal (SIGCHLD, sigchld);
+ /* Now really handle any of these signals
+ that came in during this function. */
+ if (sigchld_deferred)
+ kill (getpid (), SIGCHLD);
+#endif
+#endif /* ordinary USG */
+#endif /* not BSD4_1 */
+#endif /* SIGCHLD */
+ return;
+
+io_failure:
+ {
+ int temp = errno;
+ close (forkin);
+ close (forkout);
+ close (inchannel);
+ close (outchannel);
+ errno = temp;
+ report_file_error ("Opening pty or pipe", Qnil);
+ }
+}
+
+#ifdef HAVE_SOCKETS
+
+/* open a TCP network connection to a given HOST/SERVICE. Treated
+ exactly like a normal process when reading and writing. Only
+ differences are in status display and process deletion. A network
+ connection has no PID; you cannot signal it. All you can do is
+ deactivate and close it via delete-process */
+
+DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
+ 4, 4, 0,
+ "Open a TCP connection for a service to a host.\n\
+Returns a subprocess-object to represent the connection.\n\
+Input and output work as for subprocesses; `delete-process' closes it.\n\
+Args are NAME BUFFER HOST SERVICE.\n\
+NAME is name for process. It is modified if necessary to make it unique.\n\
+BUFFER is the buffer (or buffer-name) to associate with the process.\n\
+ Process output goes at end of that buffer, unless you specify\n\
+ an output stream or filter function to handle the output.\n\
+ BUFFER may be also nil, meaning that this process is not associated\n\
+ with any buffer\n\
+Third arg is name of the host to connect to.\n\
+Fourth arg SERVICE is name of the service desired, or an integer\n\
+ specifying a port number to connect to.")
+ (name, buffer, host, service)
+ Lisp_Object name, buffer, host, service;
+{
+ Lisp_Object proc;
+ register int i;
+ struct sockaddr_in address;
+ struct servent *svc_info;
+ struct hostent *host_info;
+ int s, outch, inch;
+ char errstring[80];
+ int port;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ GCPRO4 (name, buffer, host, service);
+ CHECK_STRING (name, 0);
+ CHECK_STRING (host, 0);
+ if (XTYPE (service) == Lisp_Int)
+ port = htons ((unsigned short) XINT (service));
+ else
+ {
+ CHECK_STRING (service, 0);
+ svc_info = getservbyname (XSTRING (service)->data, "tcp");
+ if (svc_info == 0)
+ error ("Unknown service \"%s\"", XSTRING (service)->data);
+ port = svc_info->s_port;
+ }
+
+ bzero (&address, sizeof address);
+ address.sin_addr.s_addr = inet_addr (XSTRING (host)->data);
+ if (address.sin_addr.s_addr != -1)
+ address.sin_family = AF_INET;
+ else
+ {
+ host_info = gethostbyname (XSTRING (host)->data);
+ if (host_info == 0)
+ error ("Unknown host \"%s\"", XSTRING (host)->data);
+ bcopy (host_info->h_addr, (char *) &address.sin_addr, host_info->h_length);
+ address.sin_family = host_info->h_addrtype;
+ }
+ address.sin_port = port;
+
+ s = socket (address.sin_family, SOCK_STREAM, 0);
+ if (s < 0)
+ report_file_error ("error creating socket", Fcons (name, Qnil));
+
+ /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
+ when connect is interrupted. So let's not let it get interrupted. */
+ if (interrupt_input)
+ unrequest_sigio ();
+ stop_polling ();
+
+ while (1)
+ {
+ int value = connect (s, &address, sizeof address);
+ /* Continue if successeful. */
+ if (value != -1)
+ break;
+ /* Report a "real" error. */
+ if (errno != EINTR)
+ {
+ close (s);
+ error ("Host \"%s\" not responding", XSTRING (host)->data);
+ }
+ /* Loop around after temporary error. */
+ }
+
+ if (interrupt_input)
+ request_sigio ();
+ start_polling ();
+
+ inch = s;
+ outch = dup (s);
+ if (outch < 0)
+ report_file_error ("error duplicating socket", Fcons (name, Qnil));
+
+ if (!NULL (buffer))
+ buffer = Fget_buffer_create (buffer);
+ proc = make_process (name);
+
+ chan_process[inch] = proc;
+
+#ifdef O_NONBLOCK
+ fcntl (inch, F_SETFL, O_NONBLOCK);
+#else
+#ifdef O_NDELAY
+ fcntl (inch, F_SETFL, O_NDELAY);
+#endif
+#endif
+
+ XPROCESS (proc)->childp = host;
+ XPROCESS (proc)->command_channel_p = Qnil;
+ XPROCESS (proc)->buffer = buffer;
+ XPROCESS (proc)->sentinel = Qnil;
+ XPROCESS (proc)->filter = Qnil;
+ XPROCESS (proc)->command = Qnil;
+ XPROCESS (proc)->pid = Qnil;
+ XPROCESS (proc)->kill_without_query = Qt;
+ XFASTINT (XPROCESS (proc)->infd) = s;
+ XFASTINT (XPROCESS (proc)->outfd) = outch;
+ XPROCESS (proc)->status = Qrun;
+ FD_SET (inch, &input_wait_mask);
+
+ UNGCPRO;
+ return proc;
+}
+#endif /* HAVE_SOCKETS */
+
+deactivate_process (proc)
+ Lisp_Object proc;
+{
+ register int inchannel, outchannel;
+ register struct Lisp_Process *p = XPROCESS (proc);
+
+ inchannel = XFASTINT (p->infd);
+ outchannel = XFASTINT (p->outfd);
+
+ if (inchannel)
+ {
+ /* Beware SIGCHLD hereabouts. */
+ flush_pending_output (inchannel);
+ close (inchannel);
+ if (outchannel && outchannel != inchannel)
+ close (outchannel);
+
+ XFASTINT (p->infd) = 0;
+ XFASTINT (p->outfd) = 0;
+ chan_process[inchannel] = Qnil;
+ FD_CLR (inchannel, &input_wait_mask);
+ }
+}
+
+/* Close all descriptors currently in use for communication
+ with subprocess. This is used in a newly-forked subprocess
+ to get rid of irrelevant descriptors. */
+
+close_process_descs ()
+{
+ int i;
+ for (i = 0; i < MAXDESC; i++)
+ {
+ Lisp_Object process;
+ process = chan_process[i];
+ if (!NULL (process))
+ {
+ int in = XFASTINT (XPROCESS (process)->infd);
+ int out = XFASTINT (XPROCESS (process)->outfd);
+
+ if (in != 0)
+ close (in);
+ if (out != 0 && out != in)
+ close (out);
+ if (!NULL (XPROCESS (process)->subtty))
+ close (XFASTINT (XPROCESS (process)->subtty));
+ }
+ }
+}
+
+DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
+ 0, 1, 0,
+ "Allow any pending output from subprocesses to be read by Emacs.\n\
+It is read into the process' buffers or given to their filter functions.\n\
+Non-nil arg PROCESS means do not return until some output has been received\n\
+from PROCESS.")
+ (proc)
+ register Lisp_Object proc;
+{
+ if (NULL (proc))
+ wait_reading_process_input (-1, 0, 0);
+ else
+ {
+ proc = get_process (proc);
+ wait_reading_process_input (0, XPROCESS (proc), 0);
+ }
+ return Qnil;
+}
+
+/* This variable is different from waiting_for_input in keyboard.c.
+ It is used to communicate to a lisp process-filter/sentinel (via the
+ function Fwaiting_for_user_input_p below) whether emacs was waiting
+ for user-input when that process-filter was called.
+ waiting_for_input cannot be used as that is by definition 0 when
+ lisp code is being evalled */
+static int waiting_for_user_input_p;
+
+/* Read and dispose of subprocess output
+ while waiting for timeout to elapse and/or keyboard input to be available.
+
+ time_limit is the timeout in seconds, or zero for no limit.
+ -1 means gobble data available immediately but don't wait for any.
+
+ read_kbd is 1 to return when input is available.
+ -1 means caller will actually read the input.
+ A pointer to a struct Lisp_Process means wait until
+ something arrives from that process.
+
+ do_display means redisplay should be done to show
+ subprocess output that arrives. */
+
+wait_reading_process_input (time_limit, read_kbd, do_display)
+ int time_limit, read_kbd, do_display;
+{
+ register int channel, nfds, m;
+ SELECT_TYPE Available;
+ SELECT_TYPE Exception;
+ int xerrno;
+ Lisp_Object proc;
+#ifdef HAVE_TIMEVAL
+ struct timeval timeout, end_time, garbage;
+#else
+ long timeout, end_time, temp;
+#endif /* not HAVE_TIMEVAL */
+ SELECT_TYPE Atemp;
+ int wait_channel = 0;
+ struct Lisp_Process *wait_proc = 0;
+ extern kbd_count;
+
+ /* Detect when read_kbd is really the address of a Lisp_Process. */
+ if (read_kbd > 10 || read_kbd < -1)
+ {
+ wait_proc = (struct Lisp_Process *) read_kbd;
+ wait_channel = XFASTINT (wait_proc->infd);
+ read_kbd = 0;
+ }
+ waiting_for_user_input_p = read_kbd;
+
+ /* Since we may need to wait several times,
+ compute the absolute time to return at. */
+ if (time_limit)
+ {
+#ifdef HAVE_TIMEVAL
+ gettimeofday (&end_time, &garbage);
+ end_time.tv_sec += time_limit;
+#else /* not HAVE_TIMEVAL */
+ time (&end_time);
+ end_time += time_limit;
+#endif /* not HAVE_TIMEVAL */
+ }
+
+#if 0 /* Select emulator claims to preserve alarms.
+ And there are many ways to get out of this function by longjmp. */
+ /* Turn off periodic alarms (in case they are in use)
+ because the select emulator uses alarms. */
+ stop_polling ();
+#endif
+
+ while (1)
+ {
+ /* If calling from keyboard input, do not quit
+ since we want to return C-g as an input character.
+ Otherwise, do pending quit if requested. */
+ if (read_kbd >= 0)
+ {
+#if 0
+ /* This is the same condition tested by QUIT.
+ We need to resume polling if we are going to quit. */
+ if (!NULL (Vquit_flag) && NULL (Vinhibit_quit))
+ {
+ start_polling ();
+ QUIT;
+ }
+#endif
+ QUIT;
+ }
+
+ /* If status of something has changed, and no input is available,
+ notify the user of the change right away */
+ if (update_tick != process_tick && do_display)
+ {
+ Atemp = input_wait_mask;
+#ifdef HAVE_TIMEVAL
+ timeout.tv_sec=0; timeout.tv_usec=0;
+#else /* not HAVE_TIMEVAL */
+ timeout = 0;
+#endif /* not HAVE_TIMEVAL */
+ if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
+ status_notify ();
+ }
+
+ /* Don't wait for output from a non-running process. */
+ if (wait_proc != 0 && !NULL (wait_proc->raw_status_low))
+ update_status (wait_proc);
+ if (wait_proc != 0
+ && ! EQ (wait_proc->status, Qrun))
+ break;
+
+ if (fix_screen_hook)
+ (*fix_screen_hook) ();
+
+ /* Compute time from now till when time limit is up */
+ /* Exit if already run out */
+ if (time_limit == -1)
+ {
+ /* -1 specified for timeout means
+ gobble output available now
+ but don't wait at all. */
+#ifdef HAVE_TIMEVAL
+ timeout.tv_sec = 0;
+ timeout.tv_usec = 0;
+#else
+ timeout = 0;
+#endif /* not HAVE_TIMEVAL */
+ }
+ else if (time_limit)
+ {
+#ifdef HAVE_TIMEVAL
+ gettimeofday (&timeout, &garbage);
+
+ /* In effect, timeout = end_time - timeout.
+ Break if result would be negative. */
+ if (timeval_subtract (&timeout, end_time, timeout))
+ break;
+#else /* not HAVE_TIMEVAL */
+ time (&temp);
+ timeout = end_time - temp;
+ if (timeout < 0)
+ break;
+#endif /* not HAVE_TIMEVAL */
+ }
+ else
+ {
+#ifdef HAVE_TIMEVAL
+ /* If no real timeout, loop sleeping with a big timeout
+ so that input interrupt can wake us up by zeroing it */
+ timeout.tv_sec = 100;
+ timeout.tv_usec = 0;
+#else /* not HAVE_TIMEVAL */
+ timeout = 100000; /* 100000 recognized by the select emulator */
+#endif /* not HAVE_TIMEVAL */
+ }
+
+ /* Cause quitting and alarm signals to take immediate action,
+ and cause input available signals to zero out timeout */
+ if (read_kbd < 0)
+ set_waiting_for_input (&timeout);
+
+ /* Wait till there is something to do */
+
+ Available = Exception = input_wait_mask;
+ if (!read_kbd)
+ FD_CLR (0, &Available);
+
+ if (read_kbd && kbd_count)
+ nfds = 0;
+ else
+ /* Since we don't do anything abt Exceptions,
+ let's notw wake up for them. */
+ nfds = select (MAXDESC, &Available, 0, 0, &timeout);
+#if 0
+#ifdef IBMRTAIX
+ nfds = select (MAXDESC, &Available, 0, 0, &timeout);
+#else
+#ifdef HPUX
+ nfds = select (MAXDESC, &Available, 0, 0, &timeout);
+#else
+ nfds = select (MAXDESC, &Available, 0, &Exception, &timeout);
+#endif
+#endif
+#endif /* 0 */
+ xerrno = errno;
+
+ if (fix_screen_hook)
+ (*fix_screen_hook) ();
+
+ /* Make C-g and alarm signals set flags again */
+ clear_waiting_for_input ();
+
+ /* If we woke up due to SIGWINCH, actually change size now. */
+ if (read_kbd)
+ do_pending_window_change ();
+
+ if (time_limit && nfds == 0) /* timeout elapsed */
+ break;
+ if (nfds < 0)
+ {
+ if (xerrno == EINTR)
+ FD_ZERO (&Available);
+#ifdef ALLIANT
+ /* This happens for no known reason on ALLIANT.
+ I am guessing that this is the right response. -- RMS. */
+ else if (xerrno == EFAULT)
+ FD_ZERO (&Available);
+#endif
+ else if (xerrno == EBADF)
+#ifdef AIX
+ /* AIX will return EBADF on a call to select involving a ptc if the
+ associated pts isn't open. Since this will only happen just as
+ a child is dying, just ignore the situation -- SIGCHLD will come
+ along quite quickly, and after cleanup the ptc will no longer be
+ checked, so this error will stop recurring. */
+ FD_ZERO (&Available); /* Cannot depend on values returned. */
+#else /* not AIX */
+ abort ();
+#endif /* not AIX */
+ else
+ error("select error: %s", sys_errlist[xerrno]);
+ }
+#ifdef SIGIO
+#if defined (sun) || defined (APOLLO)
+ else if (nfds > 0 && FD_ISSET (0, &Available) && interrupt_input)
+ /* System sometimes fails to deliver SIGIO. */
+ kill (getpid (), SIGIO);
+#endif
+#endif
+
+ /* Check for keyboard input */
+ /* If there is any, return immediately
+ to give it higher priority than subprocesses */
+
+ if (read_kbd && detect_input_pending ())
+ break;
+
+ /* If checking input just got us a size-change event from X,
+ obey it now if we should. */
+ if (read_kbd)
+ do_pending_window_change ();
+
+ /* If screen size has changed, redisplay now
+ for either sit-for or keyboard input. */
+ if (read_kbd && screen_garbaged)
+ redisplay_preserve_echo_area ();
+
+#ifdef vipc
+ /* Check for connection from other process */
+
+ if (FD_ISSET (comm_server, &Available))
+ {
+ FD_CLR (comm_server, &Available);
+ create_commchan ();
+ }
+#endif /* vipc */
+
+ /* Check for data from a process or a command channel */
+
+ for (channel = 3; channel < MAXDESC; channel++)
+ {
+ if (FD_ISSET (channel, &Available))
+ {
+ int nread;
+
+ FD_CLR (channel, &Available);
+ /* If waiting for this channel,
+ arrange to return as soon as no more input
+ to be processed. No more waiting. */
+ if (wait_channel == channel)
+ {
+ wait_channel = 0;
+ time_limit = -1;
+ }
+ proc = chan_process[channel];
+ if (NULL (proc))
+ continue;
+
+#ifdef vipc
+ /* It's a command channel */
+ if (!NULL (XPROCESS (proc)->command_channel_p))
+ {
+ ProcessCommChan (channel, proc);
+ if (NULL (XPROCESS (proc)->command_channel_p))
+ {
+ /* It has ceased to be a command channel! */
+ int bytes_available;
+ if (ioctl (channel, FIONREAD, &bytes_available) < 0)
+ bytes_available = 0;
+ if (bytes_available)
+ FD_SET (channel, &Available);
+ }
+ continue;
+ }
+#endif /* vipc */
+
+ /* Read data from the process, starting with our
+ buffered-ahead character if we have one. */
+
+ nread = read_process_output (proc, channel);
+ if (nread > 0)
+ {
+ /* Since read_process_output can run a filter,
+ which can call accept-process-output,
+ don't try to read from any other processes
+ before doing the select again. */
+ FD_ZERO (&Available);
+
+ if (do_display)
+ redisplay_preserve_echo_area ();
+ }
+#ifdef EWOULDBLOCK
+ else if (nread == -1 && errno == EWOULDBLOCK)
+ ;
+#else
+#ifdef O_NONBLOCK
+ else if (nread == -1 && errno == EAGAIN)
+ ;
+#else
+#ifdef O_NDELAY
+ else if (nread == -1 && errno == EAGAIN)
+ ;
+ /* Note that we cannot distinguish between no input
+ available now and a closed pipe.
+ With luck, a closed pipe will be accompanied by
+ subprocess termination and SIGCHLD. */
+ else if (nread == 0 && !NETCONN_P (proc))
+ ;
+#endif /* O_NDELAY */
+#endif /* O_NONBLOCK */
+#endif /* EWOULDBLOCK */
+#ifdef HAVE_PTYS
+ /* On some OSs with ptys, when the process on one end of
+ a pty exits, the other end gets an error reading with
+ errno = EIO instead of getting an EOF (0 bytes read).
+ Therefore, if we get an error reading and errno =
+ EIO, just continue, because the child process has
+ exited and should clean itself up soon (e.g. when we
+ get a SIGCHLD). */
+ else if (nread == -1 && errno == EIO && !NETCONN_P (proc))
+ ;
+#endif /* HAVE_PTYS */
+/* If we can detect process termination, don't consider the process
+ gone just because its pipe is closed. */
+#ifdef SIGCHLD
+ else if (nread == 0 && !NETCONN_P (proc))
+ ;
+#endif
+ else
+ {
+ /* Preserve status of processes already terminated. */
+ XSETINT (XPROCESS (proc)->tick, ++process_tick);
+ deactivate_process (proc);
+ if (!NULL (XPROCESS (proc)->raw_status_low))
+ update_status (XPROCESS (proc));
+ if (EQ (XPROCESS (proc)->status, Qrun))
+ XPROCESS (proc)->status
+ = Fcons (Qexit, Fcons (make_number (256), Qnil));
+ }
+ }
+ } /* end for */
+ } /* end while */
+
+ /* If calling from keyboard input, do not quit
+ since we want to return C-g as an input character.
+ Otherwise, do pending quit if requested. */
+ if (read_kbd >= 0)
+ {
+ /* Prevent input_pending from remaining set if we quit. */
+ clear_input_pending ();
+ QUIT;
+ }
+}
+
+/* Actually call the filter. This gets the information via variables
+ because internal_condition_case won't pass arguments. */
+
+Lisp_Object
+run_filter ()
+{
+ return call2 (this_filter, filter_process, filter_string);
+}
+
+/* Read pending output from the process channel,
+ starting with our buffered-ahead character if we have one.
+ Yield number of characters read.
+
+ This function reads at most 1024 characters.
+ If you want to read all available subprocess output,
+ you must call it repeatedly until it returns zero. */
+
+read_process_output (proc, channel)
+ Lisp_Object proc;
+ register int channel;
+{
+ register int nchars;
+ char chars[1024];
+ register Lisp_Object outstream;
+ register struct buffer *old = current_buffer;
+ register struct Lisp_Process *p = XPROCESS (proc);
+ register int opoint;
+
+ if (proc_buffered_char[channel] < 0)
+ nchars = read (channel, chars, sizeof chars);
+ else
+ {
+ chars[0] = proc_buffered_char[channel];
+ proc_buffered_char[channel] = -1;
+ nchars = read (channel, chars + 1, sizeof chars - 1);
+ if (nchars < 0)
+ nchars = 1;
+ else
+ nchars = nchars + 1;
+ }
+
+ if (nchars <= 0) return nchars;
+
+ outstream = p->filter;
+ if (!NULL (outstream))
+ {
+ int count = specpdl_ptr - specpdl;
+ specbind (Qinhibit_quit, Qt);
+ this_filter = outstream;
+ filter_process = proc;
+ filter_string = make_string (chars, nchars);
+ call2 (this_filter, filter_process, filter_string);
+ /* internal_condition_case (run_filter, Qerror, Fidentity); */
+ unbind_to (count);
+ return nchars;
+ }
+
+ /* If no filter, write into buffer if it isn't dead. */
+ if (!NULL (p->buffer) && !NULL (XBUFFER (p->buffer)->name))
+ {
+ Lisp_Object tem;
+
+ Fset_buffer (p->buffer);
+ opoint = point;
+
+ /* Insert new output into buffer
+ at the current end-of-output marker,
+ thus preserving logical ordering of input and output. */
+ if (XMARKER (p->mark)->buffer)
+ SET_PT (marker_position (p->mark));
+ else
+ SET_PT (ZV);
+ if (point <= opoint)
+ opoint += nchars;
+
+ tem = current_buffer->read_only;
+ current_buffer->read_only = Qnil;
+ insert (chars, nchars);
+ current_buffer->read_only = tem;
+ Fset_marker (p->mark, make_number (point), p->buffer);
+ update_mode_lines++;
+
+ SET_PT (opoint);
+ set_buffer_internal (old);
+ }
+ return nchars;
+}
+
+DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p,
+ 0, 0, 0,
+ "Returns non-NIL if emacs is waiting for input from the user.\n\
+This is intended for use by asynchronous process output filters and sentinels.")
+ ()
+{
+ return ((waiting_for_user_input_p) ? Qt : Qnil);
+}
+
+/* Sending data to subprocess */
+
+jmp_buf send_process_frame;
+
+send_process_trap ()
+{
+#ifdef BSD4_1
+ sigrelse (SIGPIPE);
+ sigrelse (SIGALRM);
+#endif /* BSD4_1 */
+ longjmp (send_process_frame, 1);
+}
+
+send_process (proc, buf, len)
+ Lisp_Object proc;
+ char *buf;
+ int len;
+{
+ /* Don't use register vars; longjmp can lose them. */
+ int rv;
+ unsigned char *procname = XSTRING (XPROCESS (proc)->name)->data;
+
+ if (!NULL (XPROCESS (proc)->raw_status_low))
+ update_status (XPROCESS (proc));
+ if (! EQ (XPROCESS (proc)->status, Qrun))
+ error ("Process %s not running", procname);
+
+ if (!setjmp (send_process_frame))
+ while (len > 0)
+ {
+ signal (SIGPIPE, send_process_trap);
+ rv = write (XFASTINT (XPROCESS (proc)->outfd), buf, len);
+ signal (SIGPIPE, SIG_DFL);
+ if (rv < 0)
+ {
+ if (0
+#ifdef EWOULDBLOCK
+ || errno == EWOULDBLOCK
+#endif
+#ifdef EAGAIN
+ || errno == EAGAIN
+#endif
+ )
+ {
+ /* It would be nice to accept process output here,
+ but that is difficult. For example, it could
+ garbage what we are sending if that is from a buffer. */
+ immediate_quit = 1;
+ QUIT;
+ sleep (1);
+ immediate_quit = 0;
+ continue;
+ }
+ report_file_error ("writing to process", Fcons (proc, Qnil));
+ }
+ buf += rv;
+ len -= rv;
+ }
+ else
+ {
+ XPROCESS (proc)->raw_status_low = Qnil;
+ XPROCESS (proc)->raw_status_high = Qnil;
+ XPROCESS (proc)->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
+ XSETINT (XPROCESS (proc)->tick, ++process_tick);
+ deactivate_process (proc);
+ error ("SIGPIPE raised on process %s; closed it", procname);
+ }
+}
+
+DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
+ 3, 3, 0,
+ "Send current contents of region as input to PROCESS.\n\
+PROCESS may be a process name.\n\
+Called from program, takes three arguments, PROCESS, START and END.")
+ (process, start, end)
+ Lisp_Object process, start, end;
+{
+ Lisp_Object proc;
+ int start1;
+
+ proc = get_process (process);
+ validate_region (&start, &end);
+
+ if (XINT (start) < GPT && XINT (end) > GPT)
+ move_gap (start);
+
+ start1 = XINT (start);
+ send_process (proc, &FETCH_CHAR (start1), XINT (end) - XINT (start));
+
+ return Qnil;
+}
+
+DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
+ 2, 2, 0,
+ "Send PROCESS the contents of STRING as input.\n\
+PROCESS may be a process name.")
+ (process, string)
+ Lisp_Object process, string;
+{
+ Lisp_Object proc;
+ CHECK_STRING (string, 1);
+ proc = get_process (process);
+ send_process (proc, XSTRING (string)->data, XSTRING (string)->size);
+ return Qnil;
+}
+
+/* send a signal number SIGNO to PROCESS.
+ CURRENT_GROUP means send to the process group that currently owns
+ the terminal being used to communicate with PROCESS.
+ This is used for various commands in shell mode.
+ If NOMSG is zero, insert signal-announcements into process's buffers
+ right away. */
+
+process_send_signal (process, signo, current_group, nomsg)
+ Lisp_Object process;
+ int signo;
+ Lisp_Object current_group;
+ int nomsg;
+{
+ Lisp_Object proc;
+ register struct Lisp_Process *p;
+ int gid;
+ int no_pgrp = 0;
+
+ proc = get_process (process);
+ p = XPROCESS (proc);
+
+ if (!EQ (p->childp, Qt))
+ error ("Process %s is not a subprocess",
+ XSTRING (p->name)->data);
+ if (!XFASTINT (p->infd))
+ error ("Process %s is not active",
+ XSTRING (p->name)->data);
+
+ if (NULL (p->pty_flag))
+ current_group = Qnil;
+
+#ifdef TIOCGPGRP /* Not sure about this! (fnf) */
+ /* If we are using pgrps, get a pgrp number and make it negative. */
+ if (!NULL (current_group))
+ {
+ /* If possible, send signals to the entire pgrp
+ by sending an input character to it. */
+#ifndef SIGNALS_VIA_CHARACTERS
+#if defined (TIOCGLTC) && defined (TIOCGETC)
+ struct tchars c;
+ struct ltchars lc;
+
+ switch (signo)
+ {
+ case SIGINT:
+ ioctl (XFASTINT (p->infd), TIOCGETC, &c);
+ send_process (proc, &c.t_intrc, 1);
+ return Qnil;
+ case SIGQUIT:
+ ioctl (XFASTINT (p->infd), TIOCGETC, &c);
+ send_process (proc, &c.t_quitc, 1);
+ return Qnil;
+#ifdef SIGTSTP
+ case SIGTSTP:
+ ioctl (XFASTINT (p->infd), TIOCGLTC, &lc);
+ send_process (proc, &lc.t_suspc, 1);
+ return Qnil;
+#endif
+ }
+#endif /* have TIOCGLTC and have TIOCGETC */
+#endif /* not SIGNALS_VIA_CHARACTERS */
+ /* It is possible that the following code would work
+ on other kinds of USG systems, not just on the IRIS.
+ This should be tried in Emacs 19. */
+#ifdef SIGNALS_VIA_CHARACTERS
+ struct termio t;
+ switch (signo)
+ {
+ case SIGINT:
+ ioctl (XFASTINT (p->infd), TCGETA, &t);
+ send_process (proc, &t.c_cc[VINTR], 1);
+ return Qnil;
+ case SIGQUIT:
+ ioctl (XFASTINT (p->infd), TCGETA, &t);
+ send_process (proc, &t.c_cc[VQUIT], 1);
+ return Qnil;
+#ifdef SIGTSTP
+ case SIGTSTP:
+ ioctl (XFASTINT (p->infd), TCGETA, &t);
+ send_process (proc, &t.c_cc[VSWTCH], 1);
+ return Qnil;
+#endif
+ }
+#endif /* SIGNALS_VIA_CHARACTERS */
+
+ /* Get the pgrp using the tty itself, if we have that.
+ Otherwise, use the pty to get the pgrp. */
+#if defined (pfa)
+ /* TICGPGRP symbol defined in sys/ioctl.h at E50.
+ But, TIOCGPGRP does not work on E50.
+ This way, we will use -1, since the ioctl won't change it.
+ (saka@pfu.fujitsu.co.JP.) */
+ gid = -1;
+#endif
+ if (!NULL (p->subtty))
+ ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
+ else
+ ioctl (XFASTINT (p->infd), TIOCGPGRP, &gid);
+ if (gid == -1)
+ no_pgrp = 1;
+ else
+ gid = - gid;
+ }
+ else
+ gid = - XFASTINT (p->pid);
+#else /* not using pgrps */
+ /* Can't select pgrps on this system, so we know that
+ the child itself heads the pgrp. */
+ gid = - XFASTINT (p->pid);
+#endif /* not using pgrps */
+
+ switch (signo)
+ {
+#ifdef SIGCONT
+ case SIGCONT:
+ p->raw_status_low = Qnil;
+ p->raw_status_high = Qnil;
+ p->status = Qrun;
+ XSETINT (p->tick, ++process_tick);
+ if (!nomsg)
+ status_notify ();
+ break;
+#endif
+ case SIGINT:
+ case SIGQUIT:
+ case SIGKILL:
+ flush_pending_output (XFASTINT (p->infd));
+ break;
+ }
+
+ /* If we don't have process groups, send the signal to the immediate subprocess.
+ That isn't really right, but it's better than any obvious alternative. */
+ if (no_pgrp)
+ {
+ kill (XFASTINT (p->pid), signo);
+ return;
+ }
+
+ /* gid may be a pid, or minus a pgrp's number */
+#ifdef TIOCSIGSEND
+ if (!NULL (current_group))
+ ioctl (XFASTINT (p->infd), TIOCSIGSEND, signo);
+ else
+ {
+ gid = - XFASTINT (p->pid);
+ kill (gid, signo);
+ }
+#else /* no TIOCSIGSEND */
+#ifdef BSD
+ /* On bsd, [man says] kill does not accept a negative number to kill a pgrp.
+ Must do that differently. */
+ killpg (-gid, signo);
+#else /* Not BSD. */
+ kill (gid, signo);
+#endif /* Not BSD. */
+#endif /* no TIOCSIGSEND */
+}
+
+DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
+ "Interrupt process PROCESS. May be process or name of one.\n\
+Nil or no arg means current buffer's process.\n\
+Second arg CURRENT-GROUP non-nil means send signal to\n\
+the current process-group of the process's controlling terminal\n\
+rather than to the process's own process group.\n\
+If the process is a shell, this means interrupt current subjob\n\
+rather than the shell.")
+ (process, current_group)
+ Lisp_Object process, current_group;
+{
+ process_send_signal (process, SIGINT, current_group, 0);
+ return process;
+}
+
+DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
+ "Kill process PROCESS. May be process or name of one.\n\
+See function interrupt-process for more details on usage.")
+ (process, current_group)
+ Lisp_Object process, current_group;
+{
+ process_send_signal (process, SIGKILL, current_group, 0);
+ return process;
+}
+
+DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
+ "Send QUIT signal to process PROCESS. May be process or name of one.\n\
+See function interrupt-process for more details on usage.")
+ (process, current_group)
+ Lisp_Object process, current_group;
+{
+ process_send_signal (process, SIGQUIT, current_group, 0);
+ return process;
+}
+
+DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
+ "Stop process PROCESS. May be process or name of one.\n\
+See function interrupt-process for more details on usage.")
+ (process, current_group)
+ Lisp_Object process, current_group;
+{
+#ifndef SIGTSTP
+ error ("no SIGTSTP support");
+#else
+ process_send_signal (process, SIGTSTP, current_group, 0);
+#endif
+ return process;
+}
+
+DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
+ "Continue process PROCESS. May be process or name of one.\n\
+See function interrupt-process for more details on usage.")
+ (process, current_group)
+ Lisp_Object process, current_group;
+{
+#ifdef SIGCONT
+ process_send_signal (process, SIGCONT, current_group, 0);
+#else
+ error ("no SIGCONT support");
+#endif
+ return process;
+}
+
+DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
+ "Make PROCESS see end-of-file in its input.\n\
+Eof comes after any text already sent to it.\n\
+nil or no arg means current buffer's process.")
+ (process)
+ Lisp_Object process;
+{
+ Lisp_Object proc;
+
+ proc = get_process (process);
+ /* Sending a zero-length record is supposed to mean eof
+ when TIOCREMOTE is turned on. */
+#ifdef DID_REMOTE
+ {
+ char buf[1];
+ write (XFASTINT (XPROCESS (proc)->outfd), buf, 0);
+ }
+#else /* did not do TOICREMOTE */
+ if (!NULL (XPROCESS (proc)->pty_flag))
+ send_process (proc, "\004", 1);
+ else
+ {
+ close (XPROCESS (proc)->outfd);
+ XFASTINT (XPROCESS (proc)->outfd) = open ("/dev/null", O_WRONLY);
+ }
+
+#endif /* did not do TOICREMOTE */
+ return process;
+}
+
+/* Kill all processes associated with `buffer'.
+ If `buffer' is nil, kill all processes */
+
+kill_buffer_processes (buffer)
+ Lisp_Object buffer;
+{
+ Lisp_Object tail, proc;
+
+ for (tail = Vprocess_alist; XGCTYPE (tail) == Lisp_Cons;
+ tail = XCONS (tail)->cdr)
+ {
+ proc = XCONS (XCONS (tail)->car)->cdr;
+ if (XGCTYPE (proc) == Lisp_Process
+ && (NULL (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
+ {
+ if (NETCONN_P (proc))
+ deactivate_process (proc);
+ else if (XFASTINT (XPROCESS (proc)->infd))
+ process_send_signal (proc, SIGHUP, Qnil, 1);
+ }
+ }
+}
+
+/* On receipt of a signal that a child status has changed,
+ loop asking about children with changed statuses until
+ the system says there are no more.
+ All we do is change the status;
+ we do not run sentinels or print notifications.
+ That is saved for the next time keyboard input is done,
+ in order to avoid timing errors. */
+
+/** WARNING: this can be called during garbage collection.
+ Therefore, it must not be fooled by the presence of mark bits in
+ Lisp objects. */
+
+/** USG WARNING: Although it is not obvious from the documentation
+ in signal(2), on a USG system the SIGCLD handler MUST NOT call
+ signal() before executing at least one wait(), otherwise the handler
+ will be called again, resulting in an infinite loop. The relevant
+ portion of the documentation reads "SIGCLD signals will be queued
+ and the signal-catching function will be continually reentered until
+ the queue is empty". Invoking signal() causes the kernel to reexamine
+ the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */
+
+sigchld_handler (signo)
+ int signo;
+{
+ int old_errno = errno;
+ Lisp_Object proc;
+ register struct Lisp_Process *p;
+
+#ifdef BSD4_1
+ extern int synch_process_pid;
+ extern int sigheld;
+ sigheld |= sigbit (SIGCHLD);
+#endif
+
+ while (1)
+ {
+ register int pid;
+ WAITTYPE w;
+ Lisp_Object tail;
+
+#ifdef WNOHANG
+#ifndef WUNTRACED
+#define WUNTRACED 0
+#endif /* no WUNTRACED */
+ /* Keep trying to get a status until we get a definitive result. */
+ do
+ {
+ errno = 0;
+ pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
+ }
+ while (pid <= 0 && errno == EINTR);
+
+ if (pid <= 0)
+ {
+ /* A real failure. We have done all our job, so return. */
+
+ /* USG systems forget handlers when they are used;
+ must reestablish each time */
+#ifdef USG
+ signal (signo, sigchld_handler); /* WARNING - must come after wait3() */
+#endif
+#ifdef BSD4_1
+ sigheld &= ~sigbit (SIGCHLD);
+ sigrelse (SIGCHLD);
+#endif
+ errno = old_errno;
+ return;
+ }
+#else
+ pid = wait (&w);
+#endif /* no WNOHANG */
+
+#ifdef BSD4_1
+ if (synch_process_pid == pid)
+ synch_process_pid = 0; /* Zero it to show process has died. */
+#endif
+
+ /* Find the process that signaled us, and record its status. */
+
+ p = 0;
+ for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
+ {
+ proc = XCONS (XCONS (tail)->car)->cdr;
+ p = XPROCESS (proc);
+ if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid)
+ break;
+ p = 0;
+ }
+
+ /* If we don't recognize the pid number,
+ look for a process being created. */
+
+ if (p == 0)
+ for (tail = Vprocess_alist; XSYMBOL (tail) != XSYMBOL (Qnil); tail = XCONS (tail)->cdr)
+ {
+ proc = XCONS (XCONS (tail)->car)->cdr;
+ p = XPROCESS (proc);
+ if (XINT (p->pid) == -1)
+ break;
+ p = 0;
+ }
+
+ /* Change the status of the process that was found. */
+
+ if (p != 0)
+ {
+ union { int i; WAITTYPE wt; } u;
+
+ XSETINT (p->tick, ++process_tick);
+ u.wt = w;
+ XFASTINT (p->raw_status_low) = u.i & 0xffff;
+ XFASTINT (p->raw_status_high) = u.i >> 16;
+
+ /* If process has terminated, stop waiting for its output. */
+ if (WIFSIGNALED (w) || WIFEXITED (w))
+ if (p->infd)
+ FD_CLR (p->infd, &input_wait_mask);
+ }
+ else
+ {
+ /* Report the status of the synchronous process. */
+ if (WIFEXITED (w))
+ synch_process_retcode = WRETCODE (w);
+ else if (WIFSIGNALED (w))
+ synch_process_death = sys_siglist[WTERMSIG (w)];
+ }
+
+ /* On some systems, we must return right away.
+ If any more processes want to signal us, we will
+ get another signal.
+ Otherwise (on systems that have WNOHANG), loop around
+ to use up all the processes that have something to tell us. */
+#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG))
+#ifdef USG
+ signal (signo, sigchld_handler);
+#endif
+ errno = old_errno;
+ return;
+#endif /* USG, but not HPUX with WNOHANG */
+ }
+}
+
+/* Report all recent events of a change in process status
+ (either run the sentinel or output a message).
+ This is done while Emacs is waiting for keyboard input. */
+
+status_notify ()
+{
+ register Lisp_Object proc, buffer;
+ Lisp_Object tail = Qnil;
+ Lisp_Object msg = Qnil;
+ struct gcpro gcpro1, gcpro2;
+
+ /* We need to gcpro tail; if read_process_output calls a filter
+ which deletes a process and removes the cons to which tail points
+ from Vprocess_alist, tail becomes an unprotected reference. */
+ GCPRO2 (tail, msg);
+
+ for (tail = Vprocess_alist; !NULL (tail); tail = Fcdr (tail))
+ {
+ Lisp_Object symbol;
+ register struct Lisp_Process *p;
+
+ proc = Fcdr (Fcar (tail));
+ p = XPROCESS (proc);
+
+ if (XINT (p->tick) != XINT (p->update_tick))
+ {
+ XSETINT (p->update_tick, XINT (p->tick));
+
+ /* If process is still active, read any output that remains. */
+ if (XFASTINT (p->infd))
+ while (read_process_output (proc, XFASTINT (p->infd)) > 0);
+
+ buffer = p->buffer;
+
+ /* Get the text to use for the message. */
+ if (!NULL (p->raw_status_low))
+ update_status (p);
+ msg = status_message (p->status);
+
+ /* If process is terminated, deactivate it or delete it. */
+ symbol = p->status;
+ if (XTYPE (p->status) == Lisp_Cons)
+ symbol = XCONS (p->status)->car;
+
+ if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
+ || EQ (symbol, Qclosed))
+ {
+ if (delete_exited_processes)
+ remove_process (proc);
+ else
+ deactivate_process (proc);
+ }
+
+ /* Now output the message suitably. */
+ if (!NULL (p->sentinel))
+ exec_sentinel (proc, msg);
+ /* Don't bother with a message in the buffer
+ when a process becomes runnable. */
+ else if (!EQ (symbol, Qrun) && !NULL (buffer))
+ {
+ Lisp_Object ro = XBUFFER (buffer)->read_only;
+ Lisp_Object tem;
+ struct buffer *old = current_buffer;
+ int opoint;
+
+ /* Avoid error if buffer is deleted
+ (probably that's why the process is dead, too) */
+ if (NULL (XBUFFER (buffer)->name))
+ continue;
+ Fset_buffer (buffer);
+ opoint = point;
+ /* Insert new output into buffer
+ at the current end-of-output marker,
+ thus preserving logical ordering of input and output. */
+ if (XMARKER (p->mark)->buffer)
+ SET_PT (marker_position (p->mark));
+ else
+ SET_PT (ZV);
+ if (point <= opoint)
+ opoint += XSTRING (msg)->size + XSTRING (p->name)->size + 10;
+
+ tem = current_buffer->read_only;
+ current_buffer->read_only = Qnil;
+ InsStr ("\nProcess ");
+ Finsert (1, &p->name);
+ InsStr (" ");
+ Finsert (1, &msg);
+ current_buffer->read_only = tem;
+ Fset_marker (p->mark, make_number (point), p->buffer);
+
+ SET_PT (opoint);
+ set_buffer_internal (old);
+ }
+ }
+ } /* end for */
+
+ update_mode_lines++; /* in case buffers use %s in mode-line-format */
+ redisplay_preserve_echo_area ();
+
+ update_tick = process_tick;
+
+ UNGCPRO;
+}
+
+exec_sentinel (proc, reason)
+ Lisp_Object proc, reason;
+{
+ Lisp_Object sentinel;
+ register struct Lisp_Process *p = XPROCESS (proc);
+ int count = specpdl_ptr - specpdl;
+
+ sentinel = p->sentinel;
+ if (NULL (sentinel))
+ return;
+
+ p->sentinel = Qnil;
+ specbind (Qinhibit_quit, Qt);
+ this_filter = sentinel;
+ filter_process = proc;
+ filter_string = reason;
+ call2 (this_filter, filter_process, filter_string);
+/* internal_condition_case (run_filter, Qerror, Fidentity); */
+ unbind_to (count);
+ p->sentinel = sentinel;
+}
+
+init_process ()
+{
+ register int i;
+
+#ifdef SIGCHLD
+#ifndef CANNOT_DUMP
+ if (! noninteractive || initialized)
+#endif
+ signal (SIGCHLD, sigchld_handler);
+#endif
+
+ FD_ZERO (&input_wait_mask);
+ FD_SET (0, &input_wait_mask);
+ Vprocess_alist = Qnil;
+ for (i = 0; i < MAXDESC; i++)
+ {
+ chan_process[i] = Qnil;
+ proc_buffered_char[i] = -1;
+ }
+}
+
+syms_of_process ()
+{
+ Qprocessp = intern ("processp");
+ staticpro (&Qprocessp);
+ Qrun = intern ("run");
+ staticpro (&Qrun);
+ Qstop = intern ("stop");
+ staticpro (&Qstop);
+ Qsignal = intern ("signal");
+ staticpro (&Qsignal);
+
+ /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
+ here again.
+
+ Qexit = intern ("exit");
+ staticpro (&Qexit); */
+
+ Qopen = intern ("open");
+ staticpro (&Qopen);
+ Qclosed = intern ("closed");
+ staticpro (&Qclosed);
+
+ staticpro (&Vprocess_alist);
+
+ DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes,
+ "*Non-nil means delete processes immediately when they exit.\n\
+nil means don't delete them until `list-processes' is run.");
+
+ delete_exited_processes = 1;
+
+ DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
+ "Control type of device used to communicate with subprocesses.\n\
+Values are nil to use a pipe, t for a pty (or pipe if ptys not supported).\n\
+Value takes effect when `start-process' is called.");
+ Vprocess_connection_type = Qt;
+
+ defsubr (&Sprocessp);
+ defsubr (&Sget_process);
+ defsubr (&Sget_buffer_process);
+ defsubr (&Sdelete_process);
+ defsubr (&Sprocess_status);
+ defsubr (&Sprocess_exit_status);
+ defsubr (&Sprocess_id);
+ defsubr (&Sprocess_name);
+ defsubr (&Sprocess_command);
+ defsubr (&Sset_process_buffer);
+ defsubr (&Sprocess_buffer);
+ defsubr (&Sprocess_mark);
+ defsubr (&Sset_process_filter);
+ defsubr (&Sprocess_filter);
+ defsubr (&Sset_process_sentinel);
+ defsubr (&Sprocess_sentinel);
+ defsubr (&Sprocess_kill_without_query);
+ defsubr (&Slist_processes);
+ defsubr (&Sprocess_list);
+ defsubr (&Sstart_process);
+#ifdef HAVE_SOCKETS
+ defsubr (&Sopen_network_stream);
+#endif /* HAVE_SOCKETS */
+ defsubr (&Saccept_process_output);
+ defsubr (&Sprocess_send_region);
+ defsubr (&Sprocess_send_string);
+ defsubr (&Sinterrupt_process);
+ defsubr (&Skill_process);
+ defsubr (&Squit_process);
+ defsubr (&Sstop_process);
+ defsubr (&Scontinue_process);
+ defsubr (&Sprocess_send_eof);
+ defsubr (&Swaiting_for_user_input_p);
+}
+
+#endif /* subprocesses */
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-23 04:09:04 +0000