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