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