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