* src/callproc.c (SIGCHLD): Remove conditional definition, syssignal.h defines it.
[bpt/emacs.git] / src / callproc.c
CommitLineData
80856e74 1/* Synchronous subprocess invocation for GNU Emacs.
fe12847a 2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1999, 2000, 2001,
114f9c96 3 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
8cabe764 4 Free Software Foundation, Inc.
80856e74
JB
5
6This file is part of GNU Emacs.
7
9ec0b715 8GNU Emacs is free software: you can redistribute it and/or modify
80856e74 9it under the terms of the GNU General Public License as published by
9ec0b715
GM
10the Free Software Foundation, either version 3 of the License, or
11(at your option) any later version.
80856e74
JB
12
13GNU Emacs is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
9ec0b715 19along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
80856e74
JB
20
21
68c45bf0 22#include <config.h>
80856e74 23#include <signal.h>
e576cab4 24#include <errno.h>
565620a5 25#include <stdio.h>
d7306fe6 26#include <setjmp.h>
80856e74 27#include <sys/types.h>
88a64fef 28
3cbd6585
GM
29#ifdef HAVE_UNISTD_H
30#include <unistd.h>
31#endif
32
80856e74 33#include <sys/file.h>
776a24a1 34#ifdef HAVE_FCNTL_H
80856e74
JB
35#include <fcntl.h>
36#endif
37
bad95d8f
RS
38#ifdef WINDOWSNT
39#define NOMINMAX
40#include <windows.h>
41#include <stdlib.h> /* for proper declaration of environ */
42#include <fcntl.h>
489f9371 43#include "w32.h"
bad95d8f
RS
44#define _P_NOWAIT 1 /* from process.h */
45#endif
46
7e6c2178
RS
47#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
48#include <fcntl.h>
49#include <sys/stat.h>
50#include <sys/param.h>
7e6c2178
RS
51#endif /* MSDOS */
52
80856e74
JB
53#ifndef O_RDONLY
54#define O_RDONLY 0
55#endif
56
57#ifndef O_WRONLY
58#define O_WRONLY 1
59#endif
60
61#include "lisp.h"
62#include "commands.h"
63#include "buffer.h"
91183bfd 64#include "character.h"
edf496dd 65#include "ccl.h"
32d08644 66#include "coding.h"
f0b950cf 67#include "composite.h"
57bda87a 68#include <epaths.h>
80856e74 69#include "process.h"
d177f194 70#include "syssignal.h"
a129418f 71#include "systty.h"
aba637ec 72#include "blockinput.h"
f105f403
KL
73#include "frame.h"
74#include "termhooks.h"
80856e74 75
5f027cea
EZ
76#ifdef MSDOS
77#include "msdos.h"
78#endif
79
03695ace 80#ifndef USE_CRT_DLL
80856e74
JB
81extern char **environ;
82#endif
83
f95c3f91 84#ifdef HAVE_SETPGID
58eb6cf0 85#if !defined (USG)
320695d8 86#undef setpgrp
f95c3f91
GM
87#define setpgrp setpgid
88#endif
2b7e8799 89#endif
f95c3f91 90
b81a1b72
SM
91Lisp_Object Vexec_path, Vexec_directory, Vexec_suffixes;
92Lisp_Object Vdata_directory, Vdoc_directory;
1e7ce61b 93Lisp_Object Vconfigure_info_directory, Vshared_game_score_directory;
f92d51d8
CY
94
95/* Pattern used by call-process-region to make temp files. */
96static Lisp_Object Vtemp_file_name_pattern;
97
80856e74
JB
98Lisp_Object Vshell_file_name;
99
6b8e474c 100Lisp_Object Vprocess_environment, Vinitial_environment;
80856e74 101
bad95d8f 102#ifdef DOS_NT
093650fe 103Lisp_Object Qbuffer_file_type;
bad95d8f 104#endif /* DOS_NT */
093650fe 105
e0f24100 106/* True if we are about to fork off a synchronous process or if we
80856e74
JB
107 are waiting for it. */
108int synch_process_alive;
109
110/* Nonzero => this is a string explaining death of synchronous subprocess. */
42ca4633 111const char *synch_process_death;
80856e74 112
6b61353c
KH
113/* Nonzero => this is the signal number that terminated the subprocess. */
114int synch_process_termsig;
115
80856e74
JB
116/* If synch_process_death is zero,
117 this is exit code of synchronous subprocess. */
118int synch_process_retcode;
f105f403 119
80856e74 120\f
37d54121
RS
121/* Clean up when exiting Fcall_process.
122 On MSDOS, delete the temporary file on any kind of termination.
123 On Unix, kill the process and any children on termination by signal. */
124
125/* Nonzero if this is termination due to exit. */
126static int call_process_exited;
127
d2bb6598
SM
128EXFUN (Fgetenv_internal, 2);
129
d177f194 130static Lisp_Object
971de7fb 131call_process_kill (Lisp_Object fdpid)
d177f194 132{
68c45bf0 133 emacs_close (XFASTINT (Fcar (fdpid)));
d177f194
JB
134 EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
135 synch_process_alive = 0;
136 return Qnil;
137}
138
80856e74 139Lisp_Object
971de7fb 140call_process_cleanup (Lisp_Object arg)
80856e74 141{
ad3aaf33
AS
142 Lisp_Object fdpid = Fcdr (arg);
143#if defined (MSDOS)
144 Lisp_Object file;
145#else
146 int pid;
147#endif
148
149 Fset_buffer (Fcar (arg));
150
e39a993c 151#if defined (MSDOS)
7e6c2178 152 /* for MSDOS fdpid is really (fd . tempfile) */
c1350752 153 file = Fcdr (fdpid);
68c45bf0 154 emacs_close (XFASTINT (Fcar (fdpid)));
d5db4077
KR
155 if (strcmp (SDATA (file), NULL_DEVICE) != 0)
156 unlink (SDATA (file));
e39a993c 157#else /* not MSDOS */
ad3aaf33 158 pid = XFASTINT (Fcdr (fdpid));
d177f194 159
37d54121 160 if (call_process_exited)
6b6e798b 161 {
68c45bf0 162 emacs_close (XFASTINT (Fcar (fdpid)));
6b6e798b
RS
163 return Qnil;
164 }
37d54121 165
d177f194
JB
166 if (EMACS_KILLPG (pid, SIGINT) == 0)
167 {
aed13378 168 int count = SPECPDL_INDEX ();
d177f194
JB
169 record_unwind_protect (call_process_kill, fdpid);
170 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
171 immediate_quit = 1;
172 QUIT;
173 wait_for_termination (pid);
174 immediate_quit = 0;
175 specpdl_ptr = specpdl + count; /* Discard the unwind protect. */
176 message1 ("Waiting for process to die...done");
177 }
80856e74 178 synch_process_alive = 0;
68c45bf0 179 emacs_close (XFASTINT (Fcar (fdpid)));
7e6c2178 180#endif /* not MSDOS */
80856e74
JB
181 return Qnil;
182}
183
184DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
fdb82f93
PJ
185 doc: /* Call PROGRAM synchronously in separate process.
186The remaining arguments are optional.
187The program's input comes from file INFILE (nil means `/dev/null').
188Insert output in BUFFER before point; t means current buffer;
189 nil for BUFFER means discard it; 0 means discard and don't wait.
190BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
191REAL-BUFFER says what to do with standard output, as above,
192while STDERR-FILE says what to do with standard error in the child.
193STDERR-FILE may be nil (discard standard error output),
194t (mix it with ordinary output), or a file name string.
195
196Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
197Remaining arguments are strings passed as command arguments to PROGRAM.
198
a4feb144
RS
199If executable PROGRAM can't be found as an executable, `call-process'
200signals a Lisp error. `call-process' reports errors in execution of
201the program only through its return and output.
202
fdb82f93
PJ
203If BUFFER is 0, `call-process' returns immediately with value nil.
204Otherwise it waits for PROGRAM to terminate
205and returns a numeric exit status or a signal description string.
d98b59b5
MB
206If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
207
208usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
5842a27b 209 (int nargs, register Lisp_Object *args)
80856e74 210{
0aa2630f
KS
211 Lisp_Object infile, buffer, current_dir, path;
212 int display_p;
80856e74
JB
213 int fd[2];
214 int filefd;
215 register int pid;
4da256b1
KS
216#define CALLPROC_BUFFER_SIZE_MIN (16 * 1024)
217#define CALLPROC_BUFFER_SIZE_MAX (4 * CALLPROC_BUFFER_SIZE_MIN)
218 char buf[CALLPROC_BUFFER_SIZE_MAX];
219 int bufsize = CALLPROC_BUFFER_SIZE_MIN;
aed13378 220 int count = SPECPDL_INDEX ();
2d607244 221
1aa83b22 222 register const unsigned char **new_argv;
39eaa782
RS
223 /* File to use for stderr in the child.
224 t means use same as standard output. */
225 Lisp_Object error_file;
7e6c2178
RS
226#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
227 char *outf, *tempfile;
228 int outfilefd;
80856e74 229#endif
32d08644
KH
230 struct coding_system process_coding; /* coding-system of process output */
231 struct coding_system argument_coding; /* coding-system of arguments */
09494912
RS
232 /* Set to the return value of Ffind_operation_coding_system. */
233 Lisp_Object coding_systems;
234
235 /* Qt denotes that Ffind_operation_coding_system is not yet called. */
236 coding_systems = Qt;
32d08644 237
b7826503 238 CHECK_STRING (args[0]);
80856e74 239
39eaa782
RS
240 error_file = Qt;
241
7e6c2178
RS
242#ifndef subprocesses
243 /* Without asynchronous processes we cannot have BUFFER == 0. */
177c0ea7 244 if (nargs >= 3
09ffb8b5 245 && (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
7e6c2178
RS
246 error ("Operating system cannot handle asynchronous subprocesses");
247#endif /* subprocesses */
248
09494912 249 /* Decide the coding-system for giving arguments. */
32d08644
KH
250 {
251 Lisp_Object val, *args2;
32d08644
KH
252 int i;
253
254 /* If arguments are supplied, we may have to encode them. */
255 if (nargs >= 5)
256 {
30d57b8e 257 int must_encode = 0;
6e50da0a 258 Lisp_Object coding_attrs;
30d57b8e 259
e7c1c20e 260 for (i = 4; i < nargs; i++)
b7826503 261 CHECK_STRING (args[i]);
e7c1c20e 262
a2286b5c 263 for (i = 4; i < nargs; i++)
30d57b8e
RS
264 if (STRING_MULTIBYTE (args[i]))
265 must_encode = 1;
266
beacaab3
KH
267 if (!NILP (Vcoding_system_for_write))
268 val = Vcoding_system_for_write;
30d57b8e 269 else if (! must_encode)
beacaab3
KH
270 val = Qnil;
271 else
32d08644
KH
272 {
273 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
274 args2[0] = Qcall_process;
275 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
08ee4e87 276 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
776b95cb 277 if (CONSP (coding_systems))
70949dac 278 val = XCDR (coding_systems);
776b95cb 279 else if (CONSP (Vdefault_process_coding_system))
70949dac 280 val = XCDR (Vdefault_process_coding_system);
beacaab3
KH
281 else
282 val = Qnil;
32d08644 283 }
b4413d9f 284 val = coding_inherit_eol_type (val, Qnil);
32d08644 285 setup_coding_system (Fcheck_coding_system (val), &argument_coding);
6e50da0a
KH
286 coding_attrs = CODING_ID_ATTRS (argument_coding.id);
287 if (NILP (CODING_ATTR_ASCII_COMPAT (coding_attrs)))
288 {
289 /* We should not use an ASCII incompatible coding system. */
290 val = raw_text_coding_system (val);
291 setup_coding_system (val, &argument_coding);
292 }
32d08644 293 }
32d08644
KH
294 }
295
e576cab4
JB
296 if (nargs >= 2 && ! NILP (args[1]))
297 {
298 infile = Fexpand_file_name (args[1], current_buffer->directory);
b7826503 299 CHECK_STRING (infile);
e576cab4 300 }
80856e74 301 else
5437e9f9 302 infile = build_string (NULL_DEVICE);
80856e74 303
e576cab4
JB
304 if (nargs >= 3)
305 {
39eaa782
RS
306 buffer = args[2];
307
308 /* If BUFFER is a list, its meaning is
309 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
310 if (CONSP (buffer))
311 {
70949dac 312 if (CONSP (XCDR (buffer)))
45be8a1e 313 {
a9d4f28a 314 Lisp_Object stderr_file;
70949dac 315 stderr_file = XCAR (XCDR (buffer));
45be8a1e
RS
316
317 if (NILP (stderr_file) || EQ (Qt, stderr_file))
318 error_file = stderr_file;
319 else
320 error_file = Fexpand_file_name (stderr_file, Qnil);
321 }
322
70949dac 323 buffer = XCAR (buffer);
39eaa782 324 }
044512ed 325
39eaa782
RS
326 if (!(EQ (buffer, Qnil)
327 || EQ (buffer, Qt)
3ffde7d6 328 || INTEGERP (buffer)))
e576cab4 329 {
39eaa782
RS
330 Lisp_Object spec_buffer;
331 spec_buffer = buffer;
50fe359b 332 buffer = Fget_buffer_create (buffer);
39eaa782
RS
333 /* Mention the buffer name for a better error message. */
334 if (NILP (buffer))
b7826503
PJ
335 CHECK_BUFFER (spec_buffer);
336 CHECK_BUFFER (buffer);
e576cab4
JB
337 }
338 }
177c0ea7 339 else
e576cab4 340 buffer = Qnil;
80856e74 341
58616e67
JB
342 /* Make sure that the child will be able to chdir to the current
343 buffer's current directory, or its unhandled equivalent. We
344 can't just have the child check for an error when it does the
345 chdir, since it's in a vfork.
346
347 We have to GCPRO around this because Fexpand_file_name,
348 Funhandled_file_name_directory, and Ffile_accessible_directory_p
349 might call a file name handling function. The argument list is
350 protected by the caller, so all we really have to worry about is
351 buffer. */
352 {
34b87689 353 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
58616e67
JB
354
355 current_dir = current_buffer->directory;
356
34b87689 357 GCPRO4 (infile, buffer, current_dir, error_file);
58616e67 358
ca319910
SM
359 current_dir = Funhandled_file_name_directory (current_dir);
360 if (NILP (current_dir))
361 /* If the file name handler says that current_dir is unreachable, use
362 a sensible default. */
363 current_dir = build_string ("~/");
364 current_dir = expand_and_dir_to_file (current_dir, Qnil);
db8454b0
CY
365 current_dir = Ffile_name_as_directory (current_dir);
366
58616e67
JB
367 if (NILP (Ffile_accessible_directory_p (current_dir)))
368 report_file_error ("Setting current directory",
369 Fcons (current_buffer->directory, Qnil));
370
34b87689
KH
371 if (STRING_MULTIBYTE (infile))
372 infile = ENCODE_FILE (infile);
373 if (STRING_MULTIBYTE (current_dir))
374 current_dir = ENCODE_FILE (current_dir);
375 if (STRINGP (error_file) && STRING_MULTIBYTE (error_file))
376 error_file = ENCODE_FILE (error_file);
58616e67
JB
377 UNGCPRO;
378 }
379
0aa2630f 380 display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
80856e74 381
d5db4077 382 filefd = emacs_open (SDATA (infile), O_RDONLY, 0);
80856e74
JB
383 if (filefd < 0)
384 {
34b87689 385 infile = DECODE_FILE (infile);
e576cab4 386 report_file_error ("Opening process input file", Fcons (infile, Qnil));
80856e74
JB
387 }
388 /* Search for program; barf if not found. */
c52b0b34 389 {
ad3aaf33 390 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
c52b0b34 391
ad3aaf33 392 GCPRO4 (infile, buffer, current_dir, error_file);
5c150961 393 openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK));
c52b0b34
KH
394 UNGCPRO;
395 }
012c6fcb 396 if (NILP (path))
80856e74 397 {
68c45bf0 398 emacs_close (filefd);
80856e74
JB
399 report_file_error ("Searching for program", Fcons (args[0], Qnil));
400 }
8ee8f447
RS
401
402 /* If program file name starts with /: for quoting a magic name,
403 discard that. */
404 if (SBYTES (path) > 2 && SREF (path, 0) == '/'
405 && SREF (path, 1) == ':')
406 path = Fsubstring (path, make_number (2), Qnil);
407
1aa83b22
AS
408 new_argv = (const unsigned char **)
409 alloca (max (2, nargs - 2) * sizeof (char *));
c364e618
KH
410 if (nargs > 4)
411 {
412 register int i;
ad3aaf33 413 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
c364e618 414
ad3aaf33 415 GCPRO5 (infile, buffer, current_dir, path, error_file);
c5bfa12b
KH
416 argument_coding.dst_multibyte = 0;
417 for (i = 4; i < nargs; i++)
c364e618 418 {
c5bfa12b
KH
419 argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
420 if (CODING_REQUIRE_ENCODING (&argument_coding))
91183bfd
KH
421 /* We must encode this argument. */
422 args[i] = encode_coding_string (&argument_coding, args[i], 1);
c364e618 423 }
c5bfa12b 424 UNGCPRO;
1aa83b22
AS
425 for (i = 4; i < nargs; i++)
426 new_argv[i - 3] = SDATA (args[i]);
427 new_argv[i - 3] = 0;
c364e618 428 }
db54baaa
KH
429 else
430 new_argv[1] = 0;
1aa83b22 431 new_argv[0] = SDATA (path);
80856e74 432
7e6c2178 433#ifdef MSDOS /* MW, July 1993 */
8a52365c 434 if ((outf = egetenv ("TMPDIR")))
7e6c2178
RS
435 strcpy (tempfile = alloca (strlen (outf) + 20), outf);
436 else
437 {
438 tempfile = alloca (20);
439 *tempfile = '\0';
440 }
441 dostounix_filename (tempfile);
177c0ea7 442 if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
7e6c2178
RS
443 strcat (tempfile, "/");
444 strcat (tempfile, "detmp.XXX");
445 mktemp (tempfile);
446
447 outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
448 if (outfilefd < 0)
449 {
68c45bf0 450 emacs_close (filefd);
6f89d28a
MB
451 report_file_error ("Opening process output file",
452 Fcons (build_string (tempfile), Qnil));
7e6c2178 453 }
6f89d28a 454 fd[0] = filefd;
2610078a 455 fd[1] = outfilefd;
6f89d28a 456#endif /* MSDOS */
7e6c2178 457
d50d3dc8 458 if (INTEGERP (buffer))
68c45bf0 459 fd[1] = emacs_open (NULL_DEVICE, O_WRONLY, 0), fd[0] = -1;
80856e74
JB
460 else
461 {
7e6c2178 462#ifndef MSDOS
db92b288
GM
463 errno = 0;
464 if (pipe (fd) == -1)
465 {
466 emacs_close (filefd);
467 report_file_error ("Creating process pipe", Qnil);
468 }
80856e74
JB
469#endif
470 }
471
472 {
473 /* child_setup must clobber environ in systems with true vfork.
474 Protect it from permanent change. */
475 register char **save_environ = environ;
476 register int fd1 = fd[1];
39eaa782 477 int fd_error = fd1;
80856e74
JB
478
479#if 0 /* Some systems don't have sigblock. */
e065a56e 480 mask = sigblock (sigmask (SIGCHLD));
80856e74
JB
481#endif
482
483 /* Record that we're about to create a synchronous process. */
484 synch_process_alive = 1;
485
5c03767e
RS
486 /* These vars record information from process termination.
487 Clear them now before process can possibly terminate,
488 to avoid timing error if process terminates soon. */
489 synch_process_death = 0;
490 synch_process_retcode = 0;
6b61353c 491 synch_process_termsig = 0;
5c03767e 492
39eaa782 493 if (NILP (error_file))
68c45bf0 494 fd_error = emacs_open (NULL_DEVICE, O_WRONLY, 0);
39eaa782
RS
495 else if (STRINGP (error_file))
496 {
497#ifdef DOS_NT
d5db4077 498 fd_error = emacs_open (SDATA (error_file),
68c45bf0
PE
499 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
500 S_IREAD | S_IWRITE);
39eaa782 501#else /* not DOS_NT */
d5db4077 502 fd_error = creat (SDATA (error_file), 0666);
39eaa782
RS
503#endif /* not DOS_NT */
504 }
505
506 if (fd_error < 0)
507 {
68c45bf0 508 emacs_close (filefd);
6f89d28a 509 if (fd[0] != filefd)
68c45bf0 510 emacs_close (fd[0]);
39eaa782 511 if (fd1 >= 0)
68c45bf0 512 emacs_close (fd1);
6f89d28a
MB
513#ifdef MSDOS
514 unlink (tempfile);
515#endif
34b87689
KH
516 if (NILP (error_file))
517 error_file = build_string (NULL_DEVICE);
518 else if (STRINGP (error_file))
519 error_file = DECODE_FILE (error_file);
520 report_file_error ("Cannot redirect stderr", Fcons (error_file, Qnil));
39eaa782 521 }
89e1ec1d 522
2610078a 523#ifdef MSDOS /* MW, July 1993 */
c17c4250 524 /* Note that on MSDOS `child_setup' actually returns the child process
2610078a
KH
525 exit status, not its PID, so we assign it to `synch_process_retcode'
526 below. */
c17c4250
EZ
527 pid = child_setup (filefd, outfilefd, fd_error, (char **) new_argv,
528 0, current_dir);
39eaa782 529
2610078a
KH
530 /* Record that the synchronous process exited and note its
531 termination status. */
532 synch_process_alive = 0;
533 synch_process_retcode = pid;
534 if (synch_process_retcode < 0) /* means it couldn't be exec'ed */
68c45bf0 535 {
ca9c0567 536 synchronize_system_messages_locale ();
68c45bf0
PE
537 synch_process_death = strerror (errno);
538 }
2610078a 539
68c45bf0 540 emacs_close (outfilefd);
2610078a 541 if (fd_error != outfilefd)
68c45bf0 542 emacs_close (fd_error);
2610078a 543 fd1 = -1; /* No harm in closing that one! */
32d08644
KH
544 /* Since CRLF is converted to LF within `decode_coding', we can
545 always open a file with binary mode. */
68c45bf0 546 fd[0] = emacs_open (tempfile, O_RDONLY | O_BINARY, 0);
2610078a
KH
547 if (fd[0] < 0)
548 {
549 unlink (tempfile);
68c45bf0 550 emacs_close (filefd);
2610078a
KH
551 report_file_error ("Cannot re-open temporary file", Qnil);
552 }
553#else /* not MSDOS */
bad95d8f 554#ifdef WINDOWSNT
2d607244
RS
555 pid = child_setup (filefd, fd1, fd_error, (char **) new_argv,
556 0, current_dir);
bad95d8f 557#else /* not WINDOWSNT */
aba637ec
KS
558 BLOCK_INPUT;
559
80856e74
JB
560 pid = vfork ();
561
562 if (pid == 0)
563 {
564 if (fd[0] >= 0)
68c45bf0 565 emacs_close (fd[0]);
1e7963c7
RS
566#ifdef HAVE_SETSID
567 setsid ();
568#endif
58eb6cf0 569#if defined (USG)
80856e74
JB
570 setpgrp ();
571#else
572 setpgrp (pid, pid);
573#endif /* USG */
2d607244
RS
574 child_setup (filefd, fd1, fd_error, (char **) new_argv,
575 0, current_dir);
80856e74 576 }
aba637ec
KS
577
578 UNBLOCK_INPUT;
bad95d8f 579#endif /* not WINDOWSNT */
cd5f8f60
RS
580
581 /* The MSDOS case did this already. */
582 if (fd_error >= 0)
68c45bf0 583 emacs_close (fd_error);
2610078a 584#endif /* not MSDOS */
80856e74 585
80856e74
JB
586 environ = save_environ;
587
6b6e798b
RS
588 /* Close most of our fd's, but not fd[0]
589 since we will use that to read input from. */
68c45bf0 590 emacs_close (filefd);
799abb26 591 if (fd1 >= 0 && fd1 != fd_error)
68c45bf0 592 emacs_close (fd1);
80856e74
JB
593 }
594
595 if (pid < 0)
596 {
6b6e798b 597 if (fd[0] >= 0)
68c45bf0 598 emacs_close (fd[0]);
80856e74
JB
599 report_file_error ("Doing vfork", Qnil);
600 }
601
d50d3dc8 602 if (INTEGERP (buffer))
80856e74 603 {
6b6e798b 604 if (fd[0] >= 0)
68c45bf0 605 emacs_close (fd[0]);
80856e74
JB
606 return Qnil;
607 }
608
6b6e798b 609 /* Enable sending signal if user quits below. */
37d54121
RS
610 call_process_exited = 0;
611
e39a993c 612#if defined(MSDOS)
7e6c2178
RS
613 /* MSDOS needs different cleanup information. */
614 record_unwind_protect (call_process_cleanup,
ad3aaf33
AS
615 Fcons (Fcurrent_buffer (),
616 Fcons (make_number (fd[0]),
617 build_string (tempfile))));
7e6c2178 618#else
80856e74 619 record_unwind_protect (call_process_cleanup,
ad3aaf33
AS
620 Fcons (Fcurrent_buffer (),
621 Fcons (make_number (fd[0]), make_number (pid))));
e39a993c 622#endif /* not MSDOS */
80856e74
JB
623
624
d50d3dc8 625 if (BUFFERP (buffer))
80856e74
JB
626 Fset_buffer (buffer);
627
09494912
RS
628 if (NILP (buffer))
629 {
630 /* If BUFFER is nil, we must read process output once and then
631 discard it, so setup coding system but with nil. */
632 setup_coding_system (Qnil, &process_coding);
633 }
634 else
635 {
636 Lisp_Object val, *args2;
637
638 val = Qnil;
639 if (!NILP (Vcoding_system_for_read))
640 val = Vcoding_system_for_read;
641 else
642 {
643 if (EQ (coding_systems, Qt))
644 {
645 int i;
646
647 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
648 args2[0] = Qcall_process;
649 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
650 coding_systems
651 = Ffind_operation_coding_system (nargs + 1, args2);
652 }
653 if (CONSP (coding_systems))
70949dac 654 val = XCAR (coding_systems);
09494912 655 else if (CONSP (Vdefault_process_coding_system))
70949dac 656 val = XCAR (Vdefault_process_coding_system);
09494912
RS
657 else
658 val = Qnil;
659 }
91183bfd 660 Fcheck_coding_system (val);
09494912
RS
661 /* In unibyte mode, character code conversion should not take
662 place but EOL conversion should. So, setup raw-text or one
663 of the subsidiary according to the information just setup. */
664 if (NILP (current_buffer->enable_multibyte_characters)
665 && !NILP (val))
91183bfd
KH
666 val = raw_text_coding_system (val);
667 setup_coding_system (val, &process_coding);
09494912
RS
668 }
669
80856e74
JB
670 immediate_quit = 1;
671 QUIT;
672
673 {
69481da7 674 register EMACS_INT nread;
0ad477db 675 int first = 1;
69481da7 676 EMACS_INT total_read = 0;
321fecde 677 int carryover = 0;
0aa2630f 678 int display_on_the_fly = display_p;
05b44e90
KH
679 struct coding_system saved_coding;
680
681 saved_coding = process_coding;
60558b19 682 while (1)
80856e74 683 {
60558b19
RS
684 /* Repeatedly read until we've filled as much as possible
685 of the buffer size we have. But don't read
8e6208c5 686 less than 1024--save that for the next bufferful. */
321fecde 687 nread = carryover;
60558b19 688 while (nread < bufsize - 1024)
00fb3e95 689 {
4da256b1 690 int this_read = emacs_read (fd[0], buf + nread,
68c45bf0 691 bufsize - nread);
60558b19
RS
692
693 if (this_read < 0)
694 goto give_up;
695
696 if (this_read == 0)
7a7ab107
KH
697 {
698 process_coding.mode |= CODING_MODE_LAST_BLOCK;
699 break;
700 }
60558b19
RS
701
702 nread += this_read;
7a7ab107 703 total_read += this_read;
60558b19 704
7a7ab107
KH
705 if (display_on_the_fly)
706 break;
707 }
60558b19
RS
708
709 /* Now NREAD is the total amount of data in the buffer. */
80856e74 710 immediate_quit = 0;
177c0ea7 711
012c6fcb 712 if (!NILP (buffer))
32d08644 713 {
bb4a3884
KH
714 if (NILP (current_buffer->enable_multibyte_characters)
715 && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
4da256b1 716 insert_1_both (buf, nread, nread, 0, 1, 0);
32d08644
KH
717 else
718 { /* We have to decode the input. */
45d60801 719 Lisp_Object curbuf;
71a0c011 720 int count1 = SPECPDL_INDEX ();
177c0ea7 721
45d60801 722 XSETBUFFER (curbuf, current_buffer);
71a0c011
EZ
723 /* We cannot allow after-change-functions be run
724 during decoding, because that might modify the
725 buffer, while we rely on process_coding.produced to
726 faithfully reflect inserted text until we
727 TEMP_SET_PT_BOTH below. */
728 specbind (Qinhibit_modification_hooks, Qt);
45d60801
KH
729 decode_coding_c_string (&process_coding, buf, nread,
730 curbuf);
71a0c011 731 unbind_to (count1, Qnil);
7a7ab107 732 if (display_on_the_fly
91183bfd
KH
733 && CODING_REQUIRE_DETECTION (&saved_coding)
734 && ! CODING_REQUIRE_DETECTION (&process_coding))
7a7ab107
KH
735 {
736 /* We have detected some coding system. But,
737 there's a possibility that the detection was
738 done by insufficient data. So, we give up
739 displaying on the fly. */
91183bfd
KH
740 if (process_coding.produced > 0)
741 del_range_2 (process_coding.dst_pos,
742 process_coding.dst_pos_byte,
743 process_coding.dst_pos
744 + process_coding.produced_char,
745 process_coding.dst_pos_byte
746 + process_coding.produced, 0);
7a7ab107
KH
747 display_on_the_fly = 0;
748 process_coding = saved_coding;
749 carryover = nread;
0aa2630f
KS
750 /* This is to make the above condition always
751 fails in the future. */
21d0467f
KH
752 saved_coding.common_flags
753 &= ~CODING_REQUIRE_DETECTION_MASK;
7a7ab107
KH
754 continue;
755 }
177c0ea7 756
ea99bcc1
KH
757 TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
758 PT_BYTE + process_coding.produced);
54ab3d3b 759 carryover = process_coding.carryover_bytes;
321fecde 760 if (carryover > 0)
72af86bd
AS
761 memcpy (buf, process_coding.carryover,
762 process_coding.carryover_bytes);
32d08644
KH
763 }
764 }
c5bfa12b 765
321fecde 766 if (process_coding.mode & CODING_MODE_LAST_BLOCK)
c5bfa12b 767 break;
6e3bfbb2
RS
768
769 /* Make the buffer bigger as we continue to read more data,
4da256b1
KS
770 but not past CALLPROC_BUFFER_SIZE_MAX. */
771 if (bufsize < CALLPROC_BUFFER_SIZE_MAX && total_read > 32 * bufsize)
772 if ((bufsize *= 2) > CALLPROC_BUFFER_SIZE_MAX)
773 bufsize = CALLPROC_BUFFER_SIZE_MAX;
6e3bfbb2 774
0aa2630f 775 if (display_p)
0ad477db
RS
776 {
777 if (first)
778 prepare_menu_bars ();
779 first = 0;
3007ebfb 780 redisplay_preserve_echo_area (1);
0aa2630f
KS
781 /* This variable might have been set to 0 for code
782 detection. In that case, we set it back to 1 because
783 we should have already detected a coding system. */
784 display_on_the_fly = 1;
0ad477db 785 }
80856e74
JB
786 immediate_quit = 1;
787 QUIT;
788 }
60558b19 789 give_up: ;
80856e74 790
91183bfd
KH
791 Vlast_coding_system_used = CODING_ID_NAME (process_coding.id);
792 /* If the caller required, let the buffer inherit the
793 coding-system used to decode the process output. */
794 if (inherit_process_coding_system)
795 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
ad3aaf33 796 make_number (total_read));
3b440bb5
EZ
797 }
798
77defa9a 799#ifndef MSDOS
80856e74
JB
800 /* Wait for it to terminate, unless it already has. */
801 wait_for_termination (pid);
77defa9a 802#endif
80856e74
JB
803
804 immediate_quit = 0;
805
37d54121
RS
806 /* Don't kill any children that the subprocess may have left behind
807 when exiting. */
808 call_process_exited = 1;
809
80856e74
JB
810 unbind_to (count, Qnil);
811
6b61353c
KH
812 if (synch_process_termsig)
813 {
42ca4633 814 const char *signame;
6b61353c
KH
815
816 synchronize_system_messages_locale ();
817 signame = strsignal (synch_process_termsig);
818
819 if (signame == 0)
820 signame = "unknown";
821
822 synch_process_death = signame;
823 }
824
80856e74 825 if (synch_process_death)
68c45bf0
PE
826 return code_convert_string_norecord (build_string (synch_process_death),
827 Vlocale_coding_system, 0);
80856e74
JB
828 return make_number (synch_process_retcode);
829}
80856e74 830\f
9fefd2ba 831static Lisp_Object
971de7fb 832delete_temp_file (Lisp_Object name)
80856e74 833{
1a271e14
KR
834 /* Suppress jka-compr handling, etc. */
835 int count = SPECPDL_INDEX ();
836 specbind (intern ("file-name-handler-alist"), Qnil);
f1a5d776 837 internal_delete_file (name);
1a271e14 838 unbind_to (count, Qnil);
320695d8 839 return Qnil;
80856e74
JB
840}
841
842DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
fdb82f93
PJ
843 3, MANY, 0,
844 doc: /* Send text from START to END to a synchronous process running PROGRAM.
845The remaining arguments are optional.
846Delete the text if fourth arg DELETE is non-nil.
847
848Insert output in BUFFER before point; t means current buffer;
849 nil for BUFFER means discard it; 0 means discard and don't wait.
850BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
851REAL-BUFFER says what to do with standard output, as above,
852while STDERR-FILE says what to do with standard error in the child.
853STDERR-FILE may be nil (discard standard error output),
854t (mix it with ordinary output), or a file name string.
855
856Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
857Remaining args are passed to PROGRAM at startup as command args.
858
ba9a5174 859If BUFFER is 0, `call-process-region' returns immediately with value nil.
fdb82f93
PJ
860Otherwise it waits for PROGRAM to terminate
861and returns a numeric exit status or a signal description string.
d98b59b5
MB
862If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
863
864usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
5842a27b 865 (int nargs, register Lisp_Object *args)
80856e74 866{
39323a7e
KH
867 struct gcpro gcpro1;
868 Lisp_Object filename_string;
869 register Lisp_Object start, end;
aed13378 870 int count = SPECPDL_INDEX ();
08ee4e87 871 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
09494912 872 Lisp_Object coding_systems;
32d08644
KH
873 Lisp_Object val, *args2;
874 int i;
7e6c2178 875 char *tempfile;
f92d51d8 876 Lisp_Object tmpdir, pattern;
7e6c2178 877
f92d51d8
CY
878 if (STRINGP (Vtemporary_file_directory))
879 tmpdir = Vtemporary_file_directory;
7e6c2178
RS
880 else
881 {
f92d51d8
CY
882#ifndef DOS_NT
883 if (getenv ("TMPDIR"))
884 tmpdir = build_string (getenv ("TMPDIR"));
885 else
886 tmpdir = build_string ("/tmp/");
887#else /* DOS_NT */
888 char *outf;
889 if ((outf = egetenv ("TMPDIR"))
890 || (outf = egetenv ("TMP"))
891 || (outf = egetenv ("TEMP")))
892 tmpdir = build_string (outf);
893 else
894 tmpdir = Ffile_name_as_directory (build_string ("c:/temp"));
0774fcf8 895#endif
f92d51d8 896 }
7e6c2178 897
f92d51d8
CY
898 pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
899 tempfile = (char *) alloca (SBYTES (pattern) + 1);
72af86bd 900 memcpy (tempfile, SDATA (pattern), SBYTES (pattern) + 1);
09494912
RS
901 coding_systems = Qt;
902
1ddc85a4
DL
903#ifdef HAVE_MKSTEMP
904 {
d277f1f7
YM
905 int fd;
906
907 BLOCK_INPUT;
908 fd = mkstemp (tempfile);
909 UNBLOCK_INPUT;
1ddc85a4
DL
910 if (fd == -1)
911 report_file_error ("Failed to open temporary file",
912 Fcons (Vtemp_file_name_pattern, Qnil));
913 else
914 close (fd);
915 }
916#else
80856e74 917 mktemp (tempfile);
1ddc85a4 918#endif
80856e74
JB
919
920 filename_string = build_string (tempfile);
39323a7e 921 GCPRO1 (filename_string);
80856e74
JB
922 start = args[0];
923 end = args[1];
32d08644 924 /* Decide coding-system of the contents of the temporary file. */
91489411
RS
925 if (!NILP (Vcoding_system_for_write))
926 val = Vcoding_system_for_write;
927 else if (NILP (current_buffer->enable_multibyte_characters))
32d08644
KH
928 val = Qnil;
929 else
beacaab3 930 {
91489411
RS
931 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
932 args2[0] = Qcall_process_region;
933 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
934 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
935 if (CONSP (coding_systems))
70949dac 936 val = XCDR (coding_systems);
91489411 937 else if (CONSP (Vdefault_process_coding_system))
70949dac 938 val = XCDR (Vdefault_process_coding_system);
beacaab3 939 else
91489411 940 val = Qnil;
beacaab3 941 }
32d08644 942
168afdaa 943 {
aed13378 944 int count1 = SPECPDL_INDEX ();
168afdaa
RS
945
946 specbind (intern ("coding-system-for-write"), val);
bb951f0e
KR
947 /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
948 happen to get a ".Z" suffix. */
949 specbind (intern ("file-name-handler-alist"), Qnil);
168afdaa
RS
950 Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil);
951
952 unbind_to (count1, Qnil);
953 }
91489411 954
177c0ea7 955 /* Note that Fcall_process takes care of binding
91489411 956 coding-system-for-read. */
093650fe 957
80856e74
JB
958 record_unwind_protect (delete_temp_file, filename_string);
959
edf496dd 960 if (nargs > 3 && !NILP (args[3]))
80856e74
JB
961 Fdelete_region (start, end);
962
edf496dd
KH
963 if (nargs > 3)
964 {
965 args += 2;
966 nargs -= 2;
967 }
968 else
969 {
970 args[0] = args[2];
971 nargs = 2;
972 }
973 args[1] = filename_string;
80856e74 974
edf496dd 975 RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args)));
80856e74
JB
976}
977\f
361358ea 978#ifndef WINDOWSNT
971de7fb 979static int relocate_fd (int fd, int minfd);
361358ea 980#endif
dfcf069d 981
5990851d
KL
982static char **
983add_env (char **env, char **new_env, char *string)
984{
985 char **ep;
986 int ok = 1;
987 if (string == NULL)
988 return new_env;
989
990 /* See if this string duplicates any string already in the env.
991 If so, don't put it in.
992 When an env var has multiple definitions,
993 we keep the definition that comes first in process-environment. */
994 for (ep = env; ok && ep != new_env; ep++)
995 {
996 char *p = *ep, *q = string;
997 while (ok)
998 {
999 if (*q != *p)
1000 break;
1001 if (*q == 0)
1002 /* The string is a lone variable name; keep it for now, we
1003 will remove it later. It is a placeholder for a
1004 variable that is not to be included in the environment. */
1005 break;
1006 if (*q == '=')
1007 ok = 0;
1008 p++, q++;
1009 }
1010 }
1011 if (ok)
1012 *new_env++ = string;
1013 return new_env;
1014}
1015
80856e74
JB
1016/* This is the last thing run in a newly forked inferior
1017 either synchronous or asynchronous.
1018 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
1019 Initialize inferior's priority, pgrp, connected dir and environment.
1020 then exec another program based on new_argv.
1021
1022 This function may change environ for the superior process.
1023 Therefore, the superior process must save and restore the value
1024 of environ around the vfork and the call to this function.
1025
80856e74 1026 SET_PGRP is nonzero if we should put the subprocess into a separate
177c0ea7 1027 process group.
e576cab4
JB
1028
1029 CURRENT_DIR is an elisp string giving the path of the current
1030 directory the subprocess should have. Since we can't really signal
1031 a decent error from within the child, this should be verified as an
1032 executable directory by the parent. */
80856e74 1033
dfcf069d 1034int
971de7fb 1035child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, Lisp_Object current_dir)
80856e74 1036{
e576cab4 1037 char **env;
7fcf7f05 1038 char *pwd_var;
bad95d8f
RS
1039#ifdef WINDOWSNT
1040 int cpid;
4252a4bd 1041 HANDLE handles[3];
bad95d8f 1042#endif /* WINDOWSNT */
e576cab4 1043
33abe2d9 1044 int pid = getpid ();
80856e74 1045
80856e74
JB
1046 /* Close Emacs's descriptors that this process should not have. */
1047 close_process_descs ();
ded80a25 1048
c17c4250
EZ
1049 /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
1050 we will lose if we call close_load_descs here. */
1051#ifndef DOS_NT
4458cebe 1052 close_load_descs ();
c17c4250 1053#endif
80856e74
JB
1054
1055 /* Note that use of alloca is always safe here. It's obvious for systems
1056 that do not have true vfork or that have true (stack) alloca.
caa01fe0
GM
1057 If using vfork and C_ALLOCA (when Emacs used to include
1058 src/alloca.c) it is safe because that changes the superior's
1059 static variables as if the superior had done alloca and will be
1060 cleaned up in the usual way. */
e576cab4 1061 {
7fcf7f05 1062 register char *temp;
e576cab4 1063 register int i;
77d78be1 1064
d5db4077 1065 i = SBYTES (current_dir);
16425c4a
EZ
1066#ifdef MSDOS
1067 /* MSDOS must have all environment variables malloc'ed, because
1068 low-level libc functions that launch subsidiary processes rely
1069 on that. */
1070 pwd_var = (char *) xmalloc (i + 6);
1071#else
7fcf7f05 1072 pwd_var = (char *) alloca (i + 6);
16425c4a 1073#endif
7fcf7f05 1074 temp = pwd_var + 4;
72af86bd
AS
1075 memcpy (pwd_var, "PWD=", 4);
1076 memcpy (temp, SDATA (current_dir), i);
bad95d8f 1077 if (!IS_DIRECTORY_SEP (temp[i - 1])) temp[i++] = DIRECTORY_SEP;
e576cab4
JB
1078 temp[i] = 0;
1079
c17c4250 1080#ifndef DOS_NT
e576cab4
JB
1081 /* We can't signal an Elisp error here; we're in a vfork. Since
1082 the callers check the current directory before forking, this
1083 should only return an error if the directory's permissions
1084 are changed between the check and this chdir, but we should
1085 at least check. */
1086 if (chdir (temp) < 0)
20b25e46 1087 _exit (errno);
f8d23104 1088#else /* DOS_NT */
c17c4250
EZ
1089 /* Get past the drive letter, so that d:/ is left alone. */
1090 if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
1091 {
1092 temp += 2;
1093 i -= 2;
1094 }
f8d23104 1095#endif /* DOS_NT */
c17c4250 1096
7fcf7f05 1097 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
bad95d8f 1098 while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
7fcf7f05 1099 temp[--i] = 0;
e576cab4 1100 }
80856e74 1101
5990851d 1102 /* Set `env' to a vector of the strings in the environment. */
80856e74
JB
1103 {
1104 register Lisp_Object tem;
1105 register char **new_env;
5990851d 1106 char **p, **q;
80856e74 1107 register int new_length;
d2bb6598 1108 Lisp_Object display = Qnil;
361358ea 1109
80856e74 1110 new_length = 0;
f105f403 1111
80856e74 1112 for (tem = Vprocess_environment;
5990851d
KL
1113 CONSP (tem) && STRINGP (XCAR (tem));
1114 tem = XCDR (tem))
d2bb6598
SM
1115 {
1116 if (strncmp (SDATA (XCAR (tem)), "DISPLAY", 7) == 0
1117 && (SDATA (XCAR (tem)) [7] == '\0'
1118 || SDATA (XCAR (tem)) [7] == '='))
1119 /* DISPLAY is specified in process-environment. */
1120 display = Qt;
1121 new_length++;
1122 }
de87fb59 1123
d2bb6598
SM
1124 /* If not provided yet, use the frame's DISPLAY. */
1125 if (NILP (display))
1126 {
1127 Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
1128 if (!STRINGP (tmp) && CONSP (Vinitial_environment))
1129 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1130 tmp = Fgetenv_internal (build_string ("DISPLAY"),
1131 Vinitial_environment);
1132 if (STRINGP (tmp))
1133 {
1134 display = tmp;
1135 new_length++;
1136 }
1137 }
80856e74 1138
7fcf7f05
RS
1139 /* new_length + 2 to include PWD and terminating 0. */
1140 env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *));
7fcf7f05
RS
1141 /* If we have a PWD envvar, pass one down,
1142 but with corrected value. */
a13f8f50 1143 if (egetenv ("PWD"))
7fcf7f05 1144 *new_env++ = pwd_var;
361358ea 1145
6b8e474c 1146 if (STRINGP (display))
de87fb59
DN
1147 {
1148 int vlen = strlen ("DISPLAY=") + strlen (SDATA (display)) + 1;
1149 char *vdata = (char *) alloca (vlen);
1150 strcpy (vdata, "DISPLAY=");
1151 strcat (vdata, SDATA (display));
1152 new_env = add_env (env, new_env, vdata);
1153 }
80856e74 1154
5990851d 1155 /* Overrides. */
80856e74 1156 for (tem = Vprocess_environment;
70949dac
KR
1157 CONSP (tem) && STRINGP (XCAR (tem));
1158 tem = XCDR (tem))
5990851d 1159 new_env = add_env (env, new_env, SDATA (XCAR (tem)));
d2bb6598 1160
5990851d
KL
1161 *new_env = 0;
1162
1163 /* Remove variable names without values. */
1164 p = q = env;
1165 while (*p != 0)
cd9565ba 1166 {
5990851d 1167 while (*q != 0 && strchr (*q, '=') == NULL)
1baf6db9 1168 q++;
5990851d
KL
1169 *p = *q++;
1170 if (*p != 0)
1171 p++;
cd9565ba 1172 }
80856e74 1173 }
de87fb59 1174
361358ea 1175
bad95d8f
RS
1176#ifdef WINDOWSNT
1177 prepare_standard_handles (in, out, err, handles);
d5db4077 1178 set_process_dir (SDATA (current_dir));
bad95d8f 1179#else /* not WINDOWSNT */
426b37ae
JB
1180 /* Make sure that in, out, and err are not actually already in
1181 descriptors zero, one, or two; this could happen if Emacs is
7e6c2178 1182 started with its standard in, out, or error closed, as might
426b37ae 1183 happen under X. */
f29f9e4a
RS
1184 {
1185 int oin = in, oout = out;
1186
1187 /* We have to avoid relocating the same descriptor twice! */
1188
1189 in = relocate_fd (in, 3);
1190
1191 if (out == oin)
1192 out = in;
1193 else
3e9367e7 1194 out = relocate_fd (out, 3);
f29f9e4a
RS
1195
1196 if (err == oin)
1197 err = in;
1198 else if (err == oout)
1199 err = out;
1200 else
3e9367e7 1201 err = relocate_fd (err, 3);
f29f9e4a 1202 }
426b37ae 1203
c17c4250 1204#ifndef MSDOS
68c45bf0
PE
1205 emacs_close (0);
1206 emacs_close (1);
1207 emacs_close (2);
80856e74
JB
1208
1209 dup2 (in, 0);
1210 dup2 (out, 1);
1211 dup2 (err, 2);
68c45bf0 1212 emacs_close (in);
ce8f5a9a
AS
1213 if (out != in)
1214 emacs_close (out);
1215 if (err != in && err != out)
1216 emacs_close (err);
c17c4250 1217#endif /* not MSDOS */
bad95d8f 1218#endif /* not WINDOWSNT */
80856e74 1219
58eb6cf0 1220#if defined(USG)
fdba8590 1221#ifndef SETPGRP_RELEASES_CTTY
e576cab4 1222 setpgrp (); /* No arguments but equivalent in this case */
fdba8590 1223#endif
e576cab4
JB
1224#else
1225 setpgrp (pid, pid);
1226#endif /* USG */
80856e74 1227
c17c4250
EZ
1228#ifdef MSDOS
1229 pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
a3f0666f 1230 xfree (pwd_var);
c17c4250
EZ
1231 if (pid == -1)
1232 /* An error occurred while trying to run the subprocess. */
1233 report_file_error ("Spawning child process", Qnil);
1234 return pid;
1235#else /* not MSDOS */
bad95d8f
RS
1236#ifdef WINDOWSNT
1237 /* Spawn the child. (See ntproc.c:Spawnve). */
1238 cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
db77d785 1239 reset_standard_handles (in, out, err, handles);
ff27bfbe
KH
1240 if (cpid == -1)
1241 /* An error occurred while trying to spawn the process. */
1242 report_file_error ("Spawning child process", Qnil);
bad95d8f
RS
1243 return cpid;
1244#else /* not WINDOWSNT */
a7ebc409
DN
1245 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1246 EMACS_SET_TTY_PGRP (0, &pid);
1247
80856e74
JB
1248 /* execvp does not accept an environment arg so the only way
1249 to pass this environment is to set environ. Our caller
1250 is responsible for restoring the ambient value of environ. */
1251 environ = env;
1252 execvp (new_argv[0], new_argv);
1253
68c45bf0
PE
1254 emacs_write (1, "Can't exec program: ", 20);
1255 emacs_write (1, new_argv[0], strlen (new_argv[0]));
1256 emacs_write (1, "\n", 1);
80856e74 1257 _exit (1);
bad95d8f 1258#endif /* not WINDOWSNT */
7e6c2178 1259#endif /* not MSDOS */
80856e74
JB
1260}
1261
361358ea 1262#ifndef WINDOWSNT
a3833dfe 1263/* Move the file descriptor FD so that its number is not less than MINFD.
426b37ae 1264 If the file descriptor is moved at all, the original is freed. */
dfcf069d 1265static int
971de7fb 1266relocate_fd (int fd, int minfd)
426b37ae 1267{
a3833dfe 1268 if (fd >= minfd)
426b37ae
JB
1269 return fd;
1270 else
1271 {
cf237e27
AS
1272 int new;
1273#ifdef F_DUPFD
1274 new = fcntl (fd, F_DUPFD, minfd);
1275#else
1276 new = dup (fd);
1277 if (new != -1)
1278 /* Note that we hold the original FD open while we recurse,
1279 to guarantee we'll get a new FD if we need it. */
1280 new = relocate_fd (new, minfd);
1281#endif
426b37ae
JB
1282 if (new == -1)
1283 {
a8fe7202
AS
1284 const char *message1 = "Error while setting up child: ";
1285 const char *errmessage = strerror (errno);
1286 const char *message2 = "\n";
68c45bf0
PE
1287 emacs_write (2, message1, strlen (message1));
1288 emacs_write (2, errmessage, strlen (errmessage));
1289 emacs_write (2, message2, strlen (message2));
426b37ae
JB
1290 _exit (1);
1291 }
68c45bf0 1292 emacs_close (fd);
426b37ae
JB
1293 return new;
1294 }
1295}
361358ea 1296#endif /* not WINDOWSNT */
426b37ae 1297
012c6fcb 1298static int
a8fe7202
AS
1299getenv_internal_1 (const char *var, int varlen, char **value, int *valuelen,
1300 Lisp_Object env)
012c6fcb 1301{
db699fc6 1302 for (; CONSP (env); env = XCDR (env))
012c6fcb 1303 {
db699fc6 1304 Lisp_Object entry = XCAR (env);
d50d3dc8 1305 if (STRINGP (entry)
db699fc6 1306 && SBYTES (entry) >= varlen
bad95d8f
RS
1307#ifdef WINDOWSNT
1308 /* NT environment variables are case insensitive. */
d5db4077 1309 && ! strnicmp (SDATA (entry), var, varlen)
bad95d8f 1310#else /* not WINDOWSNT */
72af86bd 1311 && ! memcmp (SDATA (entry), var, varlen)
bad95d8f 1312#endif /* not WINDOWSNT */
a9971c6d 1313 )
012c6fcb 1314 {
db699fc6
SM
1315 if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
1316 {
1317 *value = (char *) SDATA (entry) + (varlen + 1);
1318 *valuelen = SBYTES (entry) - (varlen + 1);
1319 return 1;
1320 }
1321 else if (SBYTES (entry) == varlen)
1322 {
1323 /* Lone variable names in Vprocess_environment mean that
1324 variable should be removed from the environment. */
1325 *value = NULL;
1326 return 1;
1327 }
1328 }
1329 }
1330 return 0;
1331}
1332
012c6fcb 1333static int
a8fe7202
AS
1334getenv_internal (const char *var, int varlen, char **value, int *valuelen,
1335 Lisp_Object frame)
012c6fcb 1336{
d2bb6598
SM
1337 /* Try to find VAR in Vprocess_environment first. */
1338 if (getenv_internal_1 (var, varlen, value, valuelen,
1339 Vprocess_environment))
1340 return *value ? 1 : 0;
f105f403 1341
d2bb6598 1342 /* For DISPLAY try to get the values from the frame or the initial env. */
de87fb59 1343 if (strcmp (var, "DISPLAY") == 0)
d2bb6598
SM
1344 {
1345 Lisp_Object display
1346 = Fframe_parameter (NILP (frame) ? selected_frame : frame, Qdisplay);
1347 if (STRINGP (display))
1348 {
de87fb59
DN
1349 *value = (char *) SDATA (display);
1350 *valuelen = SBYTES (display);
012c6fcb
JA
1351 return 1;
1352 }
d2bb6598
SM
1353 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1354 if (getenv_internal_1 (var, varlen, value, valuelen,
1355 Vinitial_environment))
1356 return *value ? 1 : 0;
012c6fcb
JA
1357 }
1358
1359 return 0;
1360}
1361
f105f403 1362DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
5990851d
KL
1363 doc: /* Get the value of environment variable VARIABLE.
1364VARIABLE should be a string. Value is nil if VARIABLE is undefined in
1365the environment. Otherwise, value is a string.
f105f403 1366
acf20901 1367This function searches `process-environment' for VARIABLE.
5990851d 1368
db699fc6 1369If optional parameter ENV is a list, then search this list instead of
acf20901
JB
1370`process-environment', and return t when encountering a negative entry
1371\(an entry for a variable with no value). */)
5842a27b 1372 (Lisp_Object variable, Lisp_Object env)
012c6fcb
JA
1373{
1374 char *value;
1375 int valuelen;
1376
5990851d 1377 CHECK_STRING (variable);
db699fc6
SM
1378 if (CONSP (env))
1379 {
1380 if (getenv_internal_1 (SDATA (variable), SBYTES (variable),
1381 &value, &valuelen, env))
1382 return value ? make_string (value, valuelen) : Qt;
1383 else
1384 return Qnil;
1385 }
1386 else if (getenv_internal (SDATA (variable), SBYTES (variable),
d2bb6598 1387 &value, &valuelen, env))
012c6fcb
JA
1388 return make_string (value, valuelen);
1389 else
1390 return Qnil;
1391}
1392
5990851d
KL
1393/* A version of getenv that consults the Lisp environment lists,
1394 easily callable from C. */
012c6fcb 1395char *
a8fe7202 1396egetenv (const char *var)
012c6fcb
JA
1397{
1398 char *value;
1399 int valuelen;
1400
f105f403 1401 if (getenv_internal (var, strlen (var), &value, &valuelen, Qnil))
012c6fcb
JA
1402 return value;
1403 else
1404 return 0;
1405}
1406
80856e74 1407\f
8de15d69 1408/* This is run before init_cmdargs. */
177c0ea7 1409
dfcf069d 1410void
971de7fb 1411init_callproc_1 (void)
8de15d69
RS
1412{
1413 char *data_dir = egetenv ("EMACSDATA");
35a2f4b8
KH
1414 char *doc_dir = egetenv ("EMACSDOC");
1415
8de15d69 1416 Vdata_directory
177c0ea7 1417 = Ffile_name_as_directory (build_string (data_dir ? data_dir
8de15d69 1418 : PATH_DATA));
35a2f4b8
KH
1419 Vdoc_directory
1420 = Ffile_name_as_directory (build_string (doc_dir ? doc_dir
1421 : PATH_DOC));
9453ea7b 1422
e576cab4 1423 /* Check the EMACSPATH environment variable, defaulting to the
57bda87a 1424 PATH_EXEC path from epaths.h. */
e576cab4 1425 Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
80856e74
JB
1426 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
1427 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
8de15d69
RS
1428}
1429
e17f7533 1430/* This is run after init_cmdargs, when Vinstallation_directory is valid. */
8de15d69 1431
dfcf069d 1432void
971de7fb 1433init_callproc (void)
8de15d69
RS
1434{
1435 char *data_dir = egetenv ("EMACSDATA");
177c0ea7 1436
8de15d69
RS
1437 register char * sh;
1438 Lisp_Object tempdir;
1439
9cc4fad5 1440 if (!NILP (Vinstallation_directory))
8de15d69 1441 {
05630743
RS
1442 /* Add to the path the lib-src subdir of the installation dir. */
1443 Lisp_Object tem;
1444 tem = Fexpand_file_name (build_string ("lib-src"),
1445 Vinstallation_directory);
bad95d8f 1446#ifndef DOS_NT
1a6640ec 1447 /* MSDOS uses wrapped binaries, so don't do this. */
0fa248bc 1448 if (NILP (Fmember (tem, Vexec_path)))
70ec1377
RS
1449 {
1450 Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
1451 Vexec_path = Fcons (tem, Vexec_path);
1452 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
1453 }
177c0ea7 1454
0fa248bc 1455 Vexec_directory = Ffile_name_as_directory (tem);
bad95d8f 1456#endif /* not DOS_NT */
8de15d69 1457
e17f7533
RS
1458 /* Maybe use ../etc as well as ../lib-src. */
1459 if (data_dir == 0)
1460 {
1461 tem = Fexpand_file_name (build_string ("etc"),
1462 Vinstallation_directory);
1463 Vdoc_directory = Ffile_name_as_directory (tem);
8de15d69
RS
1464 }
1465 }
7e933683
RS
1466
1467 /* Look for the files that should be in etc. We don't use
1468 Vinstallation_directory, because these files are never installed
e17f7533 1469 near the executable, and they are never in the build
7e933683
RS
1470 directory when that's different from the source directory.
1471
1472 Instead, if these files are not in the nominal place, we try the
1473 source directory. */
1474 if (data_dir == 0)
1475 {
70ec1377 1476 Lisp_Object tem, tem1, srcdir;
7e933683 1477
70ec1377
RS
1478 srcdir = Fexpand_file_name (build_string ("../src/"),
1479 build_string (PATH_DUMPLOADSEARCH));
7e933683
RS
1480 tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory);
1481 tem1 = Ffile_exists_p (tem);
70ec1377 1482 if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1))
7e933683 1483 {
70ec1377 1484 Lisp_Object newdir;
7e933683
RS
1485 newdir = Fexpand_file_name (build_string ("../etc/"),
1486 build_string (PATH_DUMPLOADSEARCH));
1487 tem = Fexpand_file_name (build_string ("GNU"), newdir);
1488 tem1 = Ffile_exists_p (tem);
1489 if (!NILP (tem1))
1490 Vdata_directory = newdir;
1491 }
1492 }
80856e74 1493
d883eb62
RS
1494#ifndef CANNOT_DUMP
1495 if (initialized)
1496#endif
1497 {
1498 tempdir = Fdirectory_file_name (Vexec_directory);
d5db4077 1499 if (access (SDATA (tempdir), 0) < 0)
d883eb62
RS
1500 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1501 Vexec_directory);
1502 }
80856e74 1503
e576cab4 1504 tempdir = Fdirectory_file_name (Vdata_directory);
d5db4077 1505 if (access (SDATA (tempdir), 0) < 0)
76d5c6cf
RS
1506 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1507 Vdata_directory);
e576cab4 1508
e576cab4 1509 sh = (char *) getenv ("SHELL");
80856e74 1510 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
8abd035b 1511
40b49d4b
JB
1512#ifdef DOS_NT
1513 Vshared_game_score_directory = Qnil;
1514#else
63789758
RS
1515 Vshared_game_score_directory = build_string (PATH_GAME);
1516 if (NILP (Ffile_directory_p (Vshared_game_score_directory)))
1517 Vshared_game_score_directory = Qnil;
40b49d4b 1518#endif
9fefd2ba
JB
1519}
1520
dfcf069d 1521void
971de7fb 1522set_initial_environment (void)
9fefd2ba
JB
1523{
1524 register char **envp;
7bfa6d77
AS
1525#ifdef CANNOT_DUMP
1526 Vprocess_environment = Qnil;
edfda783 1527#else
7bfa6d77 1528 if (initialized)
edfda783 1529#endif
7bfa6d77 1530 {
a13f8f50 1531 for (envp = environ; *envp; envp++)
de87fb59
DN
1532 Vprocess_environment = Fcons (build_string (*envp),
1533 Vprocess_environment);
3c33c79a
SM
1534 /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
1535 to use `delete' and friends on process-environment. */
1536 Vinitial_environment = Fcopy_sequence (Vprocess_environment);
a13f8f50 1537 }
80856e74
JB
1538}
1539
dfcf069d 1540void
971de7fb 1541syms_of_callproc (void)
80856e74 1542{
bad95d8f 1543#ifdef DOS_NT
093650fe
RS
1544 Qbuffer_file_type = intern ("buffer-file-type");
1545 staticpro (&Qbuffer_file_type);
bad95d8f 1546#endif /* DOS_NT */
7e6c2178 1547
f92d51d8
CY
1548#ifndef DOS_NT
1549 Vtemp_file_name_pattern = build_string ("emacsXXXXXX");
1550#elif defined (WINDOWSNT)
1551 Vtemp_file_name_pattern = build_string ("emXXXXXX");
1552#else
1553 Vtemp_file_name_pattern = build_string ("detmp.XXX");
1554#endif
1555 staticpro (&Vtemp_file_name_pattern);
1556
80856e74 1557 DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
fdb82f93 1558 doc: /* *File name to load inferior shells from.
b20b29be
EZ
1559Initialized from the SHELL environment variable, or to a system-dependent
1560default if SHELL is not set. */);
80856e74
JB
1561
1562 DEFVAR_LISP ("exec-path", &Vexec_path,
fdb82f93
PJ
1563 doc: /* *List of directories to search programs to run in subprocesses.
1564Each element is a string (directory name) or nil (try default directory). */);
80856e74 1565
b81a1b72 1566 DEFVAR_LISP ("exec-suffixes", &Vexec_suffixes,
fdb82f93
PJ
1567 doc: /* *List of suffixes to try to find executable file names.
1568Each element is a string. */);
33d5af99 1569 Vexec_suffixes = Qnil;
b81a1b72 1570
80856e74 1571 DEFVAR_LISP ("exec-directory", &Vexec_directory,
fdb82f93
PJ
1572 doc: /* Directory for executables for Emacs to invoke.
1573More generally, this includes any architecture-dependent files
1574that are built and installed from the Emacs distribution. */);
e576cab4
JB
1575
1576 DEFVAR_LISP ("data-directory", &Vdata_directory,
fdb82f93
PJ
1577 doc: /* Directory of machine-independent files that come with GNU Emacs.
1578These are files intended for Emacs to use while it runs. */);
80856e74 1579
35a2f4b8 1580 DEFVAR_LISP ("doc-directory", &Vdoc_directory,
fdb82f93 1581 doc: /* Directory containing the DOC file that comes with GNU Emacs.
ebf24b59 1582This is usually the same as `data-directory'. */);
35a2f4b8 1583
ed61592a 1584 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory,
fdb82f93
PJ
1585 doc: /* For internal use by the build procedure only.
1586This is the name of the directory in which the build procedure installed
ebf24b59 1587Emacs's info files; the default value for `Info-default-directory-list'
fdb82f93 1588includes this. */);
ed61592a
JB
1589 Vconfigure_info_directory = build_string (PATH_INFO);
1590
1e7ce61b 1591 DEFVAR_LISP ("shared-game-score-directory", &Vshared_game_score_directory,
b065672a
CW
1592 doc: /* Directory of score files for games which come with GNU Emacs.
1593If this variable is nil, then Emacs is unable to use a shared directory. */);
40b49d4b
JB
1594#ifdef DOS_NT
1595 Vshared_game_score_directory = Qnil;
1596#else
63789758 1597 Vshared_game_score_directory = build_string (PATH_GAME);
40b49d4b 1598#endif
b065672a 1599
6b8e474c
SM
1600 DEFVAR_LISP ("initial-environment", &Vinitial_environment,
1601 doc: /* List of environment variables inherited from the parent process.
1602Each element should be a string of the form ENVVARNAME=VALUE.
1603The elements must normally be decoded (using `locale-coding-system') for use. */);
1604 Vinitial_environment = Qnil;
1605
80856e74 1606 DEFVAR_LISP ("process-environment", &Vprocess_environment,
5990851d 1607 doc: /* List of overridden environment variables for subprocesses to inherit.
fdb82f93 1608Each element should be a string of the form ENVVARNAME=VALUE.
5990851d 1609
a13f8f50
KL
1610Entries in this list take precedence to those in the frame-local
1611environments. Therefore, let-binding `process-environment' is an easy
1612way to temporarily change the value of an environment variable,
1613irrespective of where it comes from. To use `process-environment' to
1614remove an environment variable, include only its name in the list,
1615without "=VALUE".
5990851d
KL
1616
1617This variable is set to nil when Emacs starts.
1618
fdb82f93
PJ
1619If multiple entries define the same variable, the first one always
1620takes precedence.
5990851d 1621
776a24a1 1622Non-ASCII characters are encoded according to the initial value of
5990851d
KL
1623`locale-coding-system', i.e. the elements must normally be decoded for
1624use.
1625
776a24a1 1626See `setenv' and `getenv'. */);
86f5ca04 1627 Vprocess_environment = Qnil;
80856e74 1628
80856e74 1629 defsubr (&Scall_process);
83fa009c 1630 defsubr (&Sgetenv_internal);
e576cab4 1631 defsubr (&Scall_process_region);
80856e74 1632}
6b61353c
KH
1633
1634/* arch-tag: 769b8045-1df7-4d2b-8968-e3fb49017f95
1635 (do not change this comment) */