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