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