Whitespace change.
[bpt/emacs.git] / src / callproc.c
CommitLineData
80856e74 1/* Synchronous subprocess invocation for GNU Emacs.
826c56ac 2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 Free Software Foundation, Inc.
80856e74
JB
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
826c56ac 8the Free Software Foundation; either version 2, or (at your option)
80856e74
JB
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21#include <signal.h>
e576cab4 22#include <errno.h>
0af6a831 23#include <stdio.h>
80856e74 24
18160b98 25#include <config.h>
80856e74 26
426b37ae 27extern int errno;
826c56ac 28extern char *strerror ();
426b37ae 29
80856e74
JB
30/* Define SIGCHLD as an alias for SIGCLD. */
31
32#if !defined (SIGCHLD) && defined (SIGCLD)
33#define SIGCHLD SIGCLD
34#endif /* SIGCLD */
35
36#include <sys/types.h>
88a64fef 37
80856e74
JB
38#include <sys/file.h>
39#ifdef USG5
40#include <fcntl.h>
41#endif
42
7e6c2178
RS
43#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
44#include <fcntl.h>
45#include <sys/stat.h>
46#include <sys/param.h>
47#include <errno.h>
48#endif /* MSDOS */
49
80856e74
JB
50#ifndef O_RDONLY
51#define O_RDONLY 0
52#endif
53
54#ifndef O_WRONLY
55#define O_WRONLY 1
56#endif
57
58#include "lisp.h"
59#include "commands.h"
60#include "buffer.h"
2a6b3537 61#include <paths.h>
80856e74 62#include "process.h"
d177f194 63#include "syssignal.h"
a129418f 64#include "systty.h"
80856e74
JB
65
66#ifdef VMS
67extern noshare char **environ;
68#else
69extern char **environ;
70#endif
71
72#define max(a, b) ((a) > (b) ? (a) : (b))
73
7e6c2178
RS
74#ifdef MSDOS
75Lisp_Object Vbinary_process;
76#endif
77
e576cab4 78Lisp_Object Vexec_path, Vexec_directory, Vdata_directory;
ed61592a 79Lisp_Object Vconfigure_info_directory;
80856e74
JB
80
81Lisp_Object Vshell_file_name;
82
80856e74 83Lisp_Object Vprocess_environment;
80856e74
JB
84
85/* True iff we are about to fork off a synchronous process or if we
86 are waiting for it. */
87int synch_process_alive;
88
89/* Nonzero => this is a string explaining death of synchronous subprocess. */
90char *synch_process_death;
91
92/* If synch_process_death is zero,
93 this is exit code of synchronous subprocess. */
94int synch_process_retcode;
8de15d69
RS
95
96extern Lisp_Object Vdoc_file_name;
80856e74
JB
97\f
98#ifndef VMS /* VMS version is in vmsproc.c. */
99
d177f194
JB
100static Lisp_Object
101call_process_kill (fdpid)
102 Lisp_Object fdpid;
103{
104 close (XFASTINT (Fcar (fdpid)));
105 EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
106 synch_process_alive = 0;
107 return Qnil;
108}
109
80856e74
JB
110Lisp_Object
111call_process_cleanup (fdpid)
112 Lisp_Object fdpid;
113{
7e6c2178
RS
114#ifdef MSDOS
115 /* for MSDOS fdpid is really (fd . tempfile) */
116 register Lisp_Object file = Fcdr (fdpid);
117 close (XFASTINT (Fcar (fdpid)));
118 if (strcmp (XSTRING (file)-> data, NULL_DEVICE) != 0)
119 unlink (XSTRING (file)->data);
120#else /* not MSDOS */
d177f194
JB
121 register int pid = XFASTINT (Fcdr (fdpid));
122
123 if (EMACS_KILLPG (pid, SIGINT) == 0)
124 {
125 int count = specpdl_ptr - specpdl;
126 record_unwind_protect (call_process_kill, fdpid);
127 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
128 immediate_quit = 1;
129 QUIT;
130 wait_for_termination (pid);
131 immediate_quit = 0;
132 specpdl_ptr = specpdl + count; /* Discard the unwind protect. */
133 message1 ("Waiting for process to die...done");
134 }
80856e74 135 synch_process_alive = 0;
d177f194 136 close (XFASTINT (Fcar (fdpid)));
7e6c2178 137#endif /* not MSDOS */
80856e74
JB
138 return Qnil;
139}
140
141DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
142 "Call PROGRAM synchronously in separate process.\n\
143The program's input comes from file INFILE (nil means `/dev/null').\n\
144Insert output in BUFFER before point; t means current buffer;\n\
145 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
146Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
147Remaining arguments are strings passed as command arguments to PROGRAM.\n\
e576cab4 148If BUFFER is 0, returns immediately with value nil.\n\
80856e74 149Otherwise waits for PROGRAM to terminate\n\
e576cab4 150and returns a numeric exit status or a signal description string.\n\
d177f194 151If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
80856e74
JB
152 (nargs, args)
153 int nargs;
154 register Lisp_Object *args;
155{
58616e67 156 Lisp_Object infile, buffer, current_dir, display, path;
80856e74
JB
157 int fd[2];
158 int filefd;
159 register int pid;
160 char buf[1024];
161 int count = specpdl_ptr - specpdl;
162 register unsigned char **new_argv
163 = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
164 struct buffer *old = current_buffer;
7e6c2178
RS
165#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
166 char *outf, *tempfile;
167 int outfilefd;
168#endif
80856e74
JB
169#if 0
170 int mask;
171#endif
80856e74
JB
172 CHECK_STRING (args[0], 0);
173
7e6c2178
RS
174#ifndef subprocesses
175 /* Without asynchronous processes we cannot have BUFFER == 0. */
176 if (nargs >= 3 && XTYPE (args[2]) == Lisp_Int)
177 error ("Operating system cannot handle asynchronous subprocesses");
178#endif /* subprocesses */
179
e576cab4
JB
180 if (nargs >= 2 && ! NILP (args[1]))
181 {
182 infile = Fexpand_file_name (args[1], current_buffer->directory);
183 CHECK_STRING (infile, 1);
184 }
80856e74 185 else
5437e9f9 186 infile = build_string (NULL_DEVICE);
80856e74 187
e576cab4
JB
188 if (nargs >= 3)
189 {
190 register Lisp_Object tem;
044512ed 191
e576cab4
JB
192 buffer = tem = args[2];
193 if (!(EQ (tem, Qnil)
194 || EQ (tem, Qt)
195 || XFASTINT (tem) == 0))
196 {
197 buffer = Fget_buffer (tem);
198 CHECK_BUFFER (buffer, 2);
199 }
200 }
201 else
202 buffer = Qnil;
80856e74 203
58616e67
JB
204 /* Make sure that the child will be able to chdir to the current
205 buffer's current directory, or its unhandled equivalent. We
206 can't just have the child check for an error when it does the
207 chdir, since it's in a vfork.
208
209 We have to GCPRO around this because Fexpand_file_name,
210 Funhandled_file_name_directory, and Ffile_accessible_directory_p
211 might call a file name handling function. The argument list is
212 protected by the caller, so all we really have to worry about is
213 buffer. */
214 {
215 struct gcpro gcpro1, gcpro2, gcpro3;
216
217 current_dir = current_buffer->directory;
218
219 GCPRO3 (infile, buffer, current_dir);
220
221 current_dir =
222 expand_and_dir_to_file
82df4891 223 (Funhandled_file_name_directory (current_dir), Qnil);
58616e67
JB
224 if (NILP (Ffile_accessible_directory_p (current_dir)))
225 report_file_error ("Setting current directory",
226 Fcons (current_buffer->directory, Qnil));
227
228 UNGCPRO;
229 }
230
e576cab4 231 display = nargs >= 4 ? args[3] : Qnil;
80856e74
JB
232
233 {
234 register int i;
235 for (i = 4; i < nargs; i++)
236 {
237 CHECK_STRING (args[i], i);
238 new_argv[i - 3] = XSTRING (args[i])->data;
239 }
240 /* Program name is first command arg */
241 new_argv[0] = XSTRING (args[0])->data;
242 new_argv[i - 3] = 0;
243 }
244
e576cab4 245 filefd = open (XSTRING (infile)->data, O_RDONLY, 0);
80856e74
JB
246 if (filefd < 0)
247 {
e576cab4 248 report_file_error ("Opening process input file", Fcons (infile, Qnil));
80856e74
JB
249 }
250 /* Search for program; barf if not found. */
5437e9f9 251 openp (Vexec_path, args[0], EXEC_SUFFIXES, &path, 1);
012c6fcb 252 if (NILP (path))
80856e74
JB
253 {
254 close (filefd);
255 report_file_error ("Searching for program", Fcons (args[0], Qnil));
256 }
257 new_argv[0] = XSTRING (path)->data;
258
7e6c2178
RS
259#ifdef MSDOS /* MW, July 1993 */
260 /* These vars record information from process termination.
261 Clear them now before process can possibly terminate,
262 to avoid timing error if process terminates soon. */
263 synch_process_death = 0;
264 synch_process_retcode = 0;
265
266 if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP")))
267 strcpy (tempfile = alloca (strlen (outf) + 20), outf);
268 else
269 {
270 tempfile = alloca (20);
271 *tempfile = '\0';
272 }
273 dostounix_filename (tempfile);
274 if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
275 strcat (tempfile, "/");
276 strcat (tempfile, "detmp.XXX");
277 mktemp (tempfile);
278
279 outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
280 if (outfilefd < 0)
281 {
282 close (filefd);
283 report_file_error ("Opening process output file", Fcons (tempfile, Qnil));
284 }
285#endif
286
80856e74 287 if (XTYPE (buffer) == Lisp_Int)
5437e9f9 288 fd[1] = open (NULL_DEVICE, O_WRONLY), fd[0] = -1;
80856e74
JB
289 else
290 {
7e6c2178 291#ifndef MSDOS
80856e74 292 pipe (fd);
7e6c2178 293#endif
80856e74
JB
294#if 0
295 /* Replaced by close_process_descs */
296 set_exclusive_use (fd[0]);
297#endif
298 }
299
300 {
301 /* child_setup must clobber environ in systems with true vfork.
302 Protect it from permanent change. */
303 register char **save_environ = environ;
304 register int fd1 = fd[1];
80856e74
JB
305
306#if 0 /* Some systems don't have sigblock. */
e065a56e 307 mask = sigblock (sigmask (SIGCHLD));
80856e74
JB
308#endif
309
310 /* Record that we're about to create a synchronous process. */
311 synch_process_alive = 1;
312
5c03767e
RS
313 /* These vars record information from process termination.
314 Clear them now before process can possibly terminate,
315 to avoid timing error if process terminates soon. */
316 synch_process_death = 0;
317 synch_process_retcode = 0;
318
7e6c2178
RS
319#ifdef MSDOS /* MW, July 1993 */
320 pid = run_msdos_command (new_argv, current_dir, filefd, outfilefd);
321 close (outfilefd);
322 fd1 = -1; /* No harm in closing that one! */
323 fd[0] = open (tempfile, NILP (Vbinary_process) ? O_TEXT : O_BINARY);
324 if (fd[0] < 0)
325 {
326 unlink (tempfile);
327 report_file_error ("Cannot re-open temporary file", Qnil);
328 }
329#else /* not MSDOS */
80856e74
JB
330 pid = vfork ();
331
332 if (pid == 0)
333 {
334 if (fd[0] >= 0)
335 close (fd[0]);
5a570e37 336#ifdef USG
80856e74
JB
337 setpgrp ();
338#else
339 setpgrp (pid, pid);
340#endif /* USG */
e576cab4 341 child_setup (filefd, fd1, fd1, new_argv, 0, current_dir);
80856e74 342 }
7e6c2178 343#endif /* not MSDOS */
80856e74
JB
344
345#if 0
346 /* Tell SIGCHLD handler to look for this pid. */
347 synch_process_pid = pid;
348 /* Now let SIGCHLD come through. */
e065a56e 349 sigsetmask (mask);
80856e74
JB
350#endif
351
352 environ = save_environ;
353
354 close (filefd);
7e6c2178
RS
355 if (fd1 >= 0)
356 close (fd1);
80856e74
JB
357 }
358
359 if (pid < 0)
360 {
361 close (fd[0]);
362 report_file_error ("Doing vfork", Qnil);
363 }
364
365 if (XTYPE (buffer) == Lisp_Int)
366 {
367#ifndef subprocesses
e576cab4
JB
368 /* If Emacs has been built with asynchronous subprocess support,
369 we don't need to do this, I think because it will then have
370 the facilities for handling SIGCHLD. */
80856e74
JB
371 wait_without_blocking ();
372#endif /* subprocesses */
80856e74
JB
373 return Qnil;
374 }
375
7e6c2178
RS
376#ifdef MSDOS
377 /* MSDOS needs different cleanup information. */
378 record_unwind_protect (call_process_cleanup,
379 Fcons (make_number (fd[0]), build_string (tempfile)));
380#else
80856e74
JB
381 record_unwind_protect (call_process_cleanup,
382 Fcons (make_number (fd[0]), make_number (pid)));
7e6c2178 383#endif /* not MSDOS */
80856e74
JB
384
385
386 if (XTYPE (buffer) == Lisp_Buffer)
387 Fset_buffer (buffer);
388
389 immediate_quit = 1;
390 QUIT;
391
392 {
393 register int nread;
0ad477db 394 int first = 1;
80856e74
JB
395
396 while ((nread = read (fd[0], buf, sizeof buf)) > 0)
397 {
398 immediate_quit = 0;
012c6fcb 399 if (!NILP (buffer))
80856e74 400 insert (buf, nread);
012c6fcb 401 if (!NILP (display) && INTERACTIVE)
0ad477db
RS
402 {
403 if (first)
404 prepare_menu_bars ();
405 first = 0;
406 redisplay_preserve_echo_area ();
407 }
80856e74
JB
408 immediate_quit = 1;
409 QUIT;
410 }
411 }
412
413 /* Wait for it to terminate, unless it already has. */
414 wait_for_termination (pid);
415
416 immediate_quit = 0;
417
418 set_buffer_internal (old);
419
420 unbind_to (count, Qnil);
421
80856e74
JB
422 if (synch_process_death)
423 return build_string (synch_process_death);
424 return make_number (synch_process_retcode);
425}
426#endif
427\f
9fefd2ba 428static Lisp_Object
80856e74
JB
429delete_temp_file (name)
430 Lisp_Object name;
431{
432 unlink (XSTRING (name)->data);
433}
434
435DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
436 3, MANY, 0,
437 "Send text from START to END to a synchronous process running PROGRAM.\n\
438Delete the text if fourth arg DELETE is non-nil.\n\
439Insert output in BUFFER before point; t means current buffer;\n\
440 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
441Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
442Remaining args are passed to PROGRAM at startup as command args.\n\
443If BUFFER is nil, returns immediately with value nil.\n\
444Otherwise waits for PROGRAM to terminate\n\
e576cab4 445and returns a numeric exit status or a signal description string.\n\
d177f194 446If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
80856e74
JB
447 (nargs, args)
448 int nargs;
449 register Lisp_Object *args;
450{
451 register Lisp_Object filename_string, start, end;
7e6c2178
RS
452#ifdef MSDOS
453 char *tempfile;
454#else
80856e74 455 char tempfile[20];
7e6c2178 456#endif
80856e74 457 int count = specpdl_ptr - specpdl;
7e6c2178
RS
458#ifdef MSDOS
459 char *outf = '\0';
460
461 if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP")))
462 strcpy (tempfile = alloca (strlen (outf) + 20), outf);
463 else
464 {
465 tempfile = alloca (20);
466 *tempfile = '\0';
467 }
468 dostounix_filename (tempfile);
469 if (tempfile[strlen (tempfile) - 1] != '/')
470 strcat (tempfile, "/");
471 strcat (tempfile, "detmp.XXX");
472#else /* not MSDOS */
80856e74
JB
473
474#ifdef VMS
475 strcpy (tempfile, "tmp:emacsXXXXXX.");
476#else
477 strcpy (tempfile, "/tmp/emacsXXXXXX");
478#endif
7e6c2178
RS
479#endif /* not MSDOS */
480
80856e74
JB
481 mktemp (tempfile);
482
483 filename_string = build_string (tempfile);
484 start = args[0];
485 end = args[1];
486 Fwrite_region (start, end, filename_string, Qnil, Qlambda);
487 record_unwind_protect (delete_temp_file, filename_string);
488
012c6fcb 489 if (!NILP (args[3]))
80856e74
JB
490 Fdelete_region (start, end);
491
492 args[3] = filename_string;
80856e74 493
58616e67 494 return unbind_to (count, Fcall_process (nargs - 2, args + 2));
80856e74
JB
495}
496\f
497#ifndef VMS /* VMS version is in vmsproc.c. */
498
499/* This is the last thing run in a newly forked inferior
500 either synchronous or asynchronous.
501 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
502 Initialize inferior's priority, pgrp, connected dir and environment.
503 then exec another program based on new_argv.
504
505 This function may change environ for the superior process.
506 Therefore, the superior process must save and restore the value
507 of environ around the vfork and the call to this function.
508
509 ENV is the environment for the subprocess.
510
511 SET_PGRP is nonzero if we should put the subprocess into a separate
e576cab4
JB
512 process group.
513
514 CURRENT_DIR is an elisp string giving the path of the current
515 directory the subprocess should have. Since we can't really signal
516 a decent error from within the child, this should be verified as an
517 executable directory by the parent. */
80856e74 518
e576cab4 519child_setup (in, out, err, new_argv, set_pgrp, current_dir)
80856e74
JB
520 int in, out, err;
521 register char **new_argv;
80856e74 522 int set_pgrp;
e576cab4 523 Lisp_Object current_dir;
80856e74 524{
7e6c2178
RS
525#ifdef MSDOS
526 /* The MSDOS port of gcc cannot fork, vfork, ... so we must call system
527 instead. */
528#else /* not MSDOS */
e576cab4
JB
529 char **env;
530
33abe2d9 531 int pid = getpid ();
80856e74 532
4f0b9d49
JB
533 {
534 extern int emacs_priority;
535
536 nice (- emacs_priority);
537 }
80856e74
JB
538
539#ifdef subprocesses
540 /* Close Emacs's descriptors that this process should not have. */
541 close_process_descs ();
542#endif
4458cebe 543 close_load_descs ();
80856e74
JB
544
545 /* Note that use of alloca is always safe here. It's obvious for systems
546 that do not have true vfork or that have true (stack) alloca.
547 If using vfork and C_ALLOCA it is safe because that changes
548 the superior's static variables as if the superior had done alloca
549 and will be cleaned up in the usual way. */
e576cab4
JB
550 {
551 register unsigned char *temp;
552 register int i;
77d78be1 553
e576cab4
JB
554 i = XSTRING (current_dir)->size;
555 temp = (unsigned char *) alloca (i + 2);
556 bcopy (XSTRING (current_dir)->data, temp, i);
557 if (temp[i - 1] != '/') temp[i++] = '/';
558 temp[i] = 0;
559
560 /* We can't signal an Elisp error here; we're in a vfork. Since
561 the callers check the current directory before forking, this
562 should only return an error if the directory's permissions
563 are changed between the check and this chdir, but we should
564 at least check. */
565 if (chdir (temp) < 0)
566 exit (errno);
567 }
80856e74 568
80856e74
JB
569 /* Set `env' to a vector of the strings in Vprocess_environment. */
570 {
571 register Lisp_Object tem;
572 register char **new_env;
573 register int new_length;
574
575 new_length = 0;
576 for (tem = Vprocess_environment;
577 (XTYPE (tem) == Lisp_Cons
578 && XTYPE (XCONS (tem)->car) == Lisp_String);
579 tem = XCONS (tem)->cdr)
580 new_length++;
581
cd9565ba 582 /* new_length + 1 to include terminating 0. */
80856e74
JB
583 env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));
584
cd9565ba 585 /* Copy the Vprocess_environment strings into new_env. */
80856e74
JB
586 for (tem = Vprocess_environment;
587 (XTYPE (tem) == Lisp_Cons
588 && XTYPE (XCONS (tem)->car) == Lisp_String);
589 tem = XCONS (tem)->cdr)
cd9565ba
RS
590 {
591 char **ep = env;
592 char *string = (char *) XSTRING (XCONS (tem)->car)->data;
593 /* See if this string duplicates any string already in the env.
594 If so, don't put it in.
595 When an env var has multiple definitions,
596 we keep the definition that comes first in process-environment. */
597 for (; ep != new_env; ep++)
598 {
599 char *p = *ep, *q = string;
600 while (1)
601 {
602 if (*q == 0)
603 /* The string is malformed; might as well drop it. */
604 goto duplicate;
605 if (*q != *p)
606 break;
607 if (*q == '=')
608 goto duplicate;
609 p++, q++;
610 }
611 }
612 *new_env++ = string;
613 duplicate: ;
614 }
80856e74
JB
615 *new_env = 0;
616 }
80856e74 617
426b37ae
JB
618 /* Make sure that in, out, and err are not actually already in
619 descriptors zero, one, or two; this could happen if Emacs is
7e6c2178 620 started with its standard in, out, or error closed, as might
426b37ae
JB
621 happen under X. */
622 in = relocate_fd (in, 3);
623 out = relocate_fd (out, 3);
624 err = relocate_fd (err, 3);
625
80856e74
JB
626 close (0);
627 close (1);
628 close (2);
629
630 dup2 (in, 0);
631 dup2 (out, 1);
632 dup2 (err, 2);
633 close (in);
634 close (out);
635 close (err);
636
fdba8590
RS
637#ifdef USG
638#ifndef SETPGRP_RELEASES_CTTY
e576cab4 639 setpgrp (); /* No arguments but equivalent in this case */
fdba8590 640#endif
e576cab4
JB
641#else
642 setpgrp (pid, pid);
643#endif /* USG */
a129418f
RS
644 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
645 EMACS_SET_TTY_PGRP (0, &pid);
80856e74
JB
646
647#ifdef vipc
648 something missing here;
649#endif /* vipc */
650
651 /* execvp does not accept an environment arg so the only way
652 to pass this environment is to set environ. Our caller
653 is responsible for restoring the ambient value of environ. */
654 environ = env;
655 execvp (new_argv[0], new_argv);
656
657 write (1, "Couldn't exec the program ", 26);
658 write (1, new_argv[0], strlen (new_argv[0]));
659 _exit (1);
7e6c2178 660#endif /* not MSDOS */
80856e74
JB
661}
662
426b37ae
JB
663/* Move the file descriptor FD so that its number is not less than MIN.
664 If the file descriptor is moved at all, the original is freed. */
665int
666relocate_fd (fd, min)
667 int fd, min;
668{
669 if (fd >= min)
670 return fd;
671 else
672 {
673 int new = dup (fd);
674 if (new == -1)
675 {
20c018a0 676 char *message1 = "Error while setting up child: ";
826c56ac 677 char *errmessage = strerror (errno);
20c018a0
JB
678 char *message2 = "\n";
679 write (2, message1, strlen (message1));
826c56ac 680 write (2, errmessage, strlen (errmessage));
20c018a0 681 write (2, message2, strlen (message2));
426b37ae
JB
682 _exit (1);
683 }
684 /* Note that we hold the original FD open while we recurse,
685 to guarantee we'll get a new FD if we need it. */
686 new = relocate_fd (new, min);
687 close (fd);
688 return new;
689 }
690}
691
012c6fcb
JA
692static int
693getenv_internal (var, varlen, value, valuelen)
694 char *var;
695 int varlen;
696 char **value;
697 int *valuelen;
698{
699 Lisp_Object scan;
700
701 for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr)
702 {
703 Lisp_Object entry = XCONS (scan)->car;
e576cab4 704
012c6fcb
JA
705 if (XTYPE (entry) == Lisp_String
706 && XSTRING (entry)->size > varlen
707 && XSTRING (entry)->data[varlen] == '='
708 && ! bcmp (XSTRING (entry)->data, var, varlen))
709 {
710 *value = (char *) XSTRING (entry)->data + (varlen + 1);
711 *valuelen = XSTRING (entry)->size - (varlen + 1);
712 return 1;
713 }
714 }
715
716 return 0;
717}
718
0ad477db 719DEFUN ("getenv", Fgetenv, Sgetenv, 1, 1, 0,
012c6fcb
JA
720 "Return the value of environment variable VAR, as a string.\n\
721VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
722This function consults the variable ``process-environment'' for its value.")
723 (var)
724 Lisp_Object var;
725{
726 char *value;
727 int valuelen;
728
729 CHECK_STRING (var, 0);
730 if (getenv_internal (XSTRING (var)->data, XSTRING (var)->size,
731 &value, &valuelen))
732 return make_string (value, valuelen);
733 else
734 return Qnil;
735}
736
737/* A version of getenv that consults process_environment, easily
e576cab4 738 callable from C. */
012c6fcb
JA
739char *
740egetenv (var)
e576cab4 741 char *var;
012c6fcb
JA
742{
743 char *value;
744 int valuelen;
745
746 if (getenv_internal (var, strlen (var), &value, &valuelen))
747 return value;
748 else
749 return 0;
750}
751
80856e74
JB
752#endif /* not VMS */
753\f
8de15d69 754/* This is run before init_cmdargs. */
7e6c2178 755
8de15d69
RS
756init_callproc_1 ()
757{
758 char *data_dir = egetenv ("EMACSDATA");
e576cab4 759
8de15d69 760 Vdata_directory
7e6c2178 761 = Ffile_name_as_directory (build_string (data_dir ? data_dir
8de15d69 762 : PATH_DATA));
9453ea7b 763
e576cab4
JB
764 /* Check the EMACSPATH environment variable, defaulting to the
765 PATH_EXEC path from paths.h. */
766 Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
80856e74
JB
767 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
768 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
8de15d69
RS
769}
770
771/* This is run after init_cmdargs, so that Vinvocation_directory is valid. */
772
773init_callproc ()
774{
775 char *data_dir = egetenv ("EMACSDATA");
776
777 register char * sh;
778 Lisp_Object tempdir;
779
05630743 780 if (initialized && !NILP (Vinstallation_directory))
8de15d69 781 {
05630743
RS
782 /* Add to the path the lib-src subdir of the installation dir. */
783 Lisp_Object tem;
784 tem = Fexpand_file_name (build_string ("lib-src"),
785 Vinstallation_directory);
786 if (NILP (Fmember (tem, Vexec_path)))
8de15d69
RS
787 {
788 Vexec_path = nconc2 (Vexec_path, Fcons (tem, Qnil));
789 Vexec_directory = Ffile_name_as_directory (tem);
790
791 /* If we use ../lib-src, maybe use ../etc as well.
792 Do so if ../etc exists and has our DOC-... file in it. */
793 if (data_dir == 0)
794 {
05630743
RS
795 tem = Fexpand_file_name (build_string ("etc"),
796 Vinstallation_directory);
797 Vdata_directory = Ffile_name_as_directory (tem);
8de15d69
RS
798 }
799 }
800 }
80856e74 801
e576cab4
JB
802 tempdir = Fdirectory_file_name (Vexec_directory);
803 if (access (XSTRING (tempdir)->data, 0) < 0)
80856e74 804 {
0af6a831
RS
805 fprintf (stderr,
806 "Warning: arch-dependent data dir (%s) does not exist.\n",
807 XSTRING (Vexec_directory)->data);
80856e74
JB
808 sleep (2);
809 }
810
e576cab4
JB
811 tempdir = Fdirectory_file_name (Vdata_directory);
812 if (access (XSTRING (tempdir)->data, 0) < 0)
813 {
0af6a831
RS
814 fprintf (stderr,
815 "Warning: arch-independent data dir (%s) does not exist.\n",
816 XSTRING (Vdata_directory)->data);
e576cab4
JB
817 sleep (2);
818 }
819
80856e74
JB
820#ifdef VMS
821 Vshell_file_name = build_string ("*dcl*");
822#else
e576cab4 823 sh = (char *) getenv ("SHELL");
80856e74
JB
824 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
825#endif
9fefd2ba
JB
826}
827
828set_process_environment ()
829{
830 register char **envp;
80856e74 831
80856e74
JB
832 Vprocess_environment = Qnil;
833#ifndef CANNOT_DUMP
834 if (initialized)
835#endif
836 for (envp = environ; *envp; envp++)
837 Vprocess_environment = Fcons (build_string (*envp),
838 Vprocess_environment);
80856e74
JB
839}
840
841syms_of_callproc ()
842{
7e6c2178
RS
843#ifdef MSDOS
844 DEFVAR_LISP ("binary-process", &Vbinary_process,
845 "*If non-nil then new subprocesses are assumed to produce binary output.");
846 Vbinary_process = Qnil;
847#endif
848
80856e74
JB
849 DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
850 "*File name to load inferior shells from.\n\
851Initialized from the SHELL environment variable.");
852
853 DEFVAR_LISP ("exec-path", &Vexec_path,
854 "*List of directories to search programs to run in subprocesses.\n\
855Each element is a string (directory name) or nil (try default directory).");
856
857 DEFVAR_LISP ("exec-directory", &Vexec_directory,
e576cab4
JB
858 "Directory of architecture-dependent files that come with GNU Emacs,\n\
859especially executable programs intended for Emacs to invoke.");
860
861 DEFVAR_LISP ("data-directory", &Vdata_directory,
862 "Directory of architecture-independent files that come with GNU Emacs,\n\
863intended for Emacs to use.");
80856e74 864
ed61592a
JB
865 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory,
866 "For internal use by the build procedure only.\n\
867This is the name of the directory in which the build procedure installed\n\
868Emacs's info files; the default value for Info-default-directory-list\n\
869includes this.");
870 Vconfigure_info_directory = build_string (PATH_INFO);
871
80856e74 872 DEFVAR_LISP ("process-environment", &Vprocess_environment,
e576cab4
JB
873 "List of environment variables for subprocesses to inherit.\n\
874Each element should be a string of the form ENVVARNAME=VALUE.\n\
875The environment which Emacs inherits is placed in this variable\n\
876when Emacs starts.");
80856e74
JB
877
878#ifndef VMS
879 defsubr (&Scall_process);
012c6fcb 880 defsubr (&Sgetenv);
986ffb24 881#endif
e576cab4 882 defsubr (&Scall_process_region);
80856e74 883}