(redisplay): Limit prev change to pause != 0.
[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 76#ifdef MSDOS
093650fe
RS
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. */
81Lisp_Object Vbinary_process_input;
82Lisp_Object Vbinary_process_output;
7e6c2178
RS
83#endif
84
35a2f4b8 85Lisp_Object Vexec_path, Vexec_directory, Vdata_directory, Vdoc_directory;
ed61592a 86Lisp_Object Vconfigure_info_directory;
80856e74
JB
87
88Lisp_Object Vshell_file_name;
89
80856e74 90Lisp_Object Vprocess_environment;
80856e74 91
093650fe
RS
92#ifdef MSDOS
93Lisp_Object Qbuffer_file_type;
94#endif
95
80856e74
JB
96/* True iff we are about to fork off a synchronous process or if we
97 are waiting for it. */
98int synch_process_alive;
99
100/* Nonzero => this is a string explaining death of synchronous subprocess. */
101char *synch_process_death;
102
103/* If synch_process_death is zero,
104 this is exit code of synchronous subprocess. */
105int synch_process_retcode;
8de15d69
RS
106
107extern Lisp_Object Vdoc_file_name;
80856e74 108\f
37d54121
RS
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. */
114static int call_process_exited;
115
80856e74
JB
116#ifndef VMS /* VMS version is in vmsproc.c. */
117
d177f194
JB
118static Lisp_Object
119call_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
80856e74
JB
128Lisp_Object
129call_process_cleanup (fdpid)
130 Lisp_Object fdpid;
131{
7e6c2178
RS
132#ifdef MSDOS
133 /* for MSDOS fdpid is really (fd . tempfile) */
c1350752
KH
134 register Lisp_Object file;
135 file = Fcdr (fdpid);
7e6c2178
RS
136 close (XFASTINT (Fcar (fdpid)));
137 if (strcmp (XSTRING (file)-> data, NULL_DEVICE) != 0)
138 unlink (XSTRING (file)->data);
139#else /* not MSDOS */
d177f194
JB
140 register int pid = XFASTINT (Fcdr (fdpid));
141
6b6e798b 142
37d54121 143 if (call_process_exited)
6b6e798b
RS
144 {
145 close (XFASTINT (Fcar (fdpid)));
146 return Qnil;
147 }
37d54121 148
d177f194
JB
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 }
80856e74 161 synch_process_alive = 0;
d177f194 162 close (XFASTINT (Fcar (fdpid)));
7e6c2178 163#endif /* not MSDOS */
80856e74
JB
164 return Qnil;
165}
166
167DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
168 "Call PROGRAM synchronously in separate process.\n\
169The program's input comes from file INFILE (nil means `/dev/null').\n\
170Insert 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\
172Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
173Remaining arguments are strings passed as command arguments to PROGRAM.\n\
e576cab4 174If BUFFER is 0, returns immediately with value nil.\n\
80856e74 175Otherwise waits for PROGRAM to terminate\n\
e576cab4 176and returns a numeric exit status or a signal description string.\n\
d177f194 177If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
80856e74
JB
178 (nargs, args)
179 int nargs;
180 register Lisp_Object *args;
181{
58616e67 182 Lisp_Object infile, buffer, current_dir, display, path;
80856e74
JB
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;
7e6c2178
RS
191#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
192 char *outf, *tempfile;
193 int outfilefd;
194#endif
80856e74
JB
195#if 0
196 int mask;
197#endif
80856e74
JB
198 CHECK_STRING (args[0], 0);
199
7e6c2178
RS
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
e576cab4
JB
206 if (nargs >= 2 && ! NILP (args[1]))
207 {
208 infile = Fexpand_file_name (args[1], current_buffer->directory);
209 CHECK_STRING (infile, 1);
210 }
80856e74 211 else
5437e9f9 212 infile = build_string (NULL_DEVICE);
80856e74 213
e576cab4
JB
214 if (nargs >= 3)
215 {
216 register Lisp_Object tem;
044512ed 217
e576cab4
JB
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;
80856e74 229
58616e67
JB
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
c52b0b34
KH
247 current_dir
248 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
249 Qnil);
58616e67
JB
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
e576cab4 257 display = nargs >= 4 ? args[3] : Qnil;
80856e74 258
e576cab4 259 filefd = open (XSTRING (infile)->data, O_RDONLY, 0);
80856e74
JB
260 if (filefd < 0)
261 {
e576cab4 262 report_file_error ("Opening process input file", Fcons (infile, Qnil));
80856e74
JB
263 }
264 /* Search for program; barf if not found. */
c52b0b34
KH
265 {
266 struct gcpro gcpro1;
267
268 GCPRO1 (current_dir);
269 openp (Vexec_path, args[0], EXEC_SUFFIXES, &path, 1);
270 UNGCPRO;
271 }
012c6fcb 272 if (NILP (path))
80856e74
JB
273 {
274 close (filefd);
275 report_file_error ("Searching for program", Fcons (args[0], Qnil));
276 }
277 new_argv[0] = XSTRING (path)->data;
c52b0b34
KH
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 }
80856e74 287
7e6c2178
RS
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
80856e74 316 if (XTYPE (buffer) == Lisp_Int)
5437e9f9 317 fd[1] = open (NULL_DEVICE, O_WRONLY), fd[0] = -1;
80856e74
JB
318 else
319 {
7e6c2178 320#ifndef MSDOS
80856e74 321 pipe (fd);
7e6c2178 322#endif
80856e74
JB
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];
80856e74
JB
334
335#if 0 /* Some systems don't have sigblock. */
e065a56e 336 mask = sigblock (sigmask (SIGCHLD));
80856e74
JB
337#endif
338
339 /* Record that we're about to create a synchronous process. */
340 synch_process_alive = 1;
341
5c03767e
RS
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
7e6c2178 348#ifdef MSDOS /* MW, July 1993 */
6b6e798b
RS
349 /* ??? Someone who knows MSDOG needs to check whether this properly
350 closes all descriptors that it opens. */
7e6c2178
RS
351 pid = run_msdos_command (new_argv, current_dir, filefd, outfilefd);
352 close (outfilefd);
353 fd1 = -1; /* No harm in closing that one! */
093650fe 354 fd[0] = open (tempfile, NILP (Vbinary_process_output) ? O_TEXT : O_BINARY);
7e6c2178
RS
355 if (fd[0] < 0)
356 {
357 unlink (tempfile);
6b6e798b 358 close (filefd);
7e6c2178
RS
359 report_file_error ("Cannot re-open temporary file", Qnil);
360 }
361#else /* not MSDOS */
80856e74
JB
362 pid = vfork ();
363
364 if (pid == 0)
365 {
366 if (fd[0] >= 0)
367 close (fd[0]);
5a570e37 368#ifdef USG
80856e74
JB
369 setpgrp ();
370#else
371 setpgrp (pid, pid);
372#endif /* USG */
e576cab4 373 child_setup (filefd, fd1, fd1, new_argv, 0, current_dir);
80856e74 374 }
7e6c2178 375#endif /* not MSDOS */
80856e74 376
80856e74
JB
377 environ = save_environ;
378
6b6e798b
RS
379 /* Close most of our fd's, but not fd[0]
380 since we will use that to read input from. */
80856e74 381 close (filefd);
7e6c2178
RS
382 if (fd1 >= 0)
383 close (fd1);
80856e74
JB
384 }
385
386 if (pid < 0)
387 {
6b6e798b
RS
388 if (fd[0] >= 0)
389 close (fd[0]);
80856e74
JB
390 report_file_error ("Doing vfork", Qnil);
391 }
392
393 if (XTYPE (buffer) == Lisp_Int)
394 {
6b6e798b
RS
395 if (fd[0] >= 0)
396 close (fd[0]);
80856e74 397#ifndef subprocesses
e576cab4
JB
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. */
80856e74
JB
401 wait_without_blocking ();
402#endif /* subprocesses */
80856e74
JB
403 return Qnil;
404 }
405
6b6e798b 406 /* Enable sending signal if user quits below. */
37d54121
RS
407 call_process_exited = 0;
408
7e6c2178
RS
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
80856e74
JB
414 record_unwind_protect (call_process_cleanup,
415 Fcons (make_number (fd[0]), make_number (pid)));
7e6c2178 416#endif /* not MSDOS */
80856e74
JB
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;
0ad477db 427 int first = 1;
80856e74
JB
428
429 while ((nread = read (fd[0], buf, sizeof buf)) > 0)
430 {
431 immediate_quit = 0;
012c6fcb 432 if (!NILP (buffer))
80856e74 433 insert (buf, nread);
012c6fcb 434 if (!NILP (display) && INTERACTIVE)
0ad477db
RS
435 {
436 if (first)
437 prepare_menu_bars ();
438 first = 0;
439 redisplay_preserve_echo_area ();
440 }
80856e74
JB
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
37d54121
RS
453 /* Don't kill any children that the subprocess may have left behind
454 when exiting. */
455 call_process_exited = 1;
456
80856e74
JB
457 unbind_to (count, Qnil);
458
80856e74
JB
459 if (synch_process_death)
460 return build_string (synch_process_death);
461 return make_number (synch_process_retcode);
462}
463#endif
464\f
9fefd2ba 465static Lisp_Object
80856e74
JB
466delete_temp_file (name)
467 Lisp_Object name;
468{
469 unlink (XSTRING (name)->data);
470}
471
472DEFUN ("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\
475Delete the text if fourth arg DELETE is non-nil.\n\
476Insert 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\
478Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
479Remaining args are passed to PROGRAM at startup as command args.\n\
480If BUFFER is nil, returns immediately with value nil.\n\
481Otherwise waits for PROGRAM to terminate\n\
e576cab4 482and returns a numeric exit status or a signal description string.\n\
d177f194 483If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
80856e74
JB
484 (nargs, args)
485 int nargs;
486 register Lisp_Object *args;
487{
488 register Lisp_Object filename_string, start, end;
7e6c2178
RS
489#ifdef MSDOS
490 char *tempfile;
491#else
80856e74 492 char tempfile[20];
7e6c2178 493#endif
80856e74 494 int count = specpdl_ptr - specpdl;
7e6c2178
RS
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 */
80856e74
JB
510
511#ifdef VMS
512 strcpy (tempfile, "tmp:emacsXXXXXX.");
513#else
514 strcpy (tempfile, "/tmp/emacsXXXXXX");
515#endif
7e6c2178
RS
516#endif /* not MSDOS */
517
80856e74
JB
518 mktemp (tempfile);
519
520 filename_string = build_string (tempfile);
521 start = args[0];
522 end = args[1];
093650fe
RS
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
80856e74 528 Fwrite_region (start, end, filename_string, Qnil, Qlambda);
093650fe
RS
529#endif
530
80856e74
JB
531 record_unwind_protect (delete_temp_file, filename_string);
532
012c6fcb 533 if (!NILP (args[3]))
80856e74
JB
534 Fdelete_region (start, end);
535
536 args[3] = filename_string;
80856e74 537
58616e67 538 return unbind_to (count, Fcall_process (nargs - 2, args + 2));
80856e74
JB
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
e576cab4
JB
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. */
80856e74 562
e576cab4 563child_setup (in, out, err, new_argv, set_pgrp, current_dir)
80856e74
JB
564 int in, out, err;
565 register char **new_argv;
80856e74 566 int set_pgrp;
e576cab4 567 Lisp_Object current_dir;
80856e74 568{
7e6c2178
RS
569#ifdef MSDOS
570 /* The MSDOS port of gcc cannot fork, vfork, ... so we must call system
571 instead. */
572#else /* not MSDOS */
e576cab4 573 char **env;
7fcf7f05 574 char *pwd_var;
e576cab4 575
33abe2d9 576 int pid = getpid ();
80856e74 577
68d10241 578#ifdef SET_EMACS_PRIORITY
4f0b9d49
JB
579 {
580 extern int emacs_priority;
581
68d10241
RS
582 if (emacs_priority < 0)
583 nice (- emacs_priority);
4f0b9d49 584 }
5b633aeb 585#endif
80856e74
JB
586
587#ifdef subprocesses
588 /* Close Emacs's descriptors that this process should not have. */
589 close_process_descs ();
590#endif
4458cebe 591 close_load_descs ();
80856e74
JB
592
593 /* Note that use of alloca is always safe here. It's obvious for systems
594 that do not have true vfork or that have true (stack) alloca.
595 If using vfork and C_ALLOCA it is safe because that changes
596 the superior's static variables as if the superior had done alloca
597 and will be cleaned up in the usual way. */
e576cab4 598 {
7fcf7f05 599 register char *temp;
e576cab4 600 register int i;
77d78be1 601
e576cab4 602 i = XSTRING (current_dir)->size;
7fcf7f05
RS
603 pwd_var = (char *) alloca (i + 6);
604 temp = pwd_var + 4;
605 bcopy ("PWD=", pwd_var, 4);
e576cab4
JB
606 bcopy (XSTRING (current_dir)->data, temp, i);
607 if (temp[i - 1] != '/') temp[i++] = '/';
608 temp[i] = 0;
609
610 /* We can't signal an Elisp error here; we're in a vfork. Since
611 the callers check the current directory before forking, this
612 should only return an error if the directory's permissions
613 are changed between the check and this chdir, but we should
614 at least check. */
615 if (chdir (temp) < 0)
616 exit (errno);
7fcf7f05
RS
617
618 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
619 while (i > 2 && temp[i - 1] == '/')
620 temp[--i] = 0;
e576cab4 621 }
80856e74 622
80856e74
JB
623 /* Set `env' to a vector of the strings in Vprocess_environment. */
624 {
625 register Lisp_Object tem;
626 register char **new_env;
627 register int new_length;
628
629 new_length = 0;
630 for (tem = Vprocess_environment;
631 (XTYPE (tem) == Lisp_Cons
632 && XTYPE (XCONS (tem)->car) == Lisp_String);
633 tem = XCONS (tem)->cdr)
634 new_length++;
635
7fcf7f05
RS
636 /* new_length + 2 to include PWD and terminating 0. */
637 env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *));
638
639 /* If we have a PWD envvar, pass one down,
640 but with corrected value. */
641 if (getenv ("PWD"))
642 *new_env++ = pwd_var;
80856e74 643
cd9565ba 644 /* Copy the Vprocess_environment strings into new_env. */
80856e74
JB
645 for (tem = Vprocess_environment;
646 (XTYPE (tem) == Lisp_Cons
647 && XTYPE (XCONS (tem)->car) == Lisp_String);
648 tem = XCONS (tem)->cdr)
cd9565ba
RS
649 {
650 char **ep = env;
651 char *string = (char *) XSTRING (XCONS (tem)->car)->data;
652 /* See if this string duplicates any string already in the env.
653 If so, don't put it in.
654 When an env var has multiple definitions,
655 we keep the definition that comes first in process-environment. */
656 for (; ep != new_env; ep++)
657 {
658 char *p = *ep, *q = string;
659 while (1)
660 {
661 if (*q == 0)
662 /* The string is malformed; might as well drop it. */
663 goto duplicate;
664 if (*q != *p)
665 break;
666 if (*q == '=')
667 goto duplicate;
668 p++, q++;
669 }
670 }
671 *new_env++ = string;
672 duplicate: ;
673 }
80856e74
JB
674 *new_env = 0;
675 }
80856e74 676
426b37ae
JB
677 /* Make sure that in, out, and err are not actually already in
678 descriptors zero, one, or two; this could happen if Emacs is
7e6c2178 679 started with its standard in, out, or error closed, as might
426b37ae
JB
680 happen under X. */
681 in = relocate_fd (in, 3);
3e9367e7
KH
682 if (out == err)
683 err = out = relocate_fd (out, 3);
684 else
685 {
686 out = relocate_fd (out, 3);
687 err = relocate_fd (err, 3);
688 }
426b37ae 689
80856e74
JB
690 close (0);
691 close (1);
692 close (2);
693
694 dup2 (in, 0);
695 dup2 (out, 1);
696 dup2 (err, 2);
697 close (in);
698 close (out);
699 close (err);
700
fdba8590
RS
701#ifdef USG
702#ifndef SETPGRP_RELEASES_CTTY
e576cab4 703 setpgrp (); /* No arguments but equivalent in this case */
fdba8590 704#endif
e576cab4
JB
705#else
706 setpgrp (pid, pid);
707#endif /* USG */
a129418f
RS
708 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
709 EMACS_SET_TTY_PGRP (0, &pid);
80856e74
JB
710
711#ifdef vipc
712 something missing here;
713#endif /* vipc */
714
715 /* execvp does not accept an environment arg so the only way
716 to pass this environment is to set environ. Our caller
717 is responsible for restoring the ambient value of environ. */
718 environ = env;
719 execvp (new_argv[0], new_argv);
720
721 write (1, "Couldn't exec the program ", 26);
722 write (1, new_argv[0], strlen (new_argv[0]));
723 _exit (1);
7e6c2178 724#endif /* not MSDOS */
80856e74
JB
725}
726
426b37ae
JB
727/* Move the file descriptor FD so that its number is not less than MIN.
728 If the file descriptor is moved at all, the original is freed. */
729int
730relocate_fd (fd, min)
731 int fd, min;
732{
733 if (fd >= min)
734 return fd;
735 else
736 {
737 int new = dup (fd);
738 if (new == -1)
739 {
20c018a0 740 char *message1 = "Error while setting up child: ";
826c56ac 741 char *errmessage = strerror (errno);
20c018a0
JB
742 char *message2 = "\n";
743 write (2, message1, strlen (message1));
826c56ac 744 write (2, errmessage, strlen (errmessage));
20c018a0 745 write (2, message2, strlen (message2));
426b37ae
JB
746 _exit (1);
747 }
748 /* Note that we hold the original FD open while we recurse,
749 to guarantee we'll get a new FD if we need it. */
750 new = relocate_fd (new, min);
751 close (fd);
752 return new;
753 }
754}
755
012c6fcb
JA
756static int
757getenv_internal (var, varlen, value, valuelen)
758 char *var;
759 int varlen;
760 char **value;
761 int *valuelen;
762{
763 Lisp_Object scan;
764
765 for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr)
766 {
c1350752
KH
767 Lisp_Object entry;
768
769 entry = XCONS (scan)->car;
012c6fcb
JA
770 if (XTYPE (entry) == Lisp_String
771 && XSTRING (entry)->size > varlen
772 && XSTRING (entry)->data[varlen] == '='
773 && ! bcmp (XSTRING (entry)->data, var, varlen))
774 {
775 *value = (char *) XSTRING (entry)->data + (varlen + 1);
776 *valuelen = XSTRING (entry)->size - (varlen + 1);
777 return 1;
778 }
779 }
780
781 return 0;
782}
783
0ad477db 784DEFUN ("getenv", Fgetenv, Sgetenv, 1, 1, 0,
012c6fcb
JA
785 "Return the value of environment variable VAR, as a string.\n\
786VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
787This function consults the variable ``process-environment'' for its value.")
788 (var)
789 Lisp_Object var;
790{
791 char *value;
792 int valuelen;
793
794 CHECK_STRING (var, 0);
795 if (getenv_internal (XSTRING (var)->data, XSTRING (var)->size,
796 &value, &valuelen))
797 return make_string (value, valuelen);
798 else
799 return Qnil;
800}
801
802/* A version of getenv that consults process_environment, easily
e576cab4 803 callable from C. */
012c6fcb
JA
804char *
805egetenv (var)
e576cab4 806 char *var;
012c6fcb
JA
807{
808 char *value;
809 int valuelen;
810
811 if (getenv_internal (var, strlen (var), &value, &valuelen))
812 return value;
813 else
814 return 0;
815}
816
80856e74
JB
817#endif /* not VMS */
818\f
8de15d69 819/* This is run before init_cmdargs. */
7e6c2178 820
8de15d69
RS
821init_callproc_1 ()
822{
823 char *data_dir = egetenv ("EMACSDATA");
35a2f4b8
KH
824 char *doc_dir = egetenv ("EMACSDOC");
825
8de15d69 826 Vdata_directory
7e6c2178 827 = Ffile_name_as_directory (build_string (data_dir ? data_dir
8de15d69 828 : PATH_DATA));
35a2f4b8
KH
829 Vdoc_directory
830 = Ffile_name_as_directory (build_string (doc_dir ? doc_dir
831 : PATH_DOC));
9453ea7b 832
e576cab4
JB
833 /* Check the EMACSPATH environment variable, defaulting to the
834 PATH_EXEC path from paths.h. */
835 Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
80856e74
JB
836 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
837 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
8de15d69
RS
838}
839
840/* This is run after init_cmdargs, so that Vinvocation_directory is valid. */
841
842init_callproc ()
843{
844 char *data_dir = egetenv ("EMACSDATA");
845
846 register char * sh;
847 Lisp_Object tempdir;
848
093650fe 849#ifndef MSDOS
05630743 850 if (initialized && !NILP (Vinstallation_directory))
8de15d69 851 {
05630743
RS
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)))
8de15d69
RS
857 {
858 Vexec_path = nconc2 (Vexec_path, Fcons (tem, Qnil));
859 Vexec_directory = Ffile_name_as_directory (tem);
860
861 /* If we use ../lib-src, maybe use ../etc as well.
862 Do so if ../etc exists and has our DOC-... file in it. */
863 if (data_dir == 0)
864 {
05630743
RS
865 tem = Fexpand_file_name (build_string ("etc"),
866 Vinstallation_directory);
7e933683 867 Vdoc_directory = Ffile_name_as_directory (tem);
8de15d69
RS
868 }
869 }
870 }
7e933683
RS
871
872 /* Look for the files that should be in etc. We don't use
873 Vinstallation_directory, because these files are never installed
874 in /bin near the executable, and they are never in the build
875 directory when that's different from the source directory.
876
877 Instead, if these files are not in the nominal place, we try the
878 source directory. */
879 if (data_dir == 0)
880 {
881 Lisp_Object tem, tem1, newdir;
882
883 tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory);
884 tem1 = Ffile_exists_p (tem);
885 if (NILP (tem1))
886 {
887 newdir = Fexpand_file_name (build_string ("../etc/"),
888 build_string (PATH_DUMPLOADSEARCH));
889 tem = Fexpand_file_name (build_string ("GNU"), newdir);
890 tem1 = Ffile_exists_p (tem);
891 if (!NILP (tem1))
892 Vdata_directory = newdir;
893 }
894 }
093650fe 895#endif
80856e74 896
e576cab4
JB
897 tempdir = Fdirectory_file_name (Vexec_directory);
898 if (access (XSTRING (tempdir)->data, 0) < 0)
80856e74 899 {
0af6a831
RS
900 fprintf (stderr,
901 "Warning: arch-dependent data dir (%s) does not exist.\n",
902 XSTRING (Vexec_directory)->data);
80856e74
JB
903 sleep (2);
904 }
905
e576cab4
JB
906 tempdir = Fdirectory_file_name (Vdata_directory);
907 if (access (XSTRING (tempdir)->data, 0) < 0)
908 {
0af6a831
RS
909 fprintf (stderr,
910 "Warning: arch-independent data dir (%s) does not exist.\n",
911 XSTRING (Vdata_directory)->data);
e576cab4
JB
912 sleep (2);
913 }
914
80856e74
JB
915#ifdef VMS
916 Vshell_file_name = build_string ("*dcl*");
917#else
e576cab4 918 sh = (char *) getenv ("SHELL");
80856e74
JB
919 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
920#endif
9fefd2ba
JB
921}
922
923set_process_environment ()
924{
925 register char **envp;
80856e74 926
80856e74
JB
927 Vprocess_environment = Qnil;
928#ifndef CANNOT_DUMP
929 if (initialized)
930#endif
931 for (envp = environ; *envp; envp++)
932 Vprocess_environment = Fcons (build_string (*envp),
933 Vprocess_environment);
80856e74
JB
934}
935
936syms_of_callproc ()
937{
7e6c2178 938#ifdef MSDOS
093650fe
RS
939 Qbuffer_file_type = intern ("buffer-file-type");
940 staticpro (&Qbuffer_file_type);
941
942 DEFVAR_LISP ("binary-process-input", &Vbinary_process_input,
943 "*If non-nil then new subprocesses are assumed to take binary input.");
944 Vbinary_process_input = Qnil;
945
946 DEFVAR_LISP ("binary-process-output", &Vbinary_process_output,
7e6c2178 947 "*If non-nil then new subprocesses are assumed to produce binary output.");
093650fe 948 Vbinary_process_output = Qnil;
7e6c2178
RS
949#endif
950
80856e74
JB
951 DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
952 "*File name to load inferior shells from.\n\
953Initialized from the SHELL environment variable.");
954
955 DEFVAR_LISP ("exec-path", &Vexec_path,
956 "*List of directories to search programs to run in subprocesses.\n\
957Each element is a string (directory name) or nil (try default directory).");
958
959 DEFVAR_LISP ("exec-directory", &Vexec_directory,
e576cab4
JB
960 "Directory of architecture-dependent files that come with GNU Emacs,\n\
961especially executable programs intended for Emacs to invoke.");
962
963 DEFVAR_LISP ("data-directory", &Vdata_directory,
964 "Directory of architecture-independent files that come with GNU Emacs,\n\
965intended for Emacs to use.");
80856e74 966
35a2f4b8
KH
967 DEFVAR_LISP ("doc-directory", &Vdoc_directory,
968 "Directory containing the DOC file that comes with GNU Emacs.\n\
969This is usually the same as data-directory.");
970
ed61592a
JB
971 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory,
972 "For internal use by the build procedure only.\n\
973This is the name of the directory in which the build procedure installed\n\
974Emacs's info files; the default value for Info-default-directory-list\n\
975includes this.");
976 Vconfigure_info_directory = build_string (PATH_INFO);
977
80856e74 978 DEFVAR_LISP ("process-environment", &Vprocess_environment,
e576cab4
JB
979 "List of environment variables for subprocesses to inherit.\n\
980Each element should be a string of the form ENVVARNAME=VALUE.\n\
981The environment which Emacs inherits is placed in this variable\n\
982when Emacs starts.");
80856e74
JB
983
984#ifndef VMS
985 defsubr (&Scall_process);
012c6fcb 986 defsubr (&Sgetenv);
986ffb24 987#endif
e576cab4 988 defsubr (&Scall_process_region);
80856e74 989}