#include <config.h>
#include <signal.h>
#include <errno.h>
#include <stdio.h>
#ifndef USE_CRT_DLL
extern int errno;
#endif
#if !defined (SIGCHLD) && defined (SIGCLD)
#define SIGCHLD SIGCLD
#endif
#include <sys/types.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <sys/file.h>
#ifdef HAVE_FCNTL_H
#define INCLUDED_FCNTL
#include <fcntl.h>
#endif
#ifdef WINDOWSNT
#define NOMINMAX
#include <windows.h>
#include <stdlib.h>
#include <fcntl.h>
#include "w32.h"
#define _P_NOWAIT 1
#endif
#ifdef MSDOS
#define INCLUDED_FCNTL
#include <fcntl.h>
#include <sys/stat.h>
#include <sys/param.h>
#include <errno.h>
#endif
#ifndef O_RDONLY
#define O_RDONLY 0
#endif
#ifndef O_WRONLY
#define O_WRONLY 1
#endif
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
#include "charset.h"
#include "ccl.h"
#include "coding.h"
#include "composite.h"
#include <epaths.h>
#include "process.h"
#include "syssignal.h"
#include "systty.h"
#include "blockinput.h"
#ifdef MSDOS
#include "msdos.h"
#endif
#ifdef VMS
extern noshare char **environ;
#else
#ifndef USE_CRT_DLL
extern char **environ;
#endif
#endif
#ifdef HAVE_SETPGID
#if !defined (USG) || defined (BSD_PGRPS)
#undef setpgrp
#define setpgrp setpgid
#endif
#endif
Lisp_Object Vexec_path, Vexec_directory, Vexec_suffixes;
Lisp_Object Vdata_directory, Vdoc_directory;
Lisp_Object Vconfigure_info_directory, Vshared_game_score_directory;
Lisp_Object Vtemp_file_name_pattern;
Lisp_Object Vshell_file_name;
Lisp_Object Vprocess_environment;
#ifdef DOS_NT
Lisp_Object Qbuffer_file_type;
#endif
int synch_process_alive;
char *synch_process_death;
int synch_process_termsig;
int synch_process_retcode;
static int call_process_exited;
#ifndef VMS
static Lisp_Object
call_process_kill (fdpid)
Lisp_Object fdpid;
{
emacs_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;
{
#if defined (MSDOS) || defined (MAC_OS8)
register Lisp_Object file;
file = Fcdr (fdpid);
emacs_close (XFASTINT (Fcar (fdpid)));
if (strcmp (SDATA (file), NULL_DEVICE) != 0)
unlink (SDATA (file));
#else
register int pid = XFASTINT (Fcdr (fdpid));
if (call_process_exited)
{
emacs_close (XFASTINT (Fcar (fdpid)));
return Qnil;
}
if (EMACS_KILLPG (pid, SIGINT) == 0)
{
int count = SPECPDL_INDEX ();
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;
message1 ("Waiting for process to die...done");
}
synch_process_alive = 0;
emacs_close (XFASTINT (Fcar (fdpid)));
#endif
return Qnil;
}
DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
doc: )
(nargs, args)
int nargs;
register Lisp_Object *args;
{
Lisp_Object infile, buffer, current_dir, path;
int display_p;
int fd[2];
int filefd;
register int pid;
#define CALLPROC_BUFFER_SIZE_MIN (16 * 1024)
#define CALLPROC_BUFFER_SIZE_MAX (4 * CALLPROC_BUFFER_SIZE_MIN)
char buf[CALLPROC_BUFFER_SIZE_MAX];
int bufsize = CALLPROC_BUFFER_SIZE_MIN;
int count = SPECPDL_INDEX ();
register const unsigned char **new_argv
= (const unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
struct buffer *old = current_buffer;
Lisp_Object error_file;
#ifdef MSDOS
char *outf, *tempfile;
int outfilefd;
#endif
#ifdef MAC_OS8
char *tempfile;
int outfilefd;
#endif
#if 0
int mask;
#endif
struct coding_system process_coding;
struct coding_system argument_coding;
Lisp_Object coding_systems;
coding_systems = Qt;
CHECK_STRING (args[0]);
error_file = Qt;
#ifndef subprocesses
if (nargs >= 3
&& (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
error ("Operating system cannot handle asynchronous subprocesses");
#endif
{
Lisp_Object val, *args2;
int i;
if (nargs >= 5)
{
int must_encode = 0;
for (i = 4; i < nargs; i++)
CHECK_STRING (args[i]);
for (i = 4; i < nargs; i++)
if (STRING_MULTIBYTE (args[i]))
must_encode = 1;
if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
else if (! must_encode)
val = Qnil;
else
{
args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
args2[0] = Qcall_process;
for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
if (CONSP (coding_systems))
val = XCDR (coding_systems);
else if (CONSP (Vdefault_process_coding_system))
val = XCDR (Vdefault_process_coding_system);
else
val = Qnil;
}
setup_coding_system (Fcheck_coding_system (val), &argument_coding);
if (argument_coding.common_flags & CODING_ASCII_INCOMPATIBLE_MASK)
setup_coding_system (Qraw_text, &argument_coding);
if (argument_coding.eol_type == CODING_EOL_UNDECIDED)
argument_coding.eol_type = system_eol_type;
}
}
if (nargs >= 2 && ! NILP (args[1]))
{
infile = Fexpand_file_name (args[1], current_buffer->directory);
CHECK_STRING (infile);
}
else
infile = build_string (NULL_DEVICE);
if (nargs >= 3)
{
buffer = args[2];
if (CONSP (buffer))
{
if (CONSP (XCDR (buffer)))
{
Lisp_Object stderr_file;
stderr_file = XCAR (XCDR (buffer));
if (NILP (stderr_file) || EQ (Qt, stderr_file))
error_file = stderr_file;
else
error_file = Fexpand_file_name (stderr_file, Qnil);
}
buffer = XCAR (buffer);
}
if (!(EQ (buffer, Qnil)
|| EQ (buffer, Qt)
|| INTEGERP (buffer)))
{
Lisp_Object spec_buffer;
spec_buffer = buffer;
buffer = Fget_buffer_create (buffer);
if (NILP (buffer))
CHECK_BUFFER (spec_buffer);
CHECK_BUFFER (buffer);
}
}
else
buffer = Qnil;
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
current_dir = current_buffer->directory;
GCPRO4 (infile, buffer, current_dir, error_file);
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));
if (STRING_MULTIBYTE (infile))
infile = ENCODE_FILE (infile);
if (STRING_MULTIBYTE (current_dir))
current_dir = ENCODE_FILE (current_dir);
if (STRINGP (error_file) && STRING_MULTIBYTE (error_file))
error_file = ENCODE_FILE (error_file);
UNGCPRO;
}
display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
filefd = emacs_open (SDATA (infile), O_RDONLY, 0);
if (filefd < 0)
{
infile = DECODE_FILE (infile);
report_file_error ("Opening process input file", Fcons (infile, Qnil));
}
{
struct gcpro gcpro1;
GCPRO1 (current_dir);
openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK));
UNGCPRO;
}
if (NILP (path))
{
emacs_close (filefd);
report_file_error ("Searching for program", Fcons (args[0], Qnil));
}
if (SBYTES (path) > 2 && SREF (path, 0) == '/'
&& SREF (path, 1) == ':')
path = Fsubstring (path, make_number (2), Qnil);
new_argv[0] = SDATA (path);
if (nargs > 4)
{
register int i;
struct gcpro gcpro1, gcpro2, gcpro3;
GCPRO3 (infile, buffer, current_dir);
argument_coding.dst_multibyte = 0;
for (i = 4; i < nargs; i++)
{
argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
if (CODING_REQUIRE_ENCODING (&argument_coding))
{
args[i] = encode_coding_string (args[i], &argument_coding, 1);
if (argument_coding.type == coding_type_ccl)
setup_ccl_program (&(argument_coding.spec.ccl.encoder), Qnil);
}
new_argv[i - 3] = SDATA (args[i]);
}
UNGCPRO;
new_argv[nargs - 3] = 0;
}
else
new_argv[1] = 0;
#ifdef MSDOS
if ((outf = egetenv ("TMPDIR")))
strcpy (tempfile = alloca (strlen (outf) + 20), outf);
else
{
tempfile = alloca (20);
*tempfile = '\0';
}
dostounix_filename (tempfile);
if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
strcat (tempfile, "/");
strcat (tempfile, "detmp.XXX");
mktemp (tempfile);
outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
if (outfilefd < 0)
{
emacs_close (filefd);
report_file_error ("Opening process output file",
Fcons (build_string (tempfile), Qnil));
}
fd[0] = filefd;
fd[1] = outfilefd;
#endif
#ifdef MAC_OS8
tempfile = (char *) alloca (SBYTES (Vtemp_file_name_pattern) + 1);
bcopy (SDATA (Vtemp_file_name_pattern), tempfile,
SBYTES (Vtemp_file_name_pattern) + 1);
mktemp (tempfile);
outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
if (outfilefd < 0)
{
close (filefd);
report_file_error ("Opening process output file",
Fcons (build_string (tempfile), Qnil));
}
fd[0] = filefd;
fd[1] = outfilefd;
#endif
if (INTEGERP (buffer))
fd[1] = emacs_open (NULL_DEVICE, O_WRONLY, 0), fd[0] = -1;
else
{
#ifndef MSDOS
#ifndef MAC_OS8
errno = 0;
if (pipe (fd) == -1)
{
emacs_close (filefd);
report_file_error ("Creating process pipe", Qnil);
}
#endif
#endif
#if 0
set_exclusive_use (fd[0]);
#endif
}
{
register char **save_environ = environ;
register int fd1 = fd[1];
int fd_error = fd1;
#if 0
mask = sigblock (sigmask (SIGCHLD));
#endif
synch_process_alive = 1;
synch_process_death = 0;
synch_process_retcode = 0;
synch_process_termsig = 0;
if (NILP (error_file))
fd_error = emacs_open (NULL_DEVICE, O_WRONLY, 0);
else if (STRINGP (error_file))
{
#ifdef DOS_NT
fd_error = emacs_open (SDATA (error_file),
O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
S_IREAD | S_IWRITE);
#else
fd_error = creat (SDATA (error_file), 0666);
#endif
}
if (fd_error < 0)
{
emacs_close (filefd);
if (fd[0] != filefd)
emacs_close (fd[0]);
if (fd1 >= 0)
emacs_close (fd1);
#ifdef MSDOS
unlink (tempfile);
#endif
if (NILP (error_file))
error_file = build_string (NULL_DEVICE);
else if (STRINGP (error_file))
error_file = DECODE_FILE (error_file);
report_file_error ("Cannot redirect stderr", Fcons (error_file, Qnil));
}
#ifdef MAC_OS8
{
char *infn, *outfn, *errfn, *currdn;
close (outfilefd);
if (fd_error != outfilefd)
close (fd_error);
fd1 = -1;
infn = SDATA (infile);
outfn = tempfile;
if (NILP (error_file))
errfn = NULL_DEVICE;
else if (EQ (Qt, error_file))
errfn = outfn;
else
errfn = SDATA (error_file);
currdn = SDATA (current_dir);
pid = run_mac_command (new_argv, currdn, infn, outfn, errfn);
synch_process_alive = 0;
synch_process_retcode = pid;
if (synch_process_retcode < 0)
{
synchronize_system_messages_locale ();
synch_process_death = strerror (errno);
}
fd[0] = open (tempfile, O_BINARY);
if (fd[0] < 0)
{
unlink (tempfile);
close (filefd);
report_file_error ("Cannot re-open temporary file", Qnil);
}
}
#else
#ifdef MSDOS
pid = child_setup (filefd, outfilefd, fd_error, (char **) new_argv,
0, current_dir);
synch_process_alive = 0;
synch_process_retcode = pid;
if (synch_process_retcode < 0)
{
synchronize_system_messages_locale ();
synch_process_death = strerror (errno);
}
emacs_close (outfilefd);
if (fd_error != outfilefd)
emacs_close (fd_error);
fd1 = -1;
fd[0] = emacs_open (tempfile, O_RDONLY | O_BINARY, 0);
if (fd[0] < 0)
{
unlink (tempfile);
emacs_close (filefd);
report_file_error ("Cannot re-open temporary file", Qnil);
}
#else
#ifdef WINDOWSNT
pid = child_setup (filefd, fd1, fd_error, (char **) new_argv,
0, current_dir);
#else
BLOCK_INPUT;
pid = vfork ();
if (pid == 0)
{
if (fd[0] >= 0)
emacs_close (fd[0]);
#ifdef HAVE_SETSID
setsid ();
#endif
#if defined (USG) && !defined (BSD_PGRPS)
setpgrp ();
#else
setpgrp (pid, pid);
#endif
child_setup (filefd, fd1, fd_error, (char **) new_argv,
0, current_dir);
}
UNBLOCK_INPUT;
#endif
if (fd_error >= 0)
emacs_close (fd_error);
#endif
#endif
environ = save_environ;
emacs_close (filefd);
if (fd1 >= 0 && fd1 != fd_error)
emacs_close (fd1);
}
if (pid < 0)
{
if (fd[0] >= 0)
emacs_close (fd[0]);
report_file_error ("Doing vfork", Qnil);
}
if (INTEGERP (buffer))
{
if (fd[0] >= 0)
emacs_close (fd[0]);
#ifndef subprocesses
wait_without_blocking ();
#endif
return Qnil;
}
call_process_exited = 0;
#if defined(MSDOS) || defined(MAC_OS8)
record_unwind_protect (call_process_cleanup,
Fcons (make_number (fd[0]), build_string (tempfile)));
#else
record_unwind_protect (call_process_cleanup,
Fcons (make_number (fd[0]), make_number (pid)));
#endif
if (BUFFERP (buffer))
Fset_buffer (buffer);
if (NILP (buffer))
{
setup_coding_system (Qnil, &process_coding);
}
else
{
Lisp_Object val, *args2;
val = Qnil;
if (!NILP (Vcoding_system_for_read))
val = Vcoding_system_for_read;
else
{
if (EQ (coding_systems, Qt))
{
int i;
args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
args2[0] = Qcall_process;
for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
coding_systems
= Ffind_operation_coding_system (nargs + 1, args2);
}
if (CONSP (coding_systems))
val = XCAR (coding_systems);
else if (CONSP (Vdefault_process_coding_system))
val = XCAR (Vdefault_process_coding_system);
else
val = Qnil;
}
setup_coding_system (Fcheck_coding_system (val), &process_coding);
if (NILP (current_buffer->enable_multibyte_characters)
&& !NILP (val))
setup_raw_text_coding_system (&process_coding);
}
process_coding.src_multibyte = 0;
process_coding.dst_multibyte
= (BUFFERP (buffer)
? ! NILP (XBUFFER (buffer)->enable_multibyte_characters)
: ! NILP (current_buffer->enable_multibyte_characters));
immediate_quit = 1;
QUIT;
{
register int nread;
int first = 1;
int total_read = 0;
int carryover = 0;
int display_on_the_fly = display_p;
struct coding_system saved_coding;
int pt_orig = PT, pt_byte_orig = PT_BYTE;
int inserted;
saved_coding = process_coding;
if (process_coding.composing != COMPOSITION_DISABLED)
coding_allocate_composition_data (&process_coding, PT);
while (1)
{
nread = carryover;
while (nread < bufsize - 1024)
{
int this_read = emacs_read (fd[0], buf + nread,
bufsize - nread);
if (this_read < 0)
goto give_up;
if (this_read == 0)
{
process_coding.mode |= CODING_MODE_LAST_BLOCK;
break;
}
nread += this_read;
total_read += this_read;
if (display_on_the_fly)
break;
}
immediate_quit = 0;
if (!NILP (buffer))
{
if (! CODING_MAY_REQUIRE_DECODING (&process_coding))
insert_1_both (buf, nread, nread, 0, 1, 0);
else
{
int size;
char *decoding_buf;
repeat_decoding:
size = decoding_buffer_size (&process_coding, nread);
decoding_buf = (char *) xmalloc (size);
if (process_coding.type == coding_type_undecided)
{
detect_coding (&process_coding, buf, nread);
if (process_coding.composing != COMPOSITION_DISABLED)
coding_allocate_composition_data (&process_coding, PT);
}
if (process_coding.cmp_data)
process_coding.cmp_data->char_offset = PT;
decode_coding (&process_coding, buf, decoding_buf,
nread, size);
if (display_on_the_fly
&& saved_coding.type == coding_type_undecided
&& process_coding.type != coding_type_undecided)
{
xfree (decoding_buf);
display_on_the_fly = 0;
process_coding = saved_coding;
carryover = nread;
saved_coding.type = coding_type_no_conversion;
continue;
}
if (process_coding.produced > 0)
insert_1_both (decoding_buf, process_coding.produced_char,
process_coding.produced, 0, 1, 0);
xfree (decoding_buf);
if (process_coding.result == CODING_FINISH_INCONSISTENT_EOL)
{
Lisp_Object eol_type, coding;
if (process_coding.eol_type == CODING_EOL_CR)
{
unsigned char *p;
move_gap_both (PT, PT_BYTE);
p = BYTE_POS_ADDR (pt_byte_orig);
for (; p < GPT_ADDR; ++p)
if (*p == '\n')
*p = '\r';
}
else if (process_coding.eol_type == CODING_EOL_CRLF)
{
EMACS_INT bytepos, old_pt, old_pt_byte, nCR;
old_pt = PT;
old_pt_byte = PT_BYTE;
nCR = 0;
for (bytepos = PT_BYTE - 1;
bytepos >= pt_byte_orig;
--bytepos)
if (FETCH_BYTE (bytepos) == '\n')
{
EMACS_INT charpos = BYTE_TO_CHAR (bytepos);
TEMP_SET_PT_BOTH (charpos, bytepos);
insert_1_both ("\r", 1, 1, 0, 1, 0);
++nCR;
}
TEMP_SET_PT_BOTH (old_pt + nCR, old_pt_byte + nCR);
}
eol_type = Fget (saved_coding.symbol, Qeol_type);
if (VECTORP (eol_type)
&& ASIZE (eol_type) == 3
&& SYMBOLP (AREF (eol_type, CODING_EOL_LF)))
coding = AREF (eol_type, CODING_EOL_LF);
else
coding = saved_coding.symbol;
process_coding.symbol = coding;
process_coding.eol_type = CODING_EOL_LF;
process_coding.mode
&= ~CODING_MODE_INHIBIT_INCONSISTENT_EOL;
}
nread -= process_coding.consumed;
carryover = nread;
if (carryover > 0)
BCOPY_SHORT (buf + process_coding.consumed, buf,
carryover);
if (process_coding.result == CODING_FINISH_INSUFFICIENT_CMP)
{
coding_allocate_composition_data (&process_coding, PT);
goto repeat_decoding;
}
}
}
if (process_coding.mode & CODING_MODE_LAST_BLOCK)
break;
#if (CALLPROC_BUFFER_SIZE_MIN != CALLPROC_BUFFER_SIZE_MAX)
if (bufsize < CALLPROC_BUFFER_SIZE_MAX && total_read > 32 * bufsize)
if ((bufsize *= 2) > CALLPROC_BUFFER_SIZE_MAX)
bufsize = CALLPROC_BUFFER_SIZE_MAX;
#endif
if (display_p)
{
if (first)
prepare_menu_bars ();
first = 0;
redisplay_preserve_echo_area (1);
display_on_the_fly = 1;
}
immediate_quit = 1;
QUIT;
}
give_up: ;
if (!NILP (buffer)
&& process_coding.cmp_data)
{
coding_restore_composition (&process_coding, Fcurrent_buffer ());
coding_free_composition_data (&process_coding);
}
{
int post_read_count = SPECPDL_INDEX ();
record_unwind_protect (save_excursion_restore, save_excursion_save ());
inserted = PT - pt_orig;
TEMP_SET_PT_BOTH (pt_orig, pt_byte_orig);
if (SYMBOLP (process_coding.post_read_conversion)
&& !NILP (Ffboundp (process_coding.post_read_conversion)))
call1 (process_coding.post_read_conversion, make_number (inserted));
Vlast_coding_system_used = process_coding.symbol;
if (inherit_process_coding_system)
call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
make_number (total_read));
unbind_to (post_read_count, Qnil);
}
}
wait_for_termination (pid);
immediate_quit = 0;
set_buffer_internal (old);
call_process_exited = 1;
unbind_to (count, Qnil);
if (synch_process_termsig)
{
char *signame;
synchronize_system_messages_locale ();
signame = strsignal (synch_process_termsig);
if (signame == 0)
signame = "unknown";
synch_process_death = signame;
}
if (synch_process_death)
return code_convert_string_norecord (build_string (synch_process_death),
Vlocale_coding_system, 0);
return make_number (synch_process_retcode);
}
#endif
static Lisp_Object
delete_temp_file (name)
Lisp_Object name;
{
int count = SPECPDL_INDEX ();
specbind (intern ("file-name-handler-alist"), Qnil);
internal_delete_file (name);
unbind_to (count, Qnil);
return Qnil;
}
DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
3, MANY, 0,
doc: )
(nargs, args)
int nargs;
register Lisp_Object *args;
{
struct gcpro gcpro1;
Lisp_Object filename_string;
register Lisp_Object start, end;
int count = SPECPDL_INDEX ();
Lisp_Object coding_systems;
Lisp_Object val, *args2;
int i;
#ifdef DOS_NT
char *tempfile;
char *outf = '\0';
if ((outf = egetenv ("TMPDIR"))
|| (outf = egetenv ("TMP"))
|| (outf = egetenv ("TEMP")))
strcpy (tempfile = alloca (strlen (outf) + 20), outf);
else
{
tempfile = alloca (20);
*tempfile = '\0';
}
if (!IS_DIRECTORY_SEP (tempfile[strlen (tempfile) - 1]))
strcat (tempfile, "/");
if ('/' == DIRECTORY_SEP)
dostounix_filename (tempfile);
else
unixtodos_filename (tempfile);
#ifdef WINDOWSNT
strcat (tempfile, "emXXXXXX");
#else
strcat (tempfile, "detmp.XXX");
#endif
#else
char *tempfile = (char *) alloca (SBYTES (Vtemp_file_name_pattern) + 1);
bcopy (SDATA (Vtemp_file_name_pattern), tempfile,
SBYTES (Vtemp_file_name_pattern) + 1);
#endif
coding_systems = Qt;
#ifdef HAVE_MKSTEMP
{
int fd;
BLOCK_INPUT;
fd = mkstemp (tempfile);
UNBLOCK_INPUT;
if (fd == -1)
report_file_error ("Failed to open temporary file",
Fcons (Vtemp_file_name_pattern, Qnil));
else
close (fd);
}
#else
mktemp (tempfile);
#endif
filename_string = build_string (tempfile);
GCPRO1 (filename_string);
start = args[0];
end = args[1];
if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
else if (NILP (current_buffer->enable_multibyte_characters))
val = Qnil;
else
{
args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
args2[0] = Qcall_process_region;
for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
if (CONSP (coding_systems))
val = XCDR (coding_systems);
else if (CONSP (Vdefault_process_coding_system))
val = XCDR (Vdefault_process_coding_system);
else
val = Qnil;
}
{
int count1 = SPECPDL_INDEX ();
specbind (intern ("coding-system-for-write"), val);
specbind (intern ("file-name-handler-alist"), Qnil);
Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil);
unbind_to (count1, Qnil);
}
record_unwind_protect (delete_temp_file, filename_string);
if (nargs > 3 && !NILP (args[3]))
Fdelete_region (start, end);
if (nargs > 3)
{
args += 2;
nargs -= 2;
}
else
{
args[0] = args[2];
nargs = 2;
}
args[1] = filename_string;
RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args)));
}
#ifndef VMS
static int relocate_fd ();
int
child_setup (in, out, err, new_argv, set_pgrp, current_dir)
int in, out, err;
register char **new_argv;
int set_pgrp;
Lisp_Object current_dir;
{
char **env;
char *pwd_var;
#ifdef WINDOWSNT
int cpid;
HANDLE handles[3];
#endif
int pid = getpid ();
#ifdef SET_EMACS_PRIORITY
{
extern EMACS_INT emacs_priority;
if (emacs_priority < 0)
nice (- emacs_priority);
}
#endif
#ifdef subprocesses
close_process_descs ();
#endif
#ifndef DOS_NT
close_load_descs ();
#endif
{
register char *temp;
register int i;
i = SBYTES (current_dir);
#ifdef MSDOS
pwd_var = (char *) xmalloc (i + 6);
#else
pwd_var = (char *) alloca (i + 6);
#endif
temp = pwd_var + 4;
bcopy ("PWD=", pwd_var, 4);
bcopy (SDATA (current_dir), temp, i);
if (!IS_DIRECTORY_SEP (temp[i - 1])) temp[i++] = DIRECTORY_SEP;
temp[i] = 0;
#ifndef DOS_NT
if (chdir (temp) < 0)
_exit (errno);
#endif
#ifdef DOS_NT
if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
{
temp += 2;
i -= 2;
}
#endif
while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
temp[--i] = 0;
}
{
register Lisp_Object tem;
register char **new_env;
register int new_length;
new_length = 0;
for (tem = Vprocess_environment;
CONSP (tem) && STRINGP (XCAR (tem));
tem = XCDR (tem))
new_length++;
env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *));
if (getenv ("PWD"))
*new_env++ = pwd_var;
for (tem = Vprocess_environment;
CONSP (tem) && STRINGP (XCAR (tem));
tem = XCDR (tem))
{
char **ep = env;
char *string = (char *) SDATA (XCAR (tem));
for (; ep != new_env; ep++)
{
char *p = *ep, *q = string;
while (1)
{
if (*q == 0)
goto duplicate;
if (*q != *p)
break;
if (*q == '=')
goto duplicate;
p++, q++;
}
}
*new_env++ = string;
duplicate: ;
}
*new_env = 0;
}
#ifdef WINDOWSNT
prepare_standard_handles (in, out, err, handles);
set_process_dir (SDATA (current_dir));
#else
{
int oin = in, oout = out;
in = relocate_fd (in, 3);
if (out == oin)
out = in;
else
out = relocate_fd (out, 3);
if (err == oin)
err = in;
else if (err == oout)
err = out;
else
err = relocate_fd (err, 3);
}
#ifndef MSDOS
emacs_close (0);
emacs_close (1);
emacs_close (2);
dup2 (in, 0);
dup2 (out, 1);
dup2 (err, 2);
emacs_close (in);
emacs_close (out);
emacs_close (err);
#endif
#endif
#if defined(USG) && !defined(BSD_PGRPS)
#ifndef SETPGRP_RELEASES_CTTY
setpgrp ();
#endif
#else
setpgrp (pid, pid);
#endif
EMACS_SET_TTY_PGRP (0, &pid);
#ifdef MSDOS
pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
xfree (pwd_var);
if (pid == -1)
report_file_error ("Spawning child process", Qnil);
return pid;
#else
#ifdef WINDOWSNT
cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
reset_standard_handles (in, out, err, handles);
if (cpid == -1)
report_file_error ("Spawning child process", Qnil);
return cpid;
#else
environ = env;
execvp (new_argv[0], new_argv);
emacs_write (1, "Can't exec program: ", 20);
emacs_write (1, new_argv[0], strlen (new_argv[0]));
emacs_write (1, "\n", 1);
_exit (1);
#endif
#endif
}
static int
relocate_fd (fd, minfd)
int fd, minfd;
{
if (fd >= minfd)
return fd;
else
{
int new = dup (fd);
if (new == -1)
{
char *message1 = "Error while setting up child: ";
char *errmessage = strerror (errno);
char *message2 = "\n";
emacs_write (2, message1, strlen (message1));
emacs_write (2, errmessage, strlen (errmessage));
emacs_write (2, message2, strlen (message2));
_exit (1);
}
new = relocate_fd (new, minfd);
emacs_close (fd);
return new;
}
}
static int
getenv_internal (var, varlen, value, valuelen)
char *var;
int varlen;
char **value;
int *valuelen;
{
Lisp_Object scan;
for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
{
Lisp_Object entry;
entry = XCAR (scan);
if (STRINGP (entry)
&& SBYTES (entry) > varlen
&& SREF (entry, varlen) == '='
#ifdef WINDOWSNT
&& ! strnicmp (SDATA (entry), var, varlen)
#else
&& ! bcmp (SDATA (entry), var, varlen)
#endif
)
{
*value = (char *) SDATA (entry) + (varlen + 1);
*valuelen = SBYTES (entry) - (varlen + 1);
return 1;
}
}
return 0;
}
DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 1, 0,
doc: )
(var)
Lisp_Object var;
{
char *value;
int valuelen;
CHECK_STRING (var);
if (getenv_internal (SDATA (var), SBYTES (var),
&value, &valuelen))
return make_string (value, valuelen);
else
return Qnil;
}
char *
egetenv (var)
char *var;
{
char *value;
int valuelen;
if (getenv_internal (var, strlen (var), &value, &valuelen))
return value;
else
return 0;
}
#endif
void
init_callproc_1 ()
{
char *data_dir = egetenv ("EMACSDATA");
char *doc_dir = egetenv ("EMACSDOC");
Vdata_directory
= Ffile_name_as_directory (build_string (data_dir ? data_dir
: PATH_DATA));
Vdoc_directory
= Ffile_name_as_directory (build_string (doc_dir ? doc_dir
: PATH_DOC));
Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
}
void
init_callproc ()
{
char *data_dir = egetenv ("EMACSDATA");
register char * sh;
Lisp_Object tempdir;
if (!NILP (Vinstallation_directory))
{
Lisp_Object tem;
tem = Fexpand_file_name (build_string ("lib-src"),
Vinstallation_directory);
#ifndef DOS_NT
if (NILP (Fmember (tem, Vexec_path)))
{
Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
Vexec_path = Fcons (tem, Vexec_path);
Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
}
Vexec_directory = Ffile_name_as_directory (tem);
#endif
if (data_dir == 0)
{
tem = Fexpand_file_name (build_string ("etc"),
Vinstallation_directory);
Vdoc_directory = Ffile_name_as_directory (tem);
}
}
if (data_dir == 0)
{
Lisp_Object tem, tem1, srcdir;
srcdir = Fexpand_file_name (build_string ("../src/"),
build_string (PATH_DUMPLOADSEARCH));
tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory);
tem1 = Ffile_exists_p (tem);
if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1))
{
Lisp_Object newdir;
newdir = Fexpand_file_name (build_string ("../etc/"),
build_string (PATH_DUMPLOADSEARCH));
tem = Fexpand_file_name (build_string ("GNU"), newdir);
tem1 = Ffile_exists_p (tem);
if (!NILP (tem1))
Vdata_directory = newdir;
}
}
#ifndef CANNOT_DUMP
if (initialized)
#endif
{
tempdir = Fdirectory_file_name (Vexec_directory);
if (access (SDATA (tempdir), 0) < 0)
dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
Vexec_directory);
}
tempdir = Fdirectory_file_name (Vdata_directory);
if (access (SDATA (tempdir), 0) < 0)
dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
Vdata_directory);
#ifdef VMS
Vshell_file_name = build_string ("*dcl*");
#else
sh = (char *) getenv ("SHELL");
Vshell_file_name = build_string (sh ? sh : "/bin/sh");
#endif
#ifdef VMS
Vtemp_file_name_pattern = build_string ("tmp:emacsXXXXXX.");
#else
if (getenv ("TMPDIR"))
{
char *dir = getenv ("TMPDIR");
Vtemp_file_name_pattern
= Fexpand_file_name (build_string ("emacsXXXXXX"),
build_string (dir));
}
else
Vtemp_file_name_pattern = build_string ("/tmp/emacsXXXXXX");
#endif
#ifdef DOS_NT
Vshared_game_score_directory = Qnil;
#else
Vshared_game_score_directory = build_string (PATH_GAME);
if (NILP (Ffile_directory_p (Vshared_game_score_directory)))
Vshared_game_score_directory = Qnil;
#endif
}
void
set_process_environment ()
{
register char **envp;
Vprocess_environment = Qnil;
#ifndef CANNOT_DUMP
if (initialized)
#endif
for (envp = environ; *envp; envp++)
Vprocess_environment = Fcons (build_string (*envp),
Vprocess_environment);
}
void
syms_of_callproc ()
{
#ifdef DOS_NT
Qbuffer_file_type = intern ("buffer-file-type");
staticpro (&Qbuffer_file_type);
#endif
DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
doc: );
DEFVAR_LISP ("exec-path", &Vexec_path,
doc: );
DEFVAR_LISP ("exec-suffixes", &Vexec_suffixes,
doc: );
Vexec_suffixes = Qnil;
DEFVAR_LISP ("exec-directory", &Vexec_directory,
doc: );
DEFVAR_LISP ("data-directory", &Vdata_directory,
doc: );
DEFVAR_LISP ("doc-directory", &Vdoc_directory,
doc: );
DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory,
doc: );
Vconfigure_info_directory = build_string (PATH_INFO);
DEFVAR_LISP ("shared-game-score-directory", &Vshared_game_score_directory,
doc: );
#ifdef DOS_NT
Vshared_game_score_directory = Qnil;
#else
Vshared_game_score_directory = build_string (PATH_GAME);
#endif
DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern,
doc: );
DEFVAR_LISP ("process-environment", &Vprocess_environment,
doc: );
#ifndef VMS
defsubr (&Scall_process);
defsubr (&Sgetenv_internal);
#endif
defsubr (&Scall_process_region);
}