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