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