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