(w32_draw_fringe_bitmap): Copy unadapted code from
[bpt/emacs.git] / src / callproc.c
CommitLineData
80856e74 1/* Synchronous subprocess invocation for GNU Emacs.
7bdba03c
GM
2 Copyright (C) 1985,86,87,88,93,94,95,99, 2000, 2001
3 Free Software Foundation, Inc.
80856e74
JB
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
826c56ac 9the Free Software Foundation; either version 2, or (at your option)
80856e74
JB
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN
19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
80856e74
JB
21
22
68c45bf0 23#include <config.h>
80856e74 24#include <signal.h>
e576cab4 25#include <errno.h>
565620a5 26#include <stdio.h>
80856e74 27
03695ace 28#ifndef USE_CRT_DLL
426b37ae 29extern int errno;
03695ace 30#endif
426b37ae 31
80856e74
JB
32/* Define SIGCHLD as an alias for SIGCLD. */
33
34#if !defined (SIGCHLD) && defined (SIGCLD)
35#define SIGCHLD SIGCLD
36#endif /* SIGCLD */
37
38#include <sys/types.h>
88a64fef 39
3cbd6585
GM
40#ifdef HAVE_UNISTD_H
41#include <unistd.h>
42#endif
43
80856e74 44#include <sys/file.h>
776a24a1 45#ifdef HAVE_FCNTL_H
472e83fe 46#define INCLUDED_FCNTL
80856e74
JB
47#include <fcntl.h>
48#endif
49
bad95d8f
RS
50#ifdef WINDOWSNT
51#define NOMINMAX
52#include <windows.h>
53#include <stdlib.h> /* for proper declaration of environ */
54#include <fcntl.h>
489f9371 55#include "w32.h"
bad95d8f
RS
56#define _P_NOWAIT 1 /* from process.h */
57#endif
58
7e6c2178 59#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
472e83fe 60#define INCLUDED_FCNTL
7e6c2178
RS
61#include <fcntl.h>
62#include <sys/stat.h>
63#include <sys/param.h>
64#include <errno.h>
65#endif /* MSDOS */
66
80856e74
JB
67#ifndef O_RDONLY
68#define O_RDONLY 0
69#endif
70
71#ifndef O_WRONLY
72#define O_WRONLY 1
73#endif
74
75#include "lisp.h"
76#include "commands.h"
77#include "buffer.h"
32d08644 78#include "charset.h"
edf496dd 79#include "ccl.h"
32d08644 80#include "coding.h"
f0b950cf 81#include "composite.h"
57bda87a 82#include <epaths.h>
80856e74 83#include "process.h"
d177f194 84#include "syssignal.h"
a129418f 85#include "systty.h"
80856e74 86
5f027cea
EZ
87#ifdef MSDOS
88#include "msdos.h"
89#endif
90
80856e74
JB
91#ifdef VMS
92extern noshare char **environ;
93#else
03695ace 94#ifndef USE_CRT_DLL
80856e74
JB
95extern char **environ;
96#endif
03695ace 97#endif
80856e74 98
f95c3f91 99#ifdef HAVE_SETPGID
2b7e8799 100#if !defined (USG) || defined (BSD_PGRPS)
320695d8 101#undef setpgrp
f95c3f91
GM
102#define setpgrp setpgid
103#endif
2b7e8799 104#endif
f95c3f91 105
b81a1b72
SM
106Lisp_Object Vexec_path, Vexec_directory, Vexec_suffixes;
107Lisp_Object Vdata_directory, Vdoc_directory;
1e7ce61b 108Lisp_Object Vconfigure_info_directory, Vshared_game_score_directory;
8abd035b 109Lisp_Object Vtemp_file_name_pattern;
80856e74
JB
110
111Lisp_Object Vshell_file_name;
112
80856e74 113Lisp_Object Vprocess_environment;
80856e74 114
bad95d8f 115#ifdef DOS_NT
093650fe 116Lisp_Object Qbuffer_file_type;
bad95d8f 117#endif /* DOS_NT */
093650fe 118
80856e74
JB
119/* True iff we are about to fork off a synchronous process or if we
120 are waiting for it. */
121int synch_process_alive;
122
123/* Nonzero => this is a string explaining death of synchronous subprocess. */
124char *synch_process_death;
125
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;
6e3bfbb2
RS
223 char buf[16384];
224 char *bufptr = buf;
225 int bufsize = 16384;
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)
810 coding_allocate_composition_data (&process_coding, PT);
811 }
2d892150
KH
812 if (process_coding.cmp_data)
813 process_coding.cmp_data->char_offset = PT;
177c0ea7 814
321fecde
KH
815 decode_coding (&process_coding, bufptr, decoding_buf,
816 nread, size);
177c0ea7 817
7a7ab107
KH
818 if (display_on_the_fly
819 && saved_coding.type == coding_type_undecided
820 && process_coding.type != coding_type_undecided)
821 {
822 /* We have detected some coding system. But,
823 there's a possibility that the detection was
824 done by insufficient data. So, we give up
825 displaying on the fly. */
a871dd58 826 xfree (decoding_buf);
7a7ab107
KH
827 display_on_the_fly = 0;
828 process_coding = saved_coding;
829 carryover = nread;
830 continue;
831 }
177c0ea7 832
321fecde 833 if (process_coding.produced > 0)
2d892150
KH
834 insert_1_both (decoding_buf, process_coding.produced_char,
835 process_coding.produced, 0, 1, 0);
a871dd58 836 xfree (decoding_buf);
7bdba03c
GM
837
838 if (process_coding.result == CODING_FINISH_INCONSISTENT_EOL)
839 {
840 Lisp_Object eol_type, coding;
841
842 if (process_coding.eol_type == CODING_EOL_CR)
843 {
844 /* CRs have been replaced with LFs. Undo
845 that in the text inserted above. */
846 unsigned char *p;
177c0ea7 847
7bdba03c 848 move_gap_both (PT, PT_BYTE);
177c0ea7 849
7bdba03c
GM
850 p = BYTE_POS_ADDR (pt_byte_orig);
851 for (; p < GPT_ADDR; ++p)
852 if (*p == '\n')
853 *p = '\r';
854 }
855 else if (process_coding.eol_type == CODING_EOL_CRLF)
856 {
857 /* CR LFs have been replaced with LFs. Undo
858 that by inserting CRs in front of LFs in
859 the text inserted above. */
860 EMACS_INT bytepos, old_pt, old_pt_byte, nCR;
861
862 old_pt = PT;
863 old_pt_byte = PT_BYTE;
864 nCR = 0;
177c0ea7 865
7bdba03c
GM
866 for (bytepos = PT_BYTE - 1;
867 bytepos >= pt_byte_orig;
868 --bytepos)
869 if (FETCH_BYTE (bytepos) == '\n')
870 {
871 EMACS_INT charpos = BYTE_TO_CHAR (bytepos);
872 TEMP_SET_PT_BOTH (charpos, bytepos);
873 insert_1_both ("\r", 1, 1, 0, 1, 0);
874 ++nCR;
875 }
876
877 TEMP_SET_PT_BOTH (old_pt + nCR, old_pt_byte + nCR);
878 }
879
880 /* Set the coding system symbol to that for
881 Unix-like EOL. */
882 eol_type = Fget (saved_coding.symbol, Qeol_type);
883 if (VECTORP (eol_type)
884 && ASIZE (eol_type) == 3
885 && SYMBOLP (AREF (eol_type, CODING_EOL_LF)))
886 coding = AREF (eol_type, CODING_EOL_LF);
887 else
888 coding = saved_coding.symbol;
177c0ea7 889
7bdba03c
GM
890 process_coding.symbol = coding;
891 process_coding.eol_type = CODING_EOL_LF;
892 process_coding.mode
893 &= ~CODING_MODE_INHIBIT_INCONSISTENT_EOL;
894 }
177c0ea7 895
f0b950cf
KH
896 nread -= process_coding.consumed;
897 carryover = nread;
321fecde 898 if (carryover > 0)
c5bfa12b
KH
899 /* As CARRYOVER should not be that large, we had
900 better avoid overhead of bcopy. */
901 BCOPY_SHORT (bufptr + process_coding.consumed, bufptr,
902 carryover);
f0b950cf
KH
903 if (process_coding.result == CODING_FINISH_INSUFFICIENT_CMP)
904 {
905 /* The decoding ended because of insufficient data
906 area to record information about composition.
907 We must try decoding with additional data area
2d892150 908 before reading more output for the process. */
f0b950cf
KH
909 coding_allocate_composition_data (&process_coding, PT);
910 goto repeat_decoding;
911 }
32d08644
KH
912 }
913 }
c5bfa12b 914
321fecde 915 if (process_coding.mode & CODING_MODE_LAST_BLOCK)
c5bfa12b 916 break;
6e3bfbb2
RS
917
918 /* Make the buffer bigger as we continue to read more data,
919 but not past 64k. */
920 if (bufsize < 64 * 1024 && total_read > 32 * bufsize)
921 {
7ec8aa3f 922 char *tempptr;
6e3bfbb2 923 bufsize *= 2;
7ec8aa3f
RS
924
925 tempptr = (char *) alloca (bufsize);
926 bcopy (bufptr, tempptr, bufsize / 2);
927 bufptr = tempptr;
6e3bfbb2
RS
928 }
929
012c6fcb 930 if (!NILP (display) && INTERACTIVE)
0ad477db
RS
931 {
932 if (first)
933 prepare_menu_bars ();
934 first = 0;
3007ebfb 935 redisplay_preserve_echo_area (1);
0ad477db 936 }
80856e74
JB
937 immediate_quit = 1;
938 QUIT;
939 }
60558b19 940 give_up: ;
80856e74 941
2d892150
KH
942 if (!NILP (buffer)
943 && process_coding.cmp_data)
944 {
945 coding_restore_composition (&process_coding, Fcurrent_buffer ());
946 coding_free_composition_data (&process_coding);
947 }
f0b950cf 948
838c9726 949 {
aed13378 950 int post_read_count = SPECPDL_INDEX ();
838c9726
KH
951
952 record_unwind_protect (save_excursion_restore, save_excursion_save ());
953 inserted = PT - pt_orig;
954 TEMP_SET_PT_BOTH (pt_orig, pt_byte_orig);
955 if (SYMBOLP (process_coding.post_read_conversion)
956 && !NILP (Ffboundp (process_coding.post_read_conversion)))
957 call1 (process_coding.post_read_conversion, make_number (inserted));
f778b157 958
838c9726 959 Vlast_coding_system_used = process_coding.symbol;
bbd29cfe 960
838c9726
KH
961 /* If the caller required, let the buffer inherit the
962 coding-system used to decode the process output. */
963 if (inherit_process_coding_system)
964 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
965 make_number (total_read));
966
967 unbind_to (post_read_count, Qnil);
968 }
3b440bb5
EZ
969 }
970
80856e74
JB
971 /* Wait for it to terminate, unless it already has. */
972 wait_for_termination (pid);
973
974 immediate_quit = 0;
975
976 set_buffer_internal (old);
977
37d54121
RS
978 /* Don't kill any children that the subprocess may have left behind
979 when exiting. */
980 call_process_exited = 1;
981
80856e74
JB
982 unbind_to (count, Qnil);
983
ca498128
JD
984 if (synch_process_termsig)
985 {
986 char *signame;
987
988 synchronize_system_messages_locale ();
989 signame = strsignal (synch_process_termsig);
990
991 if (signame == 0)
992 signame = "unknown";
993
994 synch_process_death = signame;
995 }
996
80856e74 997 if (synch_process_death)
68c45bf0
PE
998 return code_convert_string_norecord (build_string (synch_process_death),
999 Vlocale_coding_system, 0);
80856e74
JB
1000 return make_number (synch_process_retcode);
1001}
1002#endif
1003\f
9fefd2ba 1004static Lisp_Object
80856e74
JB
1005delete_temp_file (name)
1006 Lisp_Object name;
1007{
2e3dc201 1008 /* Use Fdelete_file (indirectly) because that runs a file name handler.
59750d69 1009 We did that when writing the file, so we should do so when deleting. */
2e3dc201 1010 internal_delete_file (name);
320695d8 1011 return Qnil;
80856e74
JB
1012}
1013
1014DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
fdb82f93
PJ
1015 3, MANY, 0,
1016 doc: /* Send text from START to END to a synchronous process running PROGRAM.
1017The remaining arguments are optional.
1018Delete the text if fourth arg DELETE is non-nil.
1019
1020Insert output in BUFFER before point; t means current buffer;
1021 nil for BUFFER means discard it; 0 means discard and don't wait.
1022BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
1023REAL-BUFFER says what to do with standard output, as above,
1024while STDERR-FILE says what to do with standard error in the child.
1025STDERR-FILE may be nil (discard standard error output),
1026t (mix it with ordinary output), or a file name string.
1027
1028Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
1029Remaining args are passed to PROGRAM at startup as command args.
1030
ba9a5174 1031If BUFFER is 0, `call-process-region' returns immediately with value nil.
fdb82f93
PJ
1032Otherwise it waits for PROGRAM to terminate
1033and returns a numeric exit status or a signal description string.
d98b59b5
MB
1034If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
1035
1036usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
fdb82f93 1037 (nargs, args)
80856e74
JB
1038 int nargs;
1039 register Lisp_Object *args;
1040{
39323a7e
KH
1041 struct gcpro gcpro1;
1042 Lisp_Object filename_string;
1043 register Lisp_Object start, end;
aed13378 1044 int count = SPECPDL_INDEX ();
08ee4e87 1045 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
09494912 1046 Lisp_Object coding_systems;
32d08644
KH
1047 Lisp_Object val, *args2;
1048 int i;
bad95d8f 1049#ifdef DOS_NT
7e6c2178 1050 char *tempfile;
7e6c2178
RS
1051 char *outf = '\0';
1052
8a52365c
EZ
1053 if ((outf = egetenv ("TMPDIR"))
1054 || (outf = egetenv ("TMP"))
1055 || (outf = egetenv ("TEMP")))
7e6c2178
RS
1056 strcpy (tempfile = alloca (strlen (outf) + 20), outf);
1057 else
1058 {
1059 tempfile = alloca (20);
1060 *tempfile = '\0';
1061 }
0774fcf8 1062 if (!IS_DIRECTORY_SEP (tempfile[strlen (tempfile) - 1]))
7e6c2178 1063 strcat (tempfile, "/");
5711b547
RS
1064 if ('/' == DIRECTORY_SEP)
1065 dostounix_filename (tempfile);
1066 else
1067 unixtodos_filename (tempfile);
0774fcf8
RS
1068#ifdef WINDOWSNT
1069 strcat (tempfile, "emXXXXXX");
1070#else
7e6c2178 1071 strcat (tempfile, "detmp.XXX");
0774fcf8 1072#endif
bad95d8f 1073#else /* not DOS_NT */
d5db4077
KR
1074 char *tempfile = (char *) alloca (SBYTES (Vtemp_file_name_pattern) + 1);
1075 bcopy (SDATA (Vtemp_file_name_pattern), tempfile,
1076 SBYTES (Vtemp_file_name_pattern) + 1);
bad95d8f 1077#endif /* not DOS_NT */
7e6c2178 1078
09494912
RS
1079 coding_systems = Qt;
1080
1ddc85a4
DL
1081#ifdef HAVE_MKSTEMP
1082 {
1083 int fd = mkstemp (tempfile);
1084 if (fd == -1)
1085 report_file_error ("Failed to open temporary file",
1086 Fcons (Vtemp_file_name_pattern, Qnil));
1087 else
1088 close (fd);
1089 }
1090#else
80856e74 1091 mktemp (tempfile);
1ddc85a4 1092#endif
80856e74
JB
1093
1094 filename_string = build_string (tempfile);
39323a7e 1095 GCPRO1 (filename_string);
80856e74
JB
1096 start = args[0];
1097 end = args[1];
32d08644 1098 /* Decide coding-system of the contents of the temporary file. */
91489411
RS
1099 if (!NILP (Vcoding_system_for_write))
1100 val = Vcoding_system_for_write;
1101 else if (NILP (current_buffer->enable_multibyte_characters))
32d08644
KH
1102 val = Qnil;
1103 else
beacaab3 1104 {
91489411
RS
1105 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
1106 args2[0] = Qcall_process_region;
1107 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
1108 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1109 if (CONSP (coding_systems))
70949dac 1110 val = XCDR (coding_systems);
91489411 1111 else if (CONSP (Vdefault_process_coding_system))
70949dac 1112 val = XCDR (Vdefault_process_coding_system);
beacaab3 1113 else
91489411 1114 val = Qnil;
beacaab3 1115 }
32d08644 1116
168afdaa 1117 {
aed13378 1118 int count1 = SPECPDL_INDEX ();
168afdaa
RS
1119
1120 specbind (intern ("coding-system-for-write"), val);
1121 Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil);
1122
1123 unbind_to (count1, Qnil);
1124 }
91489411 1125
177c0ea7 1126 /* Note that Fcall_process takes care of binding
91489411 1127 coding-system-for-read. */
093650fe 1128
80856e74
JB
1129 record_unwind_protect (delete_temp_file, filename_string);
1130
edf496dd 1131 if (nargs > 3 && !NILP (args[3]))
80856e74
JB
1132 Fdelete_region (start, end);
1133
edf496dd
KH
1134 if (nargs > 3)
1135 {
1136 args += 2;
1137 nargs -= 2;
1138 }
1139 else
1140 {
1141 args[0] = args[2];
1142 nargs = 2;
1143 }
1144 args[1] = filename_string;
80856e74 1145
edf496dd 1146 RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args)));
80856e74
JB
1147}
1148\f
1149#ifndef VMS /* VMS version is in vmsproc.c. */
1150
dfcf069d
AS
1151static int relocate_fd ();
1152
80856e74
JB
1153/* This is the last thing run in a newly forked inferior
1154 either synchronous or asynchronous.
1155 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
1156 Initialize inferior's priority, pgrp, connected dir and environment.
1157 then exec another program based on new_argv.
1158
1159 This function may change environ for the superior process.
1160 Therefore, the superior process must save and restore the value
1161 of environ around the vfork and the call to this function.
1162
80856e74 1163 SET_PGRP is nonzero if we should put the subprocess into a separate
177c0ea7 1164 process group.
e576cab4
JB
1165
1166 CURRENT_DIR is an elisp string giving the path of the current
1167 directory the subprocess should have. Since we can't really signal
1168 a decent error from within the child, this should be verified as an
1169 executable directory by the parent. */
80856e74 1170
dfcf069d 1171int
e576cab4 1172child_setup (in, out, err, new_argv, set_pgrp, current_dir)
80856e74
JB
1173 int in, out, err;
1174 register char **new_argv;
80856e74 1175 int set_pgrp;
e576cab4 1176 Lisp_Object current_dir;
80856e74 1177{
e576cab4 1178 char **env;
7fcf7f05 1179 char *pwd_var;
bad95d8f
RS
1180#ifdef WINDOWSNT
1181 int cpid;
4252a4bd 1182 HANDLE handles[3];
bad95d8f 1183#endif /* WINDOWSNT */
e576cab4 1184
33abe2d9 1185 int pid = getpid ();
80856e74 1186
68d10241 1187#ifdef SET_EMACS_PRIORITY
4f0b9d49 1188 {
31ade731 1189 extern EMACS_INT emacs_priority;
4f0b9d49 1190
68d10241
RS
1191 if (emacs_priority < 0)
1192 nice (- emacs_priority);
4f0b9d49 1193 }
5b633aeb 1194#endif
80856e74
JB
1195
1196#ifdef subprocesses
1197 /* Close Emacs's descriptors that this process should not have. */
1198 close_process_descs ();
1199#endif
c17c4250
EZ
1200 /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
1201 we will lose if we call close_load_descs here. */
1202#ifndef DOS_NT
4458cebe 1203 close_load_descs ();
c17c4250 1204#endif
80856e74
JB
1205
1206 /* Note that use of alloca is always safe here. It's obvious for systems
1207 that do not have true vfork or that have true (stack) alloca.
1208 If using vfork and C_ALLOCA it is safe because that changes
1209 the superior's static variables as if the superior had done alloca
1210 and will be cleaned up in the usual way. */
e576cab4 1211 {
7fcf7f05 1212 register char *temp;
e576cab4 1213 register int i;
77d78be1 1214
d5db4077 1215 i = SBYTES (current_dir);
16425c4a
EZ
1216#ifdef MSDOS
1217 /* MSDOS must have all environment variables malloc'ed, because
1218 low-level libc functions that launch subsidiary processes rely
1219 on that. */
1220 pwd_var = (char *) xmalloc (i + 6);
1221#else
7fcf7f05 1222 pwd_var = (char *) alloca (i + 6);
16425c4a 1223#endif
7fcf7f05
RS
1224 temp = pwd_var + 4;
1225 bcopy ("PWD=", pwd_var, 4);
d5db4077 1226 bcopy (SDATA (current_dir), temp, i);
bad95d8f 1227 if (!IS_DIRECTORY_SEP (temp[i - 1])) temp[i++] = DIRECTORY_SEP;
e576cab4
JB
1228 temp[i] = 0;
1229
c17c4250 1230#ifndef DOS_NT
e576cab4
JB
1231 /* We can't signal an Elisp error here; we're in a vfork. Since
1232 the callers check the current directory before forking, this
1233 should only return an error if the directory's permissions
1234 are changed between the check and this chdir, but we should
1235 at least check. */
1236 if (chdir (temp) < 0)
20b25e46 1237 _exit (errno);
b4c7684c 1238#endif
7fcf7f05 1239
c17c4250
EZ
1240#ifdef DOS_NT
1241 /* Get past the drive letter, so that d:/ is left alone. */
1242 if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
1243 {
1244 temp += 2;
1245 i -= 2;
1246 }
1247#endif
1248
7fcf7f05 1249 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
bad95d8f 1250 while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
7fcf7f05 1251 temp[--i] = 0;
e576cab4 1252 }
80856e74 1253
80856e74
JB
1254 /* Set `env' to a vector of the strings in Vprocess_environment. */
1255 {
1256 register Lisp_Object tem;
1257 register char **new_env;
1258 register int new_length;
1259
1260 new_length = 0;
1261 for (tem = Vprocess_environment;
70949dac
KR
1262 CONSP (tem) && STRINGP (XCAR (tem));
1263 tem = XCDR (tem))
80856e74
JB
1264 new_length++;
1265
7fcf7f05
RS
1266 /* new_length + 2 to include PWD and terminating 0. */
1267 env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *));
1268
1269 /* If we have a PWD envvar, pass one down,
1270 but with corrected value. */
1271 if (getenv ("PWD"))
1272 *new_env++ = pwd_var;
80856e74 1273
cd9565ba 1274 /* Copy the Vprocess_environment strings into new_env. */
80856e74 1275 for (tem = Vprocess_environment;
70949dac
KR
1276 CONSP (tem) && STRINGP (XCAR (tem));
1277 tem = XCDR (tem))
cd9565ba
RS
1278 {
1279 char **ep = env;
d5db4077 1280 char *string = (char *) SDATA (XCAR (tem));
cd9565ba
RS
1281 /* See if this string duplicates any string already in the env.
1282 If so, don't put it in.
1283 When an env var has multiple definitions,
1284 we keep the definition that comes first in process-environment. */
1285 for (; ep != new_env; ep++)
1286 {
1287 char *p = *ep, *q = string;
1288 while (1)
1289 {
1290 if (*q == 0)
1291 /* The string is malformed; might as well drop it. */
1292 goto duplicate;
1293 if (*q != *p)
1294 break;
1295 if (*q == '=')
1296 goto duplicate;
1297 p++, q++;
1298 }
1299 }
1300 *new_env++ = string;
1301 duplicate: ;
1302 }
80856e74
JB
1303 *new_env = 0;
1304 }
bad95d8f
RS
1305#ifdef WINDOWSNT
1306 prepare_standard_handles (in, out, err, handles);
d5db4077 1307 set_process_dir (SDATA (current_dir));
bad95d8f 1308#else /* not WINDOWSNT */
426b37ae
JB
1309 /* Make sure that in, out, and err are not actually already in
1310 descriptors zero, one, or two; this could happen if Emacs is
7e6c2178 1311 started with its standard in, out, or error closed, as might
426b37ae 1312 happen under X. */
f29f9e4a
RS
1313 {
1314 int oin = in, oout = out;
1315
1316 /* We have to avoid relocating the same descriptor twice! */
1317
1318 in = relocate_fd (in, 3);
1319
1320 if (out == oin)
1321 out = in;
1322 else
3e9367e7 1323 out = relocate_fd (out, 3);
f29f9e4a
RS
1324
1325 if (err == oin)
1326 err = in;
1327 else if (err == oout)
1328 err = out;
1329 else
3e9367e7 1330 err = relocate_fd (err, 3);
f29f9e4a 1331 }
426b37ae 1332
c17c4250 1333#ifndef MSDOS
68c45bf0
PE
1334 emacs_close (0);
1335 emacs_close (1);
1336 emacs_close (2);
80856e74
JB
1337
1338 dup2 (in, 0);
1339 dup2 (out, 1);
1340 dup2 (err, 2);
68c45bf0
PE
1341 emacs_close (in);
1342 emacs_close (out);
1343 emacs_close (err);
c17c4250 1344#endif /* not MSDOS */
bad95d8f 1345#endif /* not WINDOWSNT */
80856e74 1346
6b2cd868 1347#if defined(USG) && !defined(BSD_PGRPS)
fdba8590 1348#ifndef SETPGRP_RELEASES_CTTY
e576cab4 1349 setpgrp (); /* No arguments but equivalent in this case */
fdba8590 1350#endif
e576cab4
JB
1351#else
1352 setpgrp (pid, pid);
1353#endif /* USG */
a129418f
RS
1354 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1355 EMACS_SET_TTY_PGRP (0, &pid);
80856e74 1356
c17c4250
EZ
1357#ifdef MSDOS
1358 pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
a3f0666f 1359 xfree (pwd_var);
c17c4250
EZ
1360 if (pid == -1)
1361 /* An error occurred while trying to run the subprocess. */
1362 report_file_error ("Spawning child process", Qnil);
1363 return pid;
1364#else /* not MSDOS */
bad95d8f
RS
1365#ifdef WINDOWSNT
1366 /* Spawn the child. (See ntproc.c:Spawnve). */
1367 cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
db77d785 1368 reset_standard_handles (in, out, err, handles);
ff27bfbe
KH
1369 if (cpid == -1)
1370 /* An error occurred while trying to spawn the process. */
1371 report_file_error ("Spawning child process", Qnil);
bad95d8f
RS
1372 return cpid;
1373#else /* not WINDOWSNT */
80856e74
JB
1374 /* execvp does not accept an environment arg so the only way
1375 to pass this environment is to set environ. Our caller
1376 is responsible for restoring the ambient value of environ. */
1377 environ = env;
1378 execvp (new_argv[0], new_argv);
1379
68c45bf0
PE
1380 emacs_write (1, "Can't exec program: ", 20);
1381 emacs_write (1, new_argv[0], strlen (new_argv[0]));
1382 emacs_write (1, "\n", 1);
80856e74 1383 _exit (1);
bad95d8f 1384#endif /* not WINDOWSNT */
7e6c2178 1385#endif /* not MSDOS */
80856e74
JB
1386}
1387
a3833dfe 1388/* Move the file descriptor FD so that its number is not less than MINFD.
426b37ae 1389 If the file descriptor is moved at all, the original is freed. */
dfcf069d 1390static int
a3833dfe
KH
1391relocate_fd (fd, minfd)
1392 int fd, minfd;
426b37ae 1393{
a3833dfe 1394 if (fd >= minfd)
426b37ae
JB
1395 return fd;
1396 else
1397 {
1398 int new = dup (fd);
1399 if (new == -1)
1400 {
20c018a0 1401 char *message1 = "Error while setting up child: ";
826c56ac 1402 char *errmessage = strerror (errno);
20c018a0 1403 char *message2 = "\n";
68c45bf0
PE
1404 emacs_write (2, message1, strlen (message1));
1405 emacs_write (2, errmessage, strlen (errmessage));
1406 emacs_write (2, message2, strlen (message2));
426b37ae
JB
1407 _exit (1);
1408 }
1409 /* Note that we hold the original FD open while we recurse,
1410 to guarantee we'll get a new FD if we need it. */
a3833dfe 1411 new = relocate_fd (new, minfd);
68c45bf0 1412 emacs_close (fd);
426b37ae
JB
1413 return new;
1414 }
1415}
1416
012c6fcb
JA
1417static int
1418getenv_internal (var, varlen, value, valuelen)
1419 char *var;
1420 int varlen;
1421 char **value;
1422 int *valuelen;
1423{
1424 Lisp_Object scan;
1425
70949dac 1426 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
012c6fcb 1427 {
c1350752
KH
1428 Lisp_Object entry;
1429
70949dac 1430 entry = XCAR (scan);
d50d3dc8 1431 if (STRINGP (entry)
d5db4077
KR
1432 && SBYTES (entry) > varlen
1433 && SREF (entry, varlen) == '='
bad95d8f
RS
1434#ifdef WINDOWSNT
1435 /* NT environment variables are case insensitive. */
d5db4077 1436 && ! strnicmp (SDATA (entry), var, varlen)
bad95d8f 1437#else /* not WINDOWSNT */
d5db4077 1438 && ! bcmp (SDATA (entry), var, varlen)
bad95d8f 1439#endif /* not WINDOWSNT */
a9971c6d 1440 )
012c6fcb 1441 {
d5db4077
KR
1442 *value = (char *) SDATA (entry) + (varlen + 1);
1443 *valuelen = SBYTES (entry) - (varlen + 1);
012c6fcb
JA
1444 return 1;
1445 }
1446 }
1447
1448 return 0;
1449}
1450
83fa009c 1451DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 1, 0,
fdb82f93
PJ
1452 doc: /* Return the value of environment variable VAR, as a string.
1453VAR should be a string. Value is nil if VAR is undefined in the environment.
1454This function consults the variable ``process-environment'' for its value. */)
1455 (var)
012c6fcb
JA
1456 Lisp_Object var;
1457{
1458 char *value;
1459 int valuelen;
1460
b7826503 1461 CHECK_STRING (var);
d5db4077 1462 if (getenv_internal (SDATA (var), SBYTES (var),
012c6fcb
JA
1463 &value, &valuelen))
1464 return make_string (value, valuelen);
1465 else
1466 return Qnil;
1467}
1468
1469/* A version of getenv that consults process_environment, easily
e576cab4 1470 callable from C. */
012c6fcb
JA
1471char *
1472egetenv (var)
e576cab4 1473 char *var;
012c6fcb
JA
1474{
1475 char *value;
1476 int valuelen;
1477
1478 if (getenv_internal (var, strlen (var), &value, &valuelen))
1479 return value;
1480 else
1481 return 0;
1482}
1483
80856e74
JB
1484#endif /* not VMS */
1485\f
8de15d69 1486/* This is run before init_cmdargs. */
177c0ea7 1487
dfcf069d 1488void
8de15d69
RS
1489init_callproc_1 ()
1490{
1491 char *data_dir = egetenv ("EMACSDATA");
35a2f4b8
KH
1492 char *doc_dir = egetenv ("EMACSDOC");
1493
8de15d69 1494 Vdata_directory
177c0ea7 1495 = Ffile_name_as_directory (build_string (data_dir ? data_dir
8de15d69 1496 : PATH_DATA));
35a2f4b8
KH
1497 Vdoc_directory
1498 = Ffile_name_as_directory (build_string (doc_dir ? doc_dir
1499 : PATH_DOC));
9453ea7b 1500
e576cab4 1501 /* Check the EMACSPATH environment variable, defaulting to the
57bda87a 1502 PATH_EXEC path from epaths.h. */
e576cab4 1503 Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
80856e74
JB
1504 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
1505 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
8de15d69
RS
1506}
1507
e17f7533 1508/* This is run after init_cmdargs, when Vinstallation_directory is valid. */
8de15d69 1509
dfcf069d 1510void
8de15d69
RS
1511init_callproc ()
1512{
1513 char *data_dir = egetenv ("EMACSDATA");
177c0ea7 1514
8de15d69
RS
1515 register char * sh;
1516 Lisp_Object tempdir;
1517
9cc4fad5 1518 if (!NILP (Vinstallation_directory))
8de15d69 1519 {
05630743
RS
1520 /* Add to the path the lib-src subdir of the installation dir. */
1521 Lisp_Object tem;
1522 tem = Fexpand_file_name (build_string ("lib-src"),
1523 Vinstallation_directory);
bad95d8f 1524#ifndef DOS_NT
1a6640ec 1525 /* MSDOS uses wrapped binaries, so don't do this. */
0fa248bc 1526 if (NILP (Fmember (tem, Vexec_path)))
70ec1377
RS
1527 {
1528 Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
1529 Vexec_path = Fcons (tem, Vexec_path);
1530 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
1531 }
177c0ea7 1532
0fa248bc 1533 Vexec_directory = Ffile_name_as_directory (tem);
bad95d8f 1534#endif /* not DOS_NT */
8de15d69 1535
e17f7533
RS
1536 /* Maybe use ../etc as well as ../lib-src. */
1537 if (data_dir == 0)
1538 {
1539 tem = Fexpand_file_name (build_string ("etc"),
1540 Vinstallation_directory);
1541 Vdoc_directory = Ffile_name_as_directory (tem);
8de15d69
RS
1542 }
1543 }
7e933683
RS
1544
1545 /* Look for the files that should be in etc. We don't use
1546 Vinstallation_directory, because these files are never installed
e17f7533 1547 near the executable, and they are never in the build
7e933683
RS
1548 directory when that's different from the source directory.
1549
1550 Instead, if these files are not in the nominal place, we try the
1551 source directory. */
1552 if (data_dir == 0)
1553 {
70ec1377 1554 Lisp_Object tem, tem1, srcdir;
7e933683 1555
70ec1377
RS
1556 srcdir = Fexpand_file_name (build_string ("../src/"),
1557 build_string (PATH_DUMPLOADSEARCH));
7e933683
RS
1558 tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory);
1559 tem1 = Ffile_exists_p (tem);
70ec1377 1560 if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1))
7e933683 1561 {
70ec1377 1562 Lisp_Object newdir;
7e933683
RS
1563 newdir = Fexpand_file_name (build_string ("../etc/"),
1564 build_string (PATH_DUMPLOADSEARCH));
1565 tem = Fexpand_file_name (build_string ("GNU"), newdir);
1566 tem1 = Ffile_exists_p (tem);
1567 if (!NILP (tem1))
1568 Vdata_directory = newdir;
1569 }
1570 }
80856e74 1571
d883eb62
RS
1572#ifndef CANNOT_DUMP
1573 if (initialized)
1574#endif
1575 {
1576 tempdir = Fdirectory_file_name (Vexec_directory);
d5db4077 1577 if (access (SDATA (tempdir), 0) < 0)
d883eb62
RS
1578 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1579 Vexec_directory);
1580 }
80856e74 1581
e576cab4 1582 tempdir = Fdirectory_file_name (Vdata_directory);
d5db4077 1583 if (access (SDATA (tempdir), 0) < 0)
76d5c6cf
RS
1584 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1585 Vdata_directory);
e576cab4 1586
80856e74
JB
1587#ifdef VMS
1588 Vshell_file_name = build_string ("*dcl*");
1589#else
e576cab4 1590 sh = (char *) getenv ("SHELL");
80856e74
JB
1591 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
1592#endif
8abd035b
RS
1593
1594#ifdef VMS
1595 Vtemp_file_name_pattern = build_string ("tmp:emacsXXXXXX.");
1596#else
1597 if (getenv ("TMPDIR"))
1598 {
1599 char *dir = getenv ("TMPDIR");
1600 Vtemp_file_name_pattern
1601 = Fexpand_file_name (build_string ("emacsXXXXXX"),
1602 build_string (dir));
1603 }
1604 else
1605 Vtemp_file_name_pattern = build_string ("/tmp/emacsXXXXXX");
1606#endif
63789758 1607
40b49d4b
JB
1608#ifdef DOS_NT
1609 Vshared_game_score_directory = Qnil;
1610#else
63789758
RS
1611 Vshared_game_score_directory = build_string (PATH_GAME);
1612 if (NILP (Ffile_directory_p (Vshared_game_score_directory)))
1613 Vshared_game_score_directory = Qnil;
40b49d4b 1614#endif
9fefd2ba
JB
1615}
1616
dfcf069d 1617void
9fefd2ba
JB
1618set_process_environment ()
1619{
1620 register char **envp;
80856e74 1621
80856e74
JB
1622 Vprocess_environment = Qnil;
1623#ifndef CANNOT_DUMP
1624 if (initialized)
1625#endif
1626 for (envp = environ; *envp; envp++)
1627 Vprocess_environment = Fcons (build_string (*envp),
1628 Vprocess_environment);
80856e74
JB
1629}
1630
dfcf069d 1631void
80856e74
JB
1632syms_of_callproc ()
1633{
bad95d8f 1634#ifdef DOS_NT
093650fe
RS
1635 Qbuffer_file_type = intern ("buffer-file-type");
1636 staticpro (&Qbuffer_file_type);
bad95d8f 1637#endif /* DOS_NT */
7e6c2178 1638
80856e74 1639 DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
fdb82f93
PJ
1640 doc: /* *File name to load inferior shells from.
1641Initialized from the SHELL environment variable. */);
80856e74
JB
1642
1643 DEFVAR_LISP ("exec-path", &Vexec_path,
fdb82f93
PJ
1644 doc: /* *List of directories to search programs to run in subprocesses.
1645Each element is a string (directory name) or nil (try default directory). */);
80856e74 1646
b81a1b72 1647 DEFVAR_LISP ("exec-suffixes", &Vexec_suffixes,
fdb82f93
PJ
1648 doc: /* *List of suffixes to try to find executable file names.
1649Each element is a string. */);
33d5af99 1650 Vexec_suffixes = Qnil;
b81a1b72 1651
80856e74 1652 DEFVAR_LISP ("exec-directory", &Vexec_directory,
fdb82f93
PJ
1653 doc: /* Directory for executables for Emacs to invoke.
1654More generally, this includes any architecture-dependent files
1655that are built and installed from the Emacs distribution. */);
e576cab4
JB
1656
1657 DEFVAR_LISP ("data-directory", &Vdata_directory,
fdb82f93
PJ
1658 doc: /* Directory of machine-independent files that come with GNU Emacs.
1659These are files intended for Emacs to use while it runs. */);
80856e74 1660
35a2f4b8 1661 DEFVAR_LISP ("doc-directory", &Vdoc_directory,
fdb82f93
PJ
1662 doc: /* Directory containing the DOC file that comes with GNU Emacs.
1663This is usually the same as data-directory. */);
35a2f4b8 1664
ed61592a 1665 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory,
fdb82f93
PJ
1666 doc: /* For internal use by the build procedure only.
1667This is the name of the directory in which the build procedure installed
1668Emacs's info files; the default value for Info-default-directory-list
1669includes this. */);
ed61592a
JB
1670 Vconfigure_info_directory = build_string (PATH_INFO);
1671
1e7ce61b 1672 DEFVAR_LISP ("shared-game-score-directory", &Vshared_game_score_directory,
b065672a
CW
1673 doc: /* Directory of score files for games which come with GNU Emacs.
1674If this variable is nil, then Emacs is unable to use a shared directory. */);
40b49d4b
JB
1675#ifdef DOS_NT
1676 Vshared_game_score_directory = Qnil;
1677#else
63789758 1678 Vshared_game_score_directory = build_string (PATH_GAME);
40b49d4b 1679#endif
b065672a 1680
8abd035b 1681 DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern,
fdb82f93
PJ
1682 doc: /* Pattern for making names for temporary files.
1683This is used by `call-process-region'. */);
0537ec48 1684 /* This variable is initialized in init_callproc. */
8abd035b 1685
80856e74 1686 DEFVAR_LISP ("process-environment", &Vprocess_environment,
fdb82f93
PJ
1687 doc: /* List of environment variables for subprocesses to inherit.
1688Each element should be a string of the form ENVVARNAME=VALUE.
1689If multiple entries define the same variable, the first one always
1690takes precedence.
1691The environment which Emacs inherits is placed in this variable
776a24a1
DL
1692when Emacs starts.
1693Non-ASCII characters are encoded according to the initial value of
1694`locale-coding-system', i.e. the elements must normally be decoded for use.
1695See `setenv' and `getenv'. */);
80856e74
JB
1696
1697#ifndef VMS
1698 defsubr (&Scall_process);
83fa009c 1699 defsubr (&Sgetenv_internal);
986ffb24 1700#endif
e576cab4 1701 defsubr (&Scall_process_region);
80856e74 1702}
ab5796a9
MB
1703
1704/* arch-tag: 769b8045-1df7-4d2b-8968-e3fb49017f95
1705 (do not change this comment) */