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