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