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