/* Asynchronous subprocess control for GNU Emacs.
- Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993 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)
+the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
#include <fcntl.h>
#endif /* HAVE_PTYS and no O_NDELAY */
#endif /* BSD or STRIDE */
-#ifdef USG
-#ifdef HAVE_TERMIOS
-#include <termios.h>
-#else
-#include <termio.h>
-#endif
-#include <fcntl.h>
-#endif /* USG */
#ifdef NEED_BSDTTY
#include <bsdtty.h>
#endif /* not IRIS */
#include "systime.h"
-#include "systerm.h"
+#include "systty.h"
#include "lisp.h"
#include "window.h"
#include "termhooks.h"
#include "termopts.h"
#include "commands.h"
-#include "dispextern.h"
+#include "frame.h"
Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed;
/* Qexit is declared and initialized in eval.c. */
/* For the CMU PTY driver + */
#define DCL_PROMPT "$ "
-
+/* This is a hack. I have no idea what needs to go here, but this */
+/* will get it to compile. We can fix it later. rbr */
+#define WAITTYPE int
#include <ssdef.h>
#include <iodef.h>
#include <clidef.h>
#endif
#endif /* VMS */
-#ifdef vipc
-
-#include "vipc.h"
-extern int comm_server;
-extern int net_listen_address;
-#endif /* vipc */
-
/* t means use pty, nil means use a pipe,
maybe other values to come. */
Lisp_Object Vprocess_connection_type;
/* Compute the Lisp form of the process status, p->status, from
the numeric status that was returned by `wait'. */
+Lisp_Object status_convert ();
+
update_status (p)
struct Lisp_Process *p;
{
*symbol = XCONS (l)->car;
tem = XCONS (l)->cdr;
*code = XFASTINT (XCONS (tem)->car);
- tem = XFASTINT (XCONS (tem)->cdr);
+ tem = XCONS (tem)->cdr;
*coredump = !NILP (tem);
}
}
if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
{
+#ifndef VMS
string = build_string (code < NSIG ? sys_siglist[code] : "unknown");
+#else
+ string = build_string (code < NSIG ? sys_errlist[code] : "unknown");
+#endif
string2 = build_string (coredump ? " (core dumped)\n" : "\n");
XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
return concat2 (string, string2);
}
\f
#ifdef HAVE_PTYS
-static int pty_process;
/* Open an available pty, returning a file descriptor.
Return -1 on failure.
tem = Fcar (Fcdr (p->status));
#ifdef VMS
if (XINT (tem) < NSIG)
- write_string (sys_siglist [XINT (tem)], -1);
+ write_string (sys_errlist [XINT (tem)], -1);
else
#endif
Fprinc (symbol, Qnil);
return Fmapcar (Qcdr, Vprocess_alist);
}
\f
+/* Starting asynchronous inferior processes. */
+
+static Lisp_Object start_process_unwind ();
+
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\
int nargs;
register Lisp_Object *args;
{
- Lisp_Object buffer, name, program, proc, tem;
+ Lisp_Object buffer, name, program, proc, current_dir, tem;
#ifdef VMS
register unsigned char *new_argv;
int len;
register unsigned char **new_argv;
#endif
register int i;
+ int count = specpdl_ptr - specpdl;
buffer = args[1];
if (!NILP (buffer))
buffer = Fget_buffer_create (buffer);
+ /* Make sure that the child will be able to chdir to the current
+ buffer's current directory, or its unhandled equivalent. We
+ can't just have the child check for an error when it does the
+ chdir, since it's in a vfork.
+
+ We have to GCPRO around this because Fexpand_file_name and
+ Funhandled_file_name_directory might call a file name handling
+ function. The argument list is protected by the caller, so all
+ we really have to worry about is buffer. */
+ {
+ struct gcpro gcpro1, gcpro2;
+
+ current_dir = current_buffer->directory;
+
+ GCPRO2 (buffer, current_dir);
+
+ current_dir =
+ expand_and_dir_to_file
+ (Funhandled_file_name_directory (current_dir), Qnil);
+ if (NILP (Ffile_accessible_directory_p (current_dir)))
+ report_file_error ("Setting current directory",
+ Fcons (current_buffer->directory, Qnil));
+
+ UNGCPRO;
+ }
+
name = args[0];
CHECK_STRING (name, 0);
strcat (new_argv, " ");
strcat (new_argv, XSTRING (tem)->data);
}
+ /* Need to add code here to check for program existence on VMS */
+
#else /* not VMS */
new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
#endif /* not VMS */
proc = make_process (name);
+ /* If an error occurs and we can't start the process, we want to
+ remove it from the process list. This means that each error
+ check in create_process doesn't need to call remove_process
+ itself; it's all taken care of here. */
+ record_unwind_protect (start_process_unwind, proc);
XPROCESS (proc)->childp = Qt;
XPROCESS (proc)->command_channel_p = Qnil;
XPROCESS (proc)->filter = Qnil;
XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
- create_process (proc, new_argv);
+ create_process (proc, new_argv, current_dir);
- return proc;
+ return unbind_to (count, proc);
+}
+
+/* This function is the unwind_protect form for Fstart_process. If
+ PROC doesn't have its pid set, then we know someone has signalled
+ an error and the process wasn't started successfully, so we should
+ remove it from the process list. */
+static Lisp_Object
+start_process_unwind (proc)
+ Lisp_Object proc;
+{
+ if (XTYPE (proc) != Lisp_Process)
+ abort ();
+
+ /* Was PROC started successfully? */
+ if (XPROCESS (proc)->pid <= 0)
+ remove_process (proc);
+
+ return Qnil;
}
+
SIGTYPE
create_process_1 (signo)
int signo;
#endif
#ifndef VMS /* VMS version of this function is in vmsproc.c. */
-create_process (process, new_argv)
+create_process (process, new_argv, current_dir)
Lisp_Object process;
char **new_argv;
+ Lisp_Object current_dir;
{
int pid, inchannel, outchannel, forkin, forkout;
int sv[2];
SIGTYPE (*sigchld)();
#endif
int pty_flag = 0;
- Lisp_Object current_dir;
extern char **environ;
inchannel = outchannel = -1;
if (EQ (Vprocess_connection_type, Qt))
outchannel = inchannel = allocate_pty ();
- /* Make sure that the child will be able to chdir to the current
- buffer's current directory. We can't just have the child check
- for an error when it does the chdir, since it's in a vfork. */
- current_dir = expand_and_dir_to_file (current_buffer->directory, Qnil);
- if (NILP (Ffile_accessible_directory_p (current_dir)))
- report_file_error ("Setting current directory",
- Fcons (current_buffer->directory, Qnil));
-
if (inchannel >= 0)
{
#ifndef USG
#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 (pid < 0)
- {
- remove_process (process);
- report_file_error ("Doing vfork", Qnil);
- }
-
+ report_file_error ("Doing vfork", Qnil);
+
XFASTINT (XPROCESS (process)->pid) = pid;
FD_SET (inchannel, &input_wait_mask);
}
}
}
+ else
+ useconds = 0;
if (! NILP (timeout))
{
zero for no limit, or
-1 means gobble data immediately available but don't wait for any.
+ microsecs is:
+ an additional duration to wait (if time_limit is greater than
+ zero), specified in millisec.
+
read_kbd is a lisp value:
0 to ignore keyboard input, or
1 to return when input is available, or
- -1 means caller will actually read the input, so don't throw to
+ -1 meaning caller will actually read the input, so don't throw to
the quit handler, or
+ a cons cell, meaning wait wait until its car is non-nil, or
a process object, meaning wait until something arrives from that
process. The return value is true iff we read some input from
that process.
int wait_channel = 0;
struct Lisp_Process *wait_proc = 0;
int got_some_input = 0;
+ Lisp_Object *wait_for_cell = 0;
FD_ZERO (&Available);
XFASTINT (read_kbd) = 0;
}
+ /* If waiting for non-nil in a cell, record where. */
+ if (XTYPE (read_kbd) == Lisp_Cons)
+ {
+ wait_for_cell = &XCONS (read_kbd)->car;
+ XFASTINT (read_kbd) = 0;
+ }
+
waiting_for_user_input_p = XINT (read_kbd);
/* Since we may need to wait several times,
if (XINT (read_kbd) >= 0)
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;
- EMACS_SET_SECS_USECS (timeout, 0, 0);
- if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
- status_notify ();
- }
-
- /* Don't wait for output from a non-running process. */
- if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
- update_status (wait_proc);
- if (wait_proc != 0
- && ! EQ (wait_proc->status, Qrun))
- break;
-
/* Compute time from now till when time limit is up */
/* Exit if already run out */
if (time_limit == -1)
}
/* Cause C-g and alarm signals to take immediate action,
- and cause input available signals to zero out timeout */
+ and cause input available signals to zero out timeout.
+
+ It is important that we do this before checking for process
+ activity. If we get a SIGCHLD after the explicit checks for
+ process activity, timeout is the only way we will know. */
if (XINT (read_kbd) < 0)
set_waiting_for_input (&timeout);
+ /* If status of something has changed, and no input is
+ available, notify the user of the change right away. After
+ this explicit check, we'll let the SIGCHLD handler zap
+ timeout to get our attention. */
+ if (update_tick != process_tick && do_display)
+ {
+ Atemp = input_wait_mask;
+ EMACS_SET_SECS_USECS (timeout, 0, 0);
+ if (select (MAXDESC, &Atemp, 0, 0, &timeout) <= 0)
+ status_notify ();
+ }
+
+ /* Don't wait for output from a non-running process. */
+ if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
+ update_status (wait_proc);
+ if (wait_proc != 0
+ && ! EQ (wait_proc->status, Qrun))
+ break;
+
/* Wait till there is something to do */
Available = input_wait_mask;
/* If frame size has changed or the window is newly mapped,
redisplay now, before we start to wait. There is a race
condition here; if a SIGIO arrives between now and the select
- and indicates that a frame is trashed, we lose. */
+ and indicates that a frame is trashed, the select may block
+ displaying a trashed screen. */
if (frame_garbaged)
redisplay_preserve_echo_area ();
{
if (xerrno == EINTR)
FD_ZERO (&Available);
+#ifdef ultrix
+ /* Ultrix select seems to return ENOMEM when it is
+ interrupted. Treat it just like EINTR. Bleah. Note
+ that we want to test for the "ultrix" CPP symbol, not
+ "__ultrix__"; the latter is only defined under GCC, but
+ not by DEC's bundled CC. -JimB */
+ else if (xerrno == ENOMEM)
+ FD_ZERO (&Available);
+#endif
#ifdef ALLIANT
/* This happens for no known reason on ALLIANT.
I am guessing that this is the right response. -- RMS. */
if (XINT (read_kbd) && detect_input_pending ())
break;
+ /* Exit now if the cell we're waiting for became non-nil. */
+ if (wait_for_cell && ! NILP (*wait_for_cell))
+ break;
+
#ifdef SIGIO
/* If we think we have keyboard input waiting, but didn't get SIGIO
go read it. This can happen with X on BSD after logging out.
In that case, there really is no input and no SIGIO,
but select says there is input. */
- /*
- if (XINT (read_kbd) && interrupt_input && (Available & fileno (stdin)))
- */
if (XINT (read_kbd) && interrupt_input && (FD_ISSET (fileno (stdin), &Available)))
kill (0, SIGIO);
#endif
-#ifdef vipc
- /* Check for connection from other process */
-
- if (Available & ChannelMask (comm_server))
- {
- Available &= ~(ChannelMask (comm_server));
- create_commchan ();
- }
-#endif /* vipc */
-
if (! wait_proc)
got_some_input |= nfds > 0;
if (NILP (proc))
continue;
-#ifdef vipc
- /* It's a command channel */
- if (!NILP (XPROCESS (proc)->command_channel_p))
- {
- ProcessCommChan (channel, proc);
- if (NILP (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. */
/* If no filter, write into buffer if it isn't dead. */
if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name))
{
- Lisp_Object tem;
+ Lisp_Object old_read_only;
+ Lisp_Object old_begv, old_zv;
Fset_buffer (p->buffer);
opoint = point;
+ old_read_only = current_buffer->read_only;
+ XFASTINT (old_begv) = BEGV;
+ XFASTINT (old_zv) = ZV;
+
+ current_buffer->read_only = Qnil;
/* Insert new output into buffer
at the current end-of-output marker,
SET_PT (marker_position (p->mark));
else
SET_PT (ZV);
+
+ /* If the output marker is outside of the visible region, save
+ the restriction and widen. */
+ if (! (BEGV <= point && point <= ZV))
+ Fwiden ();
+
+ /* Make sure opoint floats ahead of any new text, just as point
+ would. */
if (point <= opoint)
opoint += nchars;
- tem = current_buffer->read_only;
- current_buffer->read_only = Qnil;
+ /* Insert after old_begv, but before old_zv. */
+ if (point < XFASTINT (old_begv))
+ XFASTINT (old_begv) += nchars;
+ if (point <= XFASTINT (old_zv))
+ XFASTINT (old_zv) += nchars;
+
/* Insert before markers in case we are inserting where
the buffer's mark is, and the user's next command is Meta-y. */
insert_before_markers (chars, nchars);
- current_buffer->read_only = tem;
Fset_marker (p->mark, make_number (point), p->buffer);
+
update_mode_lines++;
+ /* If the restriction isn't what it should be, set it. */
+ if (XFASTINT (old_begv) != BEGV || XFASTINT (old_zv) != ZV)
+ Fnarrow_to_region (old_begv, old_zv);
+
+ current_buffer->read_only = old_read_only;
SET_PT (opoint);
set_buffer_internal (old);
}
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. */
+ right away.
+
+ If we can, we try to signal PROCESS by sending control characters
+ down the pipe. This allows us to signal inferiors who have changed
+ their uid, for which killpg would return an EPERM error. */
+static void
process_send_signal (process, signo, current_group, nomsg)
Lisp_Object process;
int signo;
/* If we are using pgrps, get a pgrp number and make it negative. */
if (!NILP (current_group))
{
+#ifdef SIGNALS_VIA_CHARACTERS
/* If possible, send signals to the entire pgrp
by sending an input character to it. */
+
+ /* TERMIOS is the latest and bestest, and seems most likely to
+ work. If the system has it, use it. */
+#ifdef HAVE_TERMIOS
+ struct termios t;
+
+ switch (signo)
+ {
+ case SIGINT:
+ tcgetattr (XFASTINT (p->infd), &t);
+ send_process (proc, &t.c_cc[VINTR], 1);
+ return;
+
+ case SIGQUIT:
+ tcgetattr (XFASTINT (p->infd), &t);
+ send_process (proc, &t.c_cc[VQUIT], 1);
+ return;
+
+ case SIGTSTP:
+ tcgetattr (XFASTINT (p->infd), &t);
+#ifdef VSWTCH
+ send_process (proc, &t.c_cc[VSWTCH], 1);
+#else
+ send_process (proc, &t.c_cc[VSUSP], 1);
+#endif
+ return;
+ }
+
+#else /* ! HAVE_TERMIOS */
+
+ /* On Berkeley descendants, the following IOCTL's retrieve the
+ current control characters. */
#if defined (TIOCGLTC) && defined (TIOCGETC)
+
struct tchars c;
struct ltchars lc;
case SIGINT:
ioctl (XFASTINT (p->infd), TIOCGETC, &c);
send_process (proc, &c.t_intrc, 1);
- return Qnil;
+ return;
case SIGQUIT:
ioctl (XFASTINT (p->infd), TIOCGETC, &c);
send_process (proc, &c.t_quitc, 1);
- return Qnil;
+ return;
#ifdef SIGTSTP
case SIGTSTP:
ioctl (XFASTINT (p->infd), TIOCGLTC, &lc);
send_process (proc, &lc.t_suspc, 1);
- return Qnil;
-#endif /* SIGTSTP */
+ return;
+#endif /* ! defined (SIGTSTP) */
}
-#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
- /* 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. */
-#if defined (USG)
+
+#else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
+
+ /* On SYSV descendants, the TCGETA ioctl retrieves the current control
+ characters. */
+#ifdef TCGETA
struct termio t;
switch (signo)
{
case SIGINT:
ioctl (XFASTINT (p->infd), TCGETA, &t);
send_process (proc, &t.c_cc[VINTR], 1);
- return Qnil;
+ return;
case SIGQUIT:
ioctl (XFASTINT (p->infd), TCGETA, &t);
send_process (proc, &t.c_cc[VQUIT], 1);
- return Qnil;
+ return;
+#ifdef SIGTSTP
case SIGTSTP:
ioctl (XFASTINT (p->infd), TCGETA, &t);
send_process (proc, &t.c_cc[VSWTCH], 1);
- return Qnil;
+ return;
+#endif /* ! defined (SIGTSTP) */
}
-#endif /* ! defined (USG) */
+#else /* ! defined (TCGETA) */
+ Your configuration files are messed up.
+ /* If your system configuration files define SIGNALS_VIA_CHARACTERS,
+ you'd better be using one of the alternatives above! */
+#endif /* ! defined (TCGETA) */
+#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
+#endif /* ! defined HAVE_TERMIOS */
+#endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
#ifdef TIOCGPGRP
/* Get the pgrp using the tty itself, if we have that.
Otherwise, use the pty to get the pgrp.
On pfa systems, saka@pfu.fujitsu.co.JP writes:
- "TICGPGRP symbol defined in sys/ioctl.h at E50.
- But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
+ "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
+ But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
His patch indicates that if TIOCGPGRP returns an error, then
we should just assume that p->pid is also the process group id. */
{
no_pgrp = 1;
else
gid = - gid;
-#else /* ! defined (TIOCGPGRP ) */
+#else /* ! defined (TIOCGPGRP ) */
/* Can't select pgrps on this system, so we know that
the child itself heads the pgrp. */
gid = - XFASTINT (p->pid);
Lisp_Object proc;
proc = get_process (process);
+
+ /* Make sure the process is really alive. */
+ if (! NILP (XPROCESS (proc)->raw_status_low))
+ update_status (XPROCESS (proc));
+ if (! EQ (XPROCESS (proc)->status, Qrun))
+ error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
+
/* Sending a zero-length record is supposed to mean eof
when TIOCREMOTE is turned on. */
#ifdef DID_REMOTE
int old_errno = errno;
Lisp_Object proc;
register struct Lisp_Process *p;
+ extern EMACS_TIME *input_available_clear_time;
#ifdef BSD4_1
extern int sigheld;
/* If process has terminated, stop waiting for its output. */
if (WIFSIGNALED (w) || WIFEXITED (w))
- if (p->infd)
- FD_CLR (p->infd, &input_wait_mask);
+ if (XFASTINT (p->infd))
+ FD_CLR (XFASTINT (p->infd), &input_wait_mask);
+
+ /* Tell wait_reading_process_input that it needs to wake up and
+ look around. */
+ if (input_available_clear_time)
+ EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
}
/* There was no asynchronous process found for that id. Check
if (WIFEXITED (w))
synch_process_retcode = WRETCODE (w);
else if (WIFSIGNALED (w))
+#ifndef VMS
synch_process_death = sys_siglist[WTERMSIG (w)];
+#else
+ synch_process_death = sys_errlist[WTERMSIG (w)];
+#endif
+
+ /* Tell wait_reading_process_input that it needs to wake up and
+ look around. */
+ if (input_available_clear_time)
+ EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
}
/* On some systems, we must return right away.
#endif
syms_of_process ()
{
-#ifdef HAVE_PTYS
- pty_process = intern ("pty");
-#endif
#ifdef HAVE_SOCKETS
stream_process = intern ("stream");
#endif
break;
}
+ start_polling ();
+
return 0;
}