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