#include "config.h"
+extern int errno;
+#ifndef VMS
+extern char *sys_errlist[];
+#endif
+
/* Define SIGCHLD as an alias for SIGCLD. */
#if !defined (SIGCHLD) && defined (SIGCLD)
#include "buffer.h"
#include "paths.h"
#include "process.h"
+#include "syssignal.h"
#ifdef VMS
extern noshare char **environ;
\f
#ifndef VMS /* VMS version is in vmsproc.c. */
+static Lisp_Object
+call_process_kill (fdpid)
+ Lisp_Object fdpid;
+{
+ close (XFASTINT (Fcar (fdpid)));
+ EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
+ synch_process_alive = 0;
+ return Qnil;
+}
+
Lisp_Object
call_process_cleanup (fdpid)
Lisp_Object fdpid;
{
- register Lisp_Object fd, pid;
- fd = Fcar (fdpid);
- pid = Fcdr (fdpid);
- close (XFASTINT (fd));
- kill (XFASTINT (pid), SIGKILL);
+ register int pid = XFASTINT (Fcdr (fdpid));
+
+ if (EMACS_KILLPG (pid, SIGINT) == 0)
+ {
+ int count = specpdl_ptr - specpdl;
+ record_unwind_protect (call_process_kill, fdpid);
+ message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
+ immediate_quit = 1;
+ QUIT;
+ wait_for_termination (pid);
+ immediate_quit = 0;
+ specpdl_ptr = specpdl + count; /* Discard the unwind protect. */
+ message1 ("Waiting for process to die...done");
+ }
synch_process_alive = 0;
+ close (XFASTINT (Fcar (fdpid)));
return Qnil;
}
If BUFFER is 0, returns immediately with value nil.\n\
Otherwise waits for PROGRAM to terminate\n\
and returns a numeric exit status or a signal description string.\n\
-If you quit, the process is killed with SIGKILL.")
+If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
(nargs, args)
int nargs;
register Lisp_Object *args;
{
- Lisp_Object display, infile, buffer, path, current_dir;
+ Lisp_Object infile, buffer, current_dir, display, path;
int fd[2];
int filefd;
register int pid;
else
buffer = Qnil;
+ /* 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,
+ Funhandled_file_name_directory, and Ffile_accessible_directory_p
+ 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, gcpro3;
+
+ current_dir = current_buffer->directory;
+
+ GCPRO3 (infile, 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;
+ }
+
display = nargs >= 4 ? args[3] : Qnil;
{
#endif
}
- /* 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));
-
{
/* child_setup must clobber environ in systems with true vfork.
Protect it from permanent change. */
}
#endif
\f
-static void
+static Lisp_Object
delete_temp_file (name)
Lisp_Object name;
{
If BUFFER is nil, returns immediately with value nil.\n\
Otherwise waits for PROGRAM to terminate\n\
and returns a numeric exit status or a signal description string.\n\
-If you quit, the process is killed with SIGKILL.")
+If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
(nargs, args)
int nargs;
register Lisp_Object *args;
Fdelete_region (start, end);
args[3] = filename_string;
- Fcall_process (nargs - 2, args + 2);
- return unbind_to (count, Qnil);
+ return unbind_to (count, Fcall_process (nargs - 2, args + 2));
}
\f
#ifndef VMS /* VMS version is in vmsproc.c. */
register int pid = getpid();
- setpriority (PRIO_PROCESS, pid, 0);
+ {
+ extern int emacs_priority;
+
+ nice (- emacs_priority);
+ }
#ifdef subprocesses
/* Close Emacs's descriptors that this process should not have. */
*new_env = 0;
}
+ /* Make sure that in, out, and err are not actually already in
+ descriptors zero, one, or two; this could happen if Emacs is
+ started with its standard in, our, or error closed, as might
+ happen under X. */
+ in = relocate_fd (in, 3);
+ out = relocate_fd (out, 3);
+ err = relocate_fd (err, 3);
+
close (0);
close (1);
close (2);
_exit (1);
}
+/* Move the file descriptor FD so that its number is not less than MIN.
+ If the file descriptor is moved at all, the original is freed. */
+int
+relocate_fd (fd, min)
+ int fd, min;
+{
+ if (fd >= min)
+ return fd;
+ else
+ {
+ int new = dup (fd);
+ if (new == -1)
+ {
+ char message1[] =
+ "Error while setting up child: ";
+ char message2[] = "\n";
+ write (2, message1, sizeof (message1) - 1);
+ write (2, sys_errlist[errno], strlen (sys_errlist[errno]));
+ write (2, message2, sizeof (message2) - 1);
+ _exit (1);
+ }
+ /* Note that we hold the original FD open while we recurse,
+ to guarantee we'll get a new FD if we need it. */
+ new = relocate_fd (new, min);
+ close (fd);
+ return new;
+ }
+}
+
static int
getenv_internal (var, varlen, value, valuelen)
char *var;
init_callproc ()
{
register char * sh;
- register char **envp;
Lisp_Object tempdir;
{
sh = (char *) getenv ("SHELL");
Vshell_file_name = build_string (sh ? sh : "/bin/sh");
#endif
+}
+
+set_process_environment ()
+{
+ register char **envp;
Vprocess_environment = Qnil;
#ifndef CANNOT_DUMP
#ifndef VMS
defsubr (&Scall_process);
-#endif
defsubr (&Sgetenv);
+#endif
defsubr (&Scall_process_region);
}
HCoop / bpt / emacs.git / blobdiff