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