(read_char): Don't text do_mouse_tracking;
[bpt/emacs.git] / src / callproc.c
CommitLineData
80856e74 1/* Synchronous subprocess invocation for GNU Emacs.
826c56ac 2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 Free Software Foundation, Inc.
80856e74
JB
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
826c56ac 8the Free Software Foundation; either version 2, or (at your option)
80856e74
JB
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21#include <signal.h>
e576cab4 22#include <errno.h>
0af6a831 23#include <stdio.h>
80856e74 24
18160b98 25#include <config.h>
80856e74 26
426b37ae 27extern int errno;
826c56ac 28extern char *strerror ();
426b37ae 29
80856e74
JB
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>
88a64fef 37
80856e74
JB
38#include <sys/file.h>
39#ifdef USG5
472e83fe 40#define INCLUDED_FCNTL
80856e74
JB
41#include <fcntl.h>
42#endif
43
7e6c2178 44#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
472e83fe 45#define INCLUDED_FCNTL
7e6c2178
RS
46#include <fcntl.h>
47#include <sys/stat.h>
48#include <sys/param.h>
49#include <errno.h>
50#endif /* MSDOS */
51
80856e74
JB
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"
2a6b3537 63#include <paths.h>
80856e74 64#include "process.h"
d177f194 65#include "syssignal.h"
a129418f 66#include "systty.h"
80856e74
JB
67
68#ifdef VMS
69extern noshare char **environ;
70#else
71extern char **environ;
72#endif
73
74#define max(a, b) ((a) > (b) ? (a) : (b))
75
7e6c2178
RS
76#ifdef MSDOS
77Lisp_Object Vbinary_process;
78#endif
79
35a2f4b8 80Lisp_Object Vexec_path, Vexec_directory, Vdata_directory, Vdoc_directory;
ed61592a 81Lisp_Object Vconfigure_info_directory;
80856e74
JB
82
83Lisp_Object Vshell_file_name;
84
80856e74 85Lisp_Object Vprocess_environment;
80856e74
JB
86
87/* True iff we are about to fork off a synchronous process or if we
88 are waiting for it. */
89int synch_process_alive;
90
91/* Nonzero => this is a string explaining death of synchronous subprocess. */
92char *synch_process_death;
93
94/* If synch_process_death is zero,
95 this is exit code of synchronous subprocess. */
96int synch_process_retcode;
8de15d69
RS
97
98extern Lisp_Object Vdoc_file_name;
80856e74 99\f
37d54121
RS
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. */
105static int call_process_exited;
106
80856e74
JB
107#ifndef VMS /* VMS version is in vmsproc.c. */
108
d177f194
JB
109static Lisp_Object
110call_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
80856e74
JB
119Lisp_Object
120call_process_cleanup (fdpid)
121 Lisp_Object fdpid;
122{
7e6c2178
RS
123#ifdef MSDOS
124 /* for MSDOS fdpid is really (fd . tempfile) */
c1350752
KH
125 register Lisp_Object file;
126 file = Fcdr (fdpid);
7e6c2178
RS
127 close (XFASTINT (Fcar (fdpid)));
128 if (strcmp (XSTRING (file)-> data, NULL_DEVICE) != 0)
129 unlink (XSTRING (file)->data);
130#else /* not MSDOS */
d177f194
JB
131 register int pid = XFASTINT (Fcdr (fdpid));
132
6b6e798b 133
37d54121 134 if (call_process_exited)
6b6e798b
RS
135 {
136 close (XFASTINT (Fcar (fdpid)));
137 return Qnil;
138 }
37d54121 139
d177f194
JB
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 }
80856e74 152 synch_process_alive = 0;
d177f194 153 close (XFASTINT (Fcar (fdpid)));
7e6c2178 154#endif /* not MSDOS */
80856e74
JB
155 return Qnil;
156}
157
158DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
159 "Call PROGRAM synchronously in separate process.\n\
160The program's input comes from file INFILE (nil means `/dev/null').\n\
161Insert 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\
163Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
164Remaining arguments are strings passed as command arguments to PROGRAM.\n\
e576cab4 165If BUFFER is 0, returns immediately with value nil.\n\
80856e74 166Otherwise waits for PROGRAM to terminate\n\
e576cab4 167and returns a numeric exit status or a signal description string.\n\
d177f194 168If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
80856e74
JB
169 (nargs, args)
170 int nargs;
171 register Lisp_Object *args;
172{
58616e67 173 Lisp_Object infile, buffer, current_dir, display, path;
80856e74
JB
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;
7e6c2178
RS
182#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
183 char *outf, *tempfile;
184 int outfilefd;
185#endif
80856e74
JB
186#if 0
187 int mask;
188#endif
80856e74
JB
189 CHECK_STRING (args[0], 0);
190
7e6c2178
RS
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
e576cab4
JB
197 if (nargs >= 2 && ! NILP (args[1]))
198 {
199 infile = Fexpand_file_name (args[1], current_buffer->directory);
200 CHECK_STRING (infile, 1);
201 }
80856e74 202 else
5437e9f9 203 infile = build_string (NULL_DEVICE);
80856e74 204
e576cab4
JB
205 if (nargs >= 3)
206 {
207 register Lisp_Object tem;
044512ed 208
e576cab4
JB
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;
80856e74 220
58616e67
JB
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
c52b0b34
KH
238 current_dir
239 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
240 Qnil);
58616e67
JB
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
e576cab4 248 display = nargs >= 4 ? args[3] : Qnil;
80856e74 249
e576cab4 250 filefd = open (XSTRING (infile)->data, O_RDONLY, 0);
80856e74
JB
251 if (filefd < 0)
252 {
e576cab4 253 report_file_error ("Opening process input file", Fcons (infile, Qnil));
80856e74
JB
254 }
255 /* Search for program; barf if not found. */
c52b0b34
KH
256 {
257 struct gcpro gcpro1;
258
259 GCPRO1 (current_dir);
260 openp (Vexec_path, args[0], EXEC_SUFFIXES, &path, 1);
261 UNGCPRO;
262 }
012c6fcb 263 if (NILP (path))
80856e74
JB
264 {
265 close (filefd);
266 report_file_error ("Searching for program", Fcons (args[0], Qnil));
267 }
268 new_argv[0] = XSTRING (path)->data;
c52b0b34
KH
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 }
80856e74 278
7e6c2178
RS
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
80856e74 307 if (XTYPE (buffer) == Lisp_Int)
5437e9f9 308 fd[1] = open (NULL_DEVICE, O_WRONLY), fd[0] = -1;
80856e74
JB
309 else
310 {
7e6c2178 311#ifndef MSDOS
80856e74 312 pipe (fd);
7e6c2178 313#endif
80856e74
JB
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];
80856e74
JB
325
326#if 0 /* Some systems don't have sigblock. */
e065a56e 327 mask = sigblock (sigmask (SIGCHLD));
80856e74
JB
328#endif
329
330 /* Record that we're about to create a synchronous process. */
331 synch_process_alive = 1;
332
5c03767e
RS
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
7e6c2178 339#ifdef MSDOS /* MW, July 1993 */
6b6e798b
RS
340 /* ??? Someone who knows MSDOG needs to check whether this properly
341 closes all descriptors that it opens. */
7e6c2178
RS
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);
6b6e798b 349 close (filefd);
7e6c2178
RS
350 report_file_error ("Cannot re-open temporary file", Qnil);
351 }
352#else /* not MSDOS */
80856e74
JB
353 pid = vfork ();
354
355 if (pid == 0)
356 {
357 if (fd[0] >= 0)
358 close (fd[0]);
5a570e37 359#ifdef USG
80856e74
JB
360 setpgrp ();
361#else
362 setpgrp (pid, pid);
363#endif /* USG */
e576cab4 364 child_setup (filefd, fd1, fd1, new_argv, 0, current_dir);
80856e74 365 }
7e6c2178 366#endif /* not MSDOS */
80856e74 367
80856e74
JB
368 environ = save_environ;
369
6b6e798b
RS
370 /* Close most of our fd's, but not fd[0]
371 since we will use that to read input from. */
80856e74 372 close (filefd);
7e6c2178
RS
373 if (fd1 >= 0)
374 close (fd1);
80856e74
JB
375 }
376
377 if (pid < 0)
378 {
6b6e798b
RS
379 if (fd[0] >= 0)
380 close (fd[0]);
80856e74
JB
381 report_file_error ("Doing vfork", Qnil);
382 }
383
384 if (XTYPE (buffer) == Lisp_Int)
385 {
6b6e798b
RS
386 if (fd[0] >= 0)
387 close (fd[0]);
80856e74 388#ifndef subprocesses
e576cab4
JB
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. */
80856e74
JB
392 wait_without_blocking ();
393#endif /* subprocesses */
80856e74
JB
394 return Qnil;
395 }
396
6b6e798b 397 /* Enable sending signal if user quits below. */
37d54121
RS
398 call_process_exited = 0;
399
7e6c2178
RS
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
80856e74
JB
405 record_unwind_protect (call_process_cleanup,
406 Fcons (make_number (fd[0]), make_number (pid)));
7e6c2178 407#endif /* not MSDOS */
80856e74
JB
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;
0ad477db 418 int first = 1;
80856e74
JB
419
420 while ((nread = read (fd[0], buf, sizeof buf)) > 0)
421 {
422 immediate_quit = 0;
012c6fcb 423 if (!NILP (buffer))
80856e74 424 insert (buf, nread);
012c6fcb 425 if (!NILP (display) && INTERACTIVE)
0ad477db
RS
426 {
427 if (first)
428 prepare_menu_bars ();
429 first = 0;
430 redisplay_preserve_echo_area ();
431 }
80856e74
JB
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
37d54121
RS
444 /* Don't kill any children that the subprocess may have left behind
445 when exiting. */
446 call_process_exited = 1;
447
80856e74
JB
448 unbind_to (count, Qnil);
449
80856e74
JB
450 if (synch_process_death)
451 return build_string (synch_process_death);
452 return make_number (synch_process_retcode);
453}
454#endif
455\f
9fefd2ba 456static Lisp_Object
80856e74
JB
457delete_temp_file (name)
458 Lisp_Object name;
459{
460 unlink (XSTRING (name)->data);
461}
462
463DEFUN ("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\
466Delete the text if fourth arg DELETE is non-nil.\n\
467Insert 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\
469Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
470Remaining args are passed to PROGRAM at startup as command args.\n\
471If BUFFER is nil, returns immediately with value nil.\n\
472Otherwise waits for PROGRAM to terminate\n\
e576cab4 473and returns a numeric exit status or a signal description string.\n\
d177f194 474If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
80856e74
JB
475 (nargs, args)
476 int nargs;
477 register Lisp_Object *args;
478{
479 register Lisp_Object filename_string, start, end;
7e6c2178
RS
480#ifdef MSDOS
481 char *tempfile;
482#else
80856e74 483 char tempfile[20];
7e6c2178 484#endif
80856e74 485 int count = specpdl_ptr - specpdl;
7e6c2178
RS
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 */
80856e74
JB
501
502#ifdef VMS
503 strcpy (tempfile, "tmp:emacsXXXXXX.");
504#else
505 strcpy (tempfile, "/tmp/emacsXXXXXX");
506#endif
7e6c2178
RS
507#endif /* not MSDOS */
508
80856e74
JB
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
012c6fcb 517 if (!NILP (args[3]))
80856e74
JB
518 Fdelete_region (start, end);
519
520 args[3] = filename_string;
80856e74 521
58616e67 522 return unbind_to (count, Fcall_process (nargs - 2, args + 2));
80856e74
JB
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
e576cab4
JB
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. */
80856e74 546
e576cab4 547child_setup (in, out, err, new_argv, set_pgrp, current_dir)
80856e74
JB
548 int in, out, err;
549 register char **new_argv;
80856e74 550 int set_pgrp;
e576cab4 551 Lisp_Object current_dir;
80856e74 552{
7e6c2178
RS
553#ifdef MSDOS
554 /* The MSDOS port of gcc cannot fork, vfork, ... so we must call system
555 instead. */
556#else /* not MSDOS */
e576cab4
JB
557 char **env;
558
33abe2d9 559 int pid = getpid ();
80856e74 560
5b633aeb 561#ifdef PRIO_PROCESS
4f0b9d49
JB
562 {
563 extern int emacs_priority;
564
565 nice (- emacs_priority);
566 }
5b633aeb 567#endif
80856e74
JB
568
569#ifdef subprocesses
570 /* Close Emacs's descriptors that this process should not have. */
571 close_process_descs ();
572#endif
4458cebe 573 close_load_descs ();
80856e74
JB
574
575 /* Note that use of alloca is always safe here. It's obvious for systems
576 that do not have true vfork or that have true (stack) alloca.
577 If using vfork and C_ALLOCA it is safe because that changes
578 the superior's static variables as if the superior had done alloca
579 and will be cleaned up in the usual way. */
e576cab4
JB
580 {
581 register unsigned char *temp;
582 register int i;
77d78be1 583
e576cab4
JB
584 i = XSTRING (current_dir)->size;
585 temp = (unsigned char *) alloca (i + 2);
586 bcopy (XSTRING (current_dir)->data, temp, i);
587 if (temp[i - 1] != '/') temp[i++] = '/';
588 temp[i] = 0;
589
590 /* We can't signal an Elisp error here; we're in a vfork. Since
591 the callers check the current directory before forking, this
592 should only return an error if the directory's permissions
593 are changed between the check and this chdir, but we should
594 at least check. */
595 if (chdir (temp) < 0)
596 exit (errno);
597 }
80856e74 598
80856e74
JB
599 /* Set `env' to a vector of the strings in Vprocess_environment. */
600 {
601 register Lisp_Object tem;
602 register char **new_env;
603 register int new_length;
604
605 new_length = 0;
606 for (tem = Vprocess_environment;
607 (XTYPE (tem) == Lisp_Cons
608 && XTYPE (XCONS (tem)->car) == Lisp_String);
609 tem = XCONS (tem)->cdr)
610 new_length++;
611
cd9565ba 612 /* new_length + 1 to include terminating 0. */
80856e74
JB
613 env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));
614
cd9565ba 615 /* Copy the Vprocess_environment strings into new_env. */
80856e74
JB
616 for (tem = Vprocess_environment;
617 (XTYPE (tem) == Lisp_Cons
618 && XTYPE (XCONS (tem)->car) == Lisp_String);
619 tem = XCONS (tem)->cdr)
cd9565ba
RS
620 {
621 char **ep = env;
622 char *string = (char *) XSTRING (XCONS (tem)->car)->data;
623 /* See if this string duplicates any string already in the env.
624 If so, don't put it in.
625 When an env var has multiple definitions,
626 we keep the definition that comes first in process-environment. */
627 for (; ep != new_env; ep++)
628 {
629 char *p = *ep, *q = string;
630 while (1)
631 {
632 if (*q == 0)
633 /* The string is malformed; might as well drop it. */
634 goto duplicate;
635 if (*q != *p)
636 break;
637 if (*q == '=')
638 goto duplicate;
639 p++, q++;
640 }
641 }
642 *new_env++ = string;
643 duplicate: ;
644 }
80856e74
JB
645 *new_env = 0;
646 }
80856e74 647
426b37ae
JB
648 /* Make sure that in, out, and err are not actually already in
649 descriptors zero, one, or two; this could happen if Emacs is
7e6c2178 650 started with its standard in, out, or error closed, as might
426b37ae
JB
651 happen under X. */
652 in = relocate_fd (in, 3);
3e9367e7
KH
653 if (out == err)
654 err = out = relocate_fd (out, 3);
655 else
656 {
657 out = relocate_fd (out, 3);
658 err = relocate_fd (err, 3);
659 }
426b37ae 660
80856e74
JB
661 close (0);
662 close (1);
663 close (2);
664
665 dup2 (in, 0);
666 dup2 (out, 1);
667 dup2 (err, 2);
668 close (in);
669 close (out);
670 close (err);
671
fdba8590
RS
672#ifdef USG
673#ifndef SETPGRP_RELEASES_CTTY
e576cab4 674 setpgrp (); /* No arguments but equivalent in this case */
fdba8590 675#endif
e576cab4
JB
676#else
677 setpgrp (pid, pid);
678#endif /* USG */
a129418f
RS
679 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
680 EMACS_SET_TTY_PGRP (0, &pid);
80856e74
JB
681
682#ifdef vipc
683 something missing here;
684#endif /* vipc */
685
686 /* execvp does not accept an environment arg so the only way
687 to pass this environment is to set environ. Our caller
688 is responsible for restoring the ambient value of environ. */
689 environ = env;
690 execvp (new_argv[0], new_argv);
691
692 write (1, "Couldn't exec the program ", 26);
693 write (1, new_argv[0], strlen (new_argv[0]));
694 _exit (1);
7e6c2178 695#endif /* not MSDOS */
80856e74
JB
696}
697
426b37ae
JB
698/* Move the file descriptor FD so that its number is not less than MIN.
699 If the file descriptor is moved at all, the original is freed. */
700int
701relocate_fd (fd, min)
702 int fd, min;
703{
704 if (fd >= min)
705 return fd;
706 else
707 {
708 int new = dup (fd);
709 if (new == -1)
710 {
20c018a0 711 char *message1 = "Error while setting up child: ";
826c56ac 712 char *errmessage = strerror (errno);
20c018a0
JB
713 char *message2 = "\n";
714 write (2, message1, strlen (message1));
826c56ac 715 write (2, errmessage, strlen (errmessage));
20c018a0 716 write (2, message2, strlen (message2));
426b37ae
JB
717 _exit (1);
718 }
719 /* Note that we hold the original FD open while we recurse,
720 to guarantee we'll get a new FD if we need it. */
721 new = relocate_fd (new, min);
722 close (fd);
723 return new;
724 }
725}
726
012c6fcb
JA
727static int
728getenv_internal (var, varlen, value, valuelen)
729 char *var;
730 int varlen;
731 char **value;
732 int *valuelen;
733{
734 Lisp_Object scan;
735
736 for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr)
737 {
c1350752
KH
738 Lisp_Object entry;
739
740 entry = XCONS (scan)->car;
012c6fcb
JA
741 if (XTYPE (entry) == Lisp_String
742 && XSTRING (entry)->size > varlen
743 && XSTRING (entry)->data[varlen] == '='
744 && ! bcmp (XSTRING (entry)->data, var, varlen))
745 {
746 *value = (char *) XSTRING (entry)->data + (varlen + 1);
747 *valuelen = XSTRING (entry)->size - (varlen + 1);
748 return 1;
749 }
750 }
751
752 return 0;
753}
754
0ad477db 755DEFUN ("getenv", Fgetenv, Sgetenv, 1, 1, 0,
012c6fcb
JA
756 "Return the value of environment variable VAR, as a string.\n\
757VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
758This function consults the variable ``process-environment'' for its value.")
759 (var)
760 Lisp_Object var;
761{
762 char *value;
763 int valuelen;
764
765 CHECK_STRING (var, 0);
766 if (getenv_internal (XSTRING (var)->data, XSTRING (var)->size,
767 &value, &valuelen))
768 return make_string (value, valuelen);
769 else
770 return Qnil;
771}
772
773/* A version of getenv that consults process_environment, easily
e576cab4 774 callable from C. */
012c6fcb
JA
775char *
776egetenv (var)
e576cab4 777 char *var;
012c6fcb
JA
778{
779 char *value;
780 int valuelen;
781
782 if (getenv_internal (var, strlen (var), &value, &valuelen))
783 return value;
784 else
785 return 0;
786}
787
80856e74
JB
788#endif /* not VMS */
789\f
8de15d69 790/* This is run before init_cmdargs. */
7e6c2178 791
8de15d69
RS
792init_callproc_1 ()
793{
794 char *data_dir = egetenv ("EMACSDATA");
35a2f4b8
KH
795 char *doc_dir = egetenv ("EMACSDOC");
796
8de15d69 797 Vdata_directory
7e6c2178 798 = Ffile_name_as_directory (build_string (data_dir ? data_dir
8de15d69 799 : PATH_DATA));
35a2f4b8
KH
800 Vdoc_directory
801 = Ffile_name_as_directory (build_string (doc_dir ? doc_dir
802 : PATH_DOC));
9453ea7b 803
e576cab4
JB
804 /* Check the EMACSPATH environment variable, defaulting to the
805 PATH_EXEC path from paths.h. */
806 Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
80856e74
JB
807 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
808 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
8de15d69
RS
809}
810
811/* This is run after init_cmdargs, so that Vinvocation_directory is valid. */
812
813init_callproc ()
814{
815 char *data_dir = egetenv ("EMACSDATA");
816
817 register char * sh;
818 Lisp_Object tempdir;
819
05630743 820 if (initialized && !NILP (Vinstallation_directory))
8de15d69 821 {
05630743
RS
822 /* Add to the path the lib-src subdir of the installation dir. */
823 Lisp_Object tem;
824 tem = Fexpand_file_name (build_string ("lib-src"),
825 Vinstallation_directory);
826 if (NILP (Fmember (tem, Vexec_path)))
8de15d69
RS
827 {
828 Vexec_path = nconc2 (Vexec_path, Fcons (tem, Qnil));
829 Vexec_directory = Ffile_name_as_directory (tem);
830
831 /* If we use ../lib-src, maybe use ../etc as well.
832 Do so if ../etc exists and has our DOC-... file in it. */
833 if (data_dir == 0)
834 {
05630743
RS
835 tem = Fexpand_file_name (build_string ("etc"),
836 Vinstallation_directory);
4bb45197 837 Vdoc_directory = Vdata_directory = Ffile_name_as_directory (tem);
8de15d69
RS
838 }
839 }
840 }
80856e74 841
e576cab4
JB
842 tempdir = Fdirectory_file_name (Vexec_directory);
843 if (access (XSTRING (tempdir)->data, 0) < 0)
80856e74 844 {
0af6a831
RS
845 fprintf (stderr,
846 "Warning: arch-dependent data dir (%s) does not exist.\n",
847 XSTRING (Vexec_directory)->data);
80856e74
JB
848 sleep (2);
849 }
850
e576cab4
JB
851 tempdir = Fdirectory_file_name (Vdata_directory);
852 if (access (XSTRING (tempdir)->data, 0) < 0)
853 {
0af6a831
RS
854 fprintf (stderr,
855 "Warning: arch-independent data dir (%s) does not exist.\n",
856 XSTRING (Vdata_directory)->data);
e576cab4
JB
857 sleep (2);
858 }
859
80856e74
JB
860#ifdef VMS
861 Vshell_file_name = build_string ("*dcl*");
862#else
e576cab4 863 sh = (char *) getenv ("SHELL");
80856e74
JB
864 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
865#endif
9fefd2ba
JB
866}
867
868set_process_environment ()
869{
870 register char **envp;
80856e74 871
80856e74
JB
872 Vprocess_environment = Qnil;
873#ifndef CANNOT_DUMP
874 if (initialized)
875#endif
876 for (envp = environ; *envp; envp++)
877 Vprocess_environment = Fcons (build_string (*envp),
878 Vprocess_environment);
80856e74
JB
879}
880
881syms_of_callproc ()
882{
7e6c2178
RS
883#ifdef MSDOS
884 DEFVAR_LISP ("binary-process", &Vbinary_process,
885 "*If non-nil then new subprocesses are assumed to produce binary output.");
886 Vbinary_process = Qnil;
887#endif
888
80856e74
JB
889 DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
890 "*File name to load inferior shells from.\n\
891Initialized from the SHELL environment variable.");
892
893 DEFVAR_LISP ("exec-path", &Vexec_path,
894 "*List of directories to search programs to run in subprocesses.\n\
895Each element is a string (directory name) or nil (try default directory).");
896
897 DEFVAR_LISP ("exec-directory", &Vexec_directory,
e576cab4
JB
898 "Directory of architecture-dependent files that come with GNU Emacs,\n\
899especially executable programs intended for Emacs to invoke.");
900
901 DEFVAR_LISP ("data-directory", &Vdata_directory,
902 "Directory of architecture-independent files that come with GNU Emacs,\n\
903intended for Emacs to use.");
80856e74 904
35a2f4b8
KH
905 DEFVAR_LISP ("doc-directory", &Vdoc_directory,
906 "Directory containing the DOC file that comes with GNU Emacs.\n\
907This is usually the same as data-directory.");
908
ed61592a
JB
909 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory,
910 "For internal use by the build procedure only.\n\
911This is the name of the directory in which the build procedure installed\n\
912Emacs's info files; the default value for Info-default-directory-list\n\
913includes this.");
914 Vconfigure_info_directory = build_string (PATH_INFO);
915
80856e74 916 DEFVAR_LISP ("process-environment", &Vprocess_environment,
e576cab4
JB
917 "List of environment variables for subprocesses to inherit.\n\
918Each element should be a string of the form ENVVARNAME=VALUE.\n\
919The environment which Emacs inherits is placed in this variable\n\
920when Emacs starts.");
80856e74
JB
921
922#ifndef VMS
923 defsubr (&Scall_process);
012c6fcb 924 defsubr (&Sgetenv);
986ffb24 925#endif
e576cab4 926 defsubr (&Scall_process_region);
80856e74 927}