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