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