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