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