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