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