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