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