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