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