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