(fill-region-as-paragraph): if left-margin is nonzero,
[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
JB
573 char **env;
574
33abe2d9 575 int pid = getpid ();
80856e74 576
68d10241 577#ifdef SET_EMACS_PRIORITY
4f0b9d49
JB
578 {
579 extern int emacs_priority;
580
68d10241
RS
581 if (emacs_priority < 0)
582 nice (- emacs_priority);
4f0b9d49 583 }
5b633aeb 584#endif
80856e74
JB
585
586#ifdef subprocesses
587 /* Close Emacs's descriptors that this process should not have. */
588 close_process_descs ();
589#endif
4458cebe 590 close_load_descs ();
80856e74
JB
591
592 /* Note that use of alloca is always safe here. It's obvious for systems
593 that do not have true vfork or that have true (stack) alloca.
594 If using vfork and C_ALLOCA it is safe because that changes
595 the superior's static variables as if the superior had done alloca
596 and will be cleaned up in the usual way. */
e576cab4
JB
597 {
598 register unsigned char *temp;
599 register int i;
77d78be1 600
e576cab4
JB
601 i = XSTRING (current_dir)->size;
602 temp = (unsigned char *) alloca (i + 2);
603 bcopy (XSTRING (current_dir)->data, temp, i);
604 if (temp[i - 1] != '/') temp[i++] = '/';
605 temp[i] = 0;
606
607 /* We can't signal an Elisp error here; we're in a vfork. Since
608 the callers check the current directory before forking, this
609 should only return an error if the directory's permissions
610 are changed between the check and this chdir, but we should
611 at least check. */
612 if (chdir (temp) < 0)
613 exit (errno);
614 }
80856e74 615
80856e74
JB
616 /* Set `env' to a vector of the strings in Vprocess_environment. */
617 {
618 register Lisp_Object tem;
619 register char **new_env;
620 register int new_length;
621
622 new_length = 0;
623 for (tem = Vprocess_environment;
624 (XTYPE (tem) == Lisp_Cons
625 && XTYPE (XCONS (tem)->car) == Lisp_String);
626 tem = XCONS (tem)->cdr)
627 new_length++;
628
cd9565ba 629 /* new_length + 1 to include terminating 0. */
80856e74
JB
630 env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));
631
cd9565ba 632 /* Copy the Vprocess_environment strings into new_env. */
80856e74
JB
633 for (tem = Vprocess_environment;
634 (XTYPE (tem) == Lisp_Cons
635 && XTYPE (XCONS (tem)->car) == Lisp_String);
636 tem = XCONS (tem)->cdr)
cd9565ba
RS
637 {
638 char **ep = env;
639 char *string = (char *) XSTRING (XCONS (tem)->car)->data;
640 /* See if this string duplicates any string already in the env.
641 If so, don't put it in.
642 When an env var has multiple definitions,
643 we keep the definition that comes first in process-environment. */
644 for (; ep != new_env; ep++)
645 {
646 char *p = *ep, *q = string;
647 while (1)
648 {
649 if (*q == 0)
650 /* The string is malformed; might as well drop it. */
651 goto duplicate;
652 if (*q != *p)
653 break;
654 if (*q == '=')
655 goto duplicate;
656 p++, q++;
657 }
658 }
659 *new_env++ = string;
660 duplicate: ;
661 }
80856e74
JB
662 *new_env = 0;
663 }
80856e74 664
426b37ae
JB
665 /* Make sure that in, out, and err are not actually already in
666 descriptors zero, one, or two; this could happen if Emacs is
7e6c2178 667 started with its standard in, out, or error closed, as might
426b37ae
JB
668 happen under X. */
669 in = relocate_fd (in, 3);
3e9367e7
KH
670 if (out == err)
671 err = out = relocate_fd (out, 3);
672 else
673 {
674 out = relocate_fd (out, 3);
675 err = relocate_fd (err, 3);
676 }
426b37ae 677
80856e74
JB
678 close (0);
679 close (1);
680 close (2);
681
682 dup2 (in, 0);
683 dup2 (out, 1);
684 dup2 (err, 2);
685 close (in);
686 close (out);
687 close (err);
688
fdba8590
RS
689#ifdef USG
690#ifndef SETPGRP_RELEASES_CTTY
e576cab4 691 setpgrp (); /* No arguments but equivalent in this case */
fdba8590 692#endif
e576cab4
JB
693#else
694 setpgrp (pid, pid);
695#endif /* USG */
a129418f
RS
696 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
697 EMACS_SET_TTY_PGRP (0, &pid);
80856e74
JB
698
699#ifdef vipc
700 something missing here;
701#endif /* vipc */
702
703 /* execvp does not accept an environment arg so the only way
704 to pass this environment is to set environ. Our caller
705 is responsible for restoring the ambient value of environ. */
706 environ = env;
707 execvp (new_argv[0], new_argv);
708
709 write (1, "Couldn't exec the program ", 26);
710 write (1, new_argv[0], strlen (new_argv[0]));
711 _exit (1);
7e6c2178 712#endif /* not MSDOS */
80856e74
JB
713}
714
426b37ae
JB
715/* Move the file descriptor FD so that its number is not less than MIN.
716 If the file descriptor is moved at all, the original is freed. */
717int
718relocate_fd (fd, min)
719 int fd, min;
720{
721 if (fd >= min)
722 return fd;
723 else
724 {
725 int new = dup (fd);
726 if (new == -1)
727 {
20c018a0 728 char *message1 = "Error while setting up child: ";
826c56ac 729 char *errmessage = strerror (errno);
20c018a0
JB
730 char *message2 = "\n";
731 write (2, message1, strlen (message1));
826c56ac 732 write (2, errmessage, strlen (errmessage));
20c018a0 733 write (2, message2, strlen (message2));
426b37ae
JB
734 _exit (1);
735 }
736 /* Note that we hold the original FD open while we recurse,
737 to guarantee we'll get a new FD if we need it. */
738 new = relocate_fd (new, min);
739 close (fd);
740 return new;
741 }
742}
743
012c6fcb
JA
744static int
745getenv_internal (var, varlen, value, valuelen)
746 char *var;
747 int varlen;
748 char **value;
749 int *valuelen;
750{
751 Lisp_Object scan;
752
753 for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr)
754 {
c1350752
KH
755 Lisp_Object entry;
756
757 entry = XCONS (scan)->car;
012c6fcb
JA
758 if (XTYPE (entry) == Lisp_String
759 && XSTRING (entry)->size > varlen
760 && XSTRING (entry)->data[varlen] == '='
761 && ! bcmp (XSTRING (entry)->data, var, varlen))
762 {
763 *value = (char *) XSTRING (entry)->data + (varlen + 1);
764 *valuelen = XSTRING (entry)->size - (varlen + 1);
765 return 1;
766 }
767 }
768
769 return 0;
770}
771
0ad477db 772DEFUN ("getenv", Fgetenv, Sgetenv, 1, 1, 0,
012c6fcb
JA
773 "Return the value of environment variable VAR, as a string.\n\
774VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
775This function consults the variable ``process-environment'' for its value.")
776 (var)
777 Lisp_Object var;
778{
779 char *value;
780 int valuelen;
781
782 CHECK_STRING (var, 0);
783 if (getenv_internal (XSTRING (var)->data, XSTRING (var)->size,
784 &value, &valuelen))
785 return make_string (value, valuelen);
786 else
787 return Qnil;
788}
789
790/* A version of getenv that consults process_environment, easily
e576cab4 791 callable from C. */
012c6fcb
JA
792char *
793egetenv (var)
e576cab4 794 char *var;
012c6fcb
JA
795{
796 char *value;
797 int valuelen;
798
799 if (getenv_internal (var, strlen (var), &value, &valuelen))
800 return value;
801 else
802 return 0;
803}
804
80856e74
JB
805#endif /* not VMS */
806\f
8de15d69 807/* This is run before init_cmdargs. */
7e6c2178 808
8de15d69
RS
809init_callproc_1 ()
810{
811 char *data_dir = egetenv ("EMACSDATA");
35a2f4b8
KH
812 char *doc_dir = egetenv ("EMACSDOC");
813
8de15d69 814 Vdata_directory
7e6c2178 815 = Ffile_name_as_directory (build_string (data_dir ? data_dir
8de15d69 816 : PATH_DATA));
35a2f4b8
KH
817 Vdoc_directory
818 = Ffile_name_as_directory (build_string (doc_dir ? doc_dir
819 : PATH_DOC));
9453ea7b 820
e576cab4
JB
821 /* Check the EMACSPATH environment variable, defaulting to the
822 PATH_EXEC path from paths.h. */
823 Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
80856e74
JB
824 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
825 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
8de15d69
RS
826}
827
828/* This is run after init_cmdargs, so that Vinvocation_directory is valid. */
829
830init_callproc ()
831{
832 char *data_dir = egetenv ("EMACSDATA");
833
834 register char * sh;
835 Lisp_Object tempdir;
836
093650fe 837#ifndef MSDOS
05630743 838 if (initialized && !NILP (Vinstallation_directory))
8de15d69 839 {
05630743
RS
840 /* Add to the path the lib-src subdir of the installation dir. */
841 Lisp_Object tem;
842 tem = Fexpand_file_name (build_string ("lib-src"),
843 Vinstallation_directory);
844 if (NILP (Fmember (tem, Vexec_path)))
8de15d69
RS
845 {
846 Vexec_path = nconc2 (Vexec_path, Fcons (tem, Qnil));
847 Vexec_directory = Ffile_name_as_directory (tem);
848
849 /* If we use ../lib-src, maybe use ../etc as well.
850 Do so if ../etc exists and has our DOC-... file in it. */
851 if (data_dir == 0)
852 {
05630743
RS
853 tem = Fexpand_file_name (build_string ("etc"),
854 Vinstallation_directory);
7e933683 855 Vdoc_directory = Ffile_name_as_directory (tem);
8de15d69
RS
856 }
857 }
858 }
7e933683
RS
859
860 /* Look for the files that should be in etc. We don't use
861 Vinstallation_directory, because these files are never installed
862 in /bin near the executable, and they are never in the build
863 directory when that's different from the source directory.
864
865 Instead, if these files are not in the nominal place, we try the
866 source directory. */
867 if (data_dir == 0)
868 {
869 Lisp_Object tem, tem1, newdir;
870
871 tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory);
872 tem1 = Ffile_exists_p (tem);
873 if (NILP (tem1))
874 {
875 newdir = Fexpand_file_name (build_string ("../etc/"),
876 build_string (PATH_DUMPLOADSEARCH));
877 tem = Fexpand_file_name (build_string ("GNU"), newdir);
878 tem1 = Ffile_exists_p (tem);
879 if (!NILP (tem1))
880 Vdata_directory = newdir;
881 }
882 }
093650fe 883#endif
80856e74 884
e576cab4
JB
885 tempdir = Fdirectory_file_name (Vexec_directory);
886 if (access (XSTRING (tempdir)->data, 0) < 0)
80856e74 887 {
0af6a831
RS
888 fprintf (stderr,
889 "Warning: arch-dependent data dir (%s) does not exist.\n",
890 XSTRING (Vexec_directory)->data);
80856e74
JB
891 sleep (2);
892 }
893
e576cab4
JB
894 tempdir = Fdirectory_file_name (Vdata_directory);
895 if (access (XSTRING (tempdir)->data, 0) < 0)
896 {
0af6a831
RS
897 fprintf (stderr,
898 "Warning: arch-independent data dir (%s) does not exist.\n",
899 XSTRING (Vdata_directory)->data);
e576cab4
JB
900 sleep (2);
901 }
902
80856e74
JB
903#ifdef VMS
904 Vshell_file_name = build_string ("*dcl*");
905#else
e576cab4 906 sh = (char *) getenv ("SHELL");
80856e74
JB
907 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
908#endif
9fefd2ba
JB
909}
910
911set_process_environment ()
912{
913 register char **envp;
80856e74 914
80856e74
JB
915 Vprocess_environment = Qnil;
916#ifndef CANNOT_DUMP
917 if (initialized)
918#endif
919 for (envp = environ; *envp; envp++)
920 Vprocess_environment = Fcons (build_string (*envp),
921 Vprocess_environment);
80856e74
JB
922}
923
924syms_of_callproc ()
925{
7e6c2178 926#ifdef MSDOS
093650fe
RS
927 Qbuffer_file_type = intern ("buffer-file-type");
928 staticpro (&Qbuffer_file_type);
929
930 DEFVAR_LISP ("binary-process-input", &Vbinary_process_input,
931 "*If non-nil then new subprocesses are assumed to take binary input.");
932 Vbinary_process_input = Qnil;
933
934 DEFVAR_LISP ("binary-process-output", &Vbinary_process_output,
7e6c2178 935 "*If non-nil then new subprocesses are assumed to produce binary output.");
093650fe 936 Vbinary_process_output = Qnil;
7e6c2178
RS
937#endif
938
80856e74
JB
939 DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
940 "*File name to load inferior shells from.\n\
941Initialized from the SHELL environment variable.");
942
943 DEFVAR_LISP ("exec-path", &Vexec_path,
944 "*List of directories to search programs to run in subprocesses.\n\
945Each element is a string (directory name) or nil (try default directory).");
946
947 DEFVAR_LISP ("exec-directory", &Vexec_directory,
e576cab4
JB
948 "Directory of architecture-dependent files that come with GNU Emacs,\n\
949especially executable programs intended for Emacs to invoke.");
950
951 DEFVAR_LISP ("data-directory", &Vdata_directory,
952 "Directory of architecture-independent files that come with GNU Emacs,\n\
953intended for Emacs to use.");
80856e74 954
35a2f4b8
KH
955 DEFVAR_LISP ("doc-directory", &Vdoc_directory,
956 "Directory containing the DOC file that comes with GNU Emacs.\n\
957This is usually the same as data-directory.");
958
ed61592a
JB
959 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory,
960 "For internal use by the build procedure only.\n\
961This is the name of the directory in which the build procedure installed\n\
962Emacs's info files; the default value for Info-default-directory-list\n\
963includes this.");
964 Vconfigure_info_directory = build_string (PATH_INFO);
965
80856e74 966 DEFVAR_LISP ("process-environment", &Vprocess_environment,
e576cab4
JB
967 "List of environment variables for subprocesses to inherit.\n\
968Each element should be a string of the form ENVVARNAME=VALUE.\n\
969The environment which Emacs inherits is placed in this variable\n\
970when Emacs starts.");
80856e74
JB
971
972#ifndef VMS
973 defsubr (&Scall_process);
012c6fcb 974 defsubr (&Sgetenv);
986ffb24 975#endif
e576cab4 976 defsubr (&Scall_process_region);
80856e74 977}