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