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