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