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