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