Restore failure returns to unexaix.c, unexcoff.c, unexcw.c
[bpt/emacs.git] / src / callproc.c
... / ...
CommitLineData
1/* Synchronous subprocess invocation for GNU Emacs.
2 Copyright (C) 1985-1988, 1993-1995, 1999-2011
3 Free Software Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software: you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation, either version 3 of the License, or
10(at your option) any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20
21#include <config.h>
22#include <signal.h>
23#include <errno.h>
24#include <stdio.h>
25#include <setjmp.h>
26#include <sys/types.h>
27#include <unistd.h>
28
29#include <sys/file.h>
30#include <fcntl.h>
31
32#ifdef WINDOWSNT
33#define NOMINMAX
34#include <windows.h>
35#include "w32.h"
36#define _P_NOWAIT 1 /* from process.h */
37#endif
38
39#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
40#include <sys/stat.h>
41#include <sys/param.h>
42#endif /* MSDOS */
43
44#include "lisp.h"
45#include "commands.h"
46#include "buffer.h"
47#include "character.h"
48#include "ccl.h"
49#include "coding.h"
50#include "composite.h"
51#include <epaths.h>
52#include "process.h"
53#include "syssignal.h"
54#include "systty.h"
55#include "blockinput.h"
56#include "frame.h"
57#include "termhooks.h"
58
59#ifdef MSDOS
60#include "msdos.h"
61#endif
62
63#ifndef USE_CRT_DLL
64extern char **environ;
65#endif
66
67#ifdef HAVE_SETPGID
68#if !defined (USG)
69#undef setpgrp
70#define setpgrp setpgid
71#endif
72#endif
73
74/* Pattern used by call-process-region to make temp files. */
75static Lisp_Object Vtemp_file_name_pattern;
76
77/* True if we are about to fork off a synchronous process or if we
78 are waiting for it. */
79int synch_process_alive;
80
81/* Nonzero => this is a string explaining death of synchronous subprocess. */
82const char *synch_process_death;
83
84/* Nonzero => this is the signal number that terminated the subprocess. */
85int synch_process_termsig;
86
87/* If synch_process_death is zero,
88 this is exit code of synchronous subprocess. */
89int synch_process_retcode;
90
91\f
92/* Clean up when exiting Fcall_process.
93 On MSDOS, delete the temporary file on any kind of termination.
94 On Unix, kill the process and any children on termination by signal. */
95
96/* Nonzero if this is termination due to exit. */
97static int call_process_exited;
98
99EXFUN (Fgetenv_internal, 2);
100
101static Lisp_Object
102call_process_kill (Lisp_Object fdpid)
103{
104 emacs_close (XFASTINT (Fcar (fdpid)));
105 EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
106 synch_process_alive = 0;
107 return Qnil;
108}
109
110Lisp_Object
111call_process_cleanup (Lisp_Object arg)
112{
113 Lisp_Object fdpid = Fcdr (arg);
114#if defined (MSDOS)
115 Lisp_Object file;
116#else
117 int pid;
118#endif
119
120 Fset_buffer (Fcar (arg));
121
122#if defined (MSDOS)
123 /* for MSDOS fdpid is really (fd . tempfile) */
124 file = Fcdr (fdpid);
125 emacs_close (XFASTINT (Fcar (fdpid)));
126 if (strcmp (SDATA (file), NULL_DEVICE) != 0)
127 unlink (SDATA (file));
128#else /* not MSDOS */
129 pid = XFASTINT (Fcdr (fdpid));
130
131 if (call_process_exited)
132 {
133 emacs_close (XFASTINT (Fcar (fdpid)));
134 return Qnil;
135 }
136
137 if (EMACS_KILLPG (pid, SIGINT) == 0)
138 {
139 int count = SPECPDL_INDEX ();
140 record_unwind_protect (call_process_kill, fdpid);
141 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
142 immediate_quit = 1;
143 QUIT;
144 wait_for_termination (pid);
145 immediate_quit = 0;
146 specpdl_ptr = specpdl + count; /* Discard the unwind protect. */
147 message1 ("Waiting for process to die...done");
148 }
149 synch_process_alive = 0;
150 emacs_close (XFASTINT (Fcar (fdpid)));
151#endif /* not MSDOS */
152 return Qnil;
153}
154
155DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
156 doc: /* Call PROGRAM synchronously in separate process.
157The remaining arguments are optional.
158The program's input comes from file INFILE (nil means `/dev/null').
159Insert output in BUFFER before point; t means current buffer;
160 nil for BUFFER means discard it; 0 means discard and don't wait.
161BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
162REAL-BUFFER says what to do with standard output, as above,
163while STDERR-FILE says what to do with standard error in the child.
164STDERR-FILE may be nil (discard standard error output),
165t (mix it with ordinary output), or a file name string.
166
167Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
168Remaining arguments are strings passed as command arguments to PROGRAM.
169
170If executable PROGRAM can't be found as an executable, `call-process'
171signals a Lisp error. `call-process' reports errors in execution of
172the program only through its return and output.
173
174If BUFFER is 0, `call-process' returns immediately with value nil.
175Otherwise it waits for PROGRAM to terminate
176and returns a numeric exit status or a signal description string.
177If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
178
179usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
180 (int nargs, register Lisp_Object *args)
181{
182 Lisp_Object infile, buffer, current_dir, path;
183 int display_p;
184 int fd[2];
185 int filefd;
186 register int pid;
187#define CALLPROC_BUFFER_SIZE_MIN (16 * 1024)
188#define CALLPROC_BUFFER_SIZE_MAX (4 * CALLPROC_BUFFER_SIZE_MIN)
189 char buf[CALLPROC_BUFFER_SIZE_MAX];
190 int bufsize = CALLPROC_BUFFER_SIZE_MIN;
191 int count = SPECPDL_INDEX ();
192
193 register const unsigned char **new_argv;
194 /* File to use for stderr in the child.
195 t means use same as standard output. */
196 Lisp_Object error_file;
197#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
198 char *outf, *tempfile;
199 int outfilefd;
200#endif
201 struct coding_system process_coding; /* coding-system of process output */
202 struct coding_system argument_coding; /* coding-system of arguments */
203 /* Set to the return value of Ffind_operation_coding_system. */
204 Lisp_Object coding_systems;
205
206 /* Qt denotes that Ffind_operation_coding_system is not yet called. */
207 coding_systems = Qt;
208
209 CHECK_STRING (args[0]);
210
211 error_file = Qt;
212
213#ifndef subprocesses
214 /* Without asynchronous processes we cannot have BUFFER == 0. */
215 if (nargs >= 3
216 && (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
217 error ("Operating system cannot handle asynchronous subprocesses");
218#endif /* subprocesses */
219
220 /* Decide the coding-system for giving arguments. */
221 {
222 Lisp_Object val, *args2;
223 int i;
224
225 /* If arguments are supplied, we may have to encode them. */
226 if (nargs >= 5)
227 {
228 int must_encode = 0;
229 Lisp_Object coding_attrs;
230
231 for (i = 4; i < nargs; i++)
232 CHECK_STRING (args[i]);
233
234 for (i = 4; i < nargs; i++)
235 if (STRING_MULTIBYTE (args[i]))
236 must_encode = 1;
237
238 if (!NILP (Vcoding_system_for_write))
239 val = Vcoding_system_for_write;
240 else if (! must_encode)
241 val = Qraw_text;
242 else
243 {
244 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
245 args2[0] = Qcall_process;
246 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
247 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
248 val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
249 }
250 val = complement_process_encoding_system (val);
251 setup_coding_system (Fcheck_coding_system (val), &argument_coding);
252 coding_attrs = CODING_ID_ATTRS (argument_coding.id);
253 if (NILP (CODING_ATTR_ASCII_COMPAT (coding_attrs)))
254 {
255 /* We should not use an ASCII incompatible coding system. */
256 val = raw_text_coding_system (val);
257 setup_coding_system (val, &argument_coding);
258 }
259 }
260 }
261
262 if (nargs >= 2 && ! NILP (args[1]))
263 {
264 infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory));
265 CHECK_STRING (infile);
266 }
267 else
268 infile = build_string (NULL_DEVICE);
269
270 if (nargs >= 3)
271 {
272 buffer = args[2];
273
274 /* If BUFFER is a list, its meaning is
275 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
276 if (CONSP (buffer))
277 {
278 if (CONSP (XCDR (buffer)))
279 {
280 Lisp_Object stderr_file;
281 stderr_file = XCAR (XCDR (buffer));
282
283 if (NILP (stderr_file) || EQ (Qt, stderr_file))
284 error_file = stderr_file;
285 else
286 error_file = Fexpand_file_name (stderr_file, Qnil);
287 }
288
289 buffer = XCAR (buffer);
290 }
291
292 if (!(EQ (buffer, Qnil)
293 || EQ (buffer, Qt)
294 || INTEGERP (buffer)))
295 {
296 Lisp_Object spec_buffer;
297 spec_buffer = buffer;
298 buffer = Fget_buffer_create (buffer);
299 /* Mention the buffer name for a better error message. */
300 if (NILP (buffer))
301 CHECK_BUFFER (spec_buffer);
302 CHECK_BUFFER (buffer);
303 }
304 }
305 else
306 buffer = Qnil;
307
308 /* Make sure that the child will be able to chdir to the current
309 buffer's current directory, or its unhandled equivalent. We
310 can't just have the child check for an error when it does the
311 chdir, since it's in a vfork.
312
313 We have to GCPRO around this because Fexpand_file_name,
314 Funhandled_file_name_directory, and Ffile_accessible_directory_p
315 might call a file name handling function. The argument list is
316 protected by the caller, so all we really have to worry about is
317 buffer. */
318 {
319 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
320
321 current_dir = BVAR (current_buffer, directory);
322
323 GCPRO4 (infile, buffer, current_dir, error_file);
324
325 current_dir = Funhandled_file_name_directory (current_dir);
326 if (NILP (current_dir))
327 /* If the file name handler says that current_dir is unreachable, use
328 a sensible default. */
329 current_dir = build_string ("~/");
330 current_dir = expand_and_dir_to_file (current_dir, Qnil);
331 current_dir = Ffile_name_as_directory (current_dir);
332
333 if (NILP (Ffile_accessible_directory_p (current_dir)))
334 report_file_error ("Setting current directory",
335 Fcons (BVAR (current_buffer, directory), Qnil));
336
337 if (STRING_MULTIBYTE (infile))
338 infile = ENCODE_FILE (infile);
339 if (STRING_MULTIBYTE (current_dir))
340 current_dir = ENCODE_FILE (current_dir);
341 if (STRINGP (error_file) && STRING_MULTIBYTE (error_file))
342 error_file = ENCODE_FILE (error_file);
343 UNGCPRO;
344 }
345
346 display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
347
348 filefd = emacs_open (SSDATA (infile), O_RDONLY, 0);
349 if (filefd < 0)
350 {
351 infile = DECODE_FILE (infile);
352 report_file_error ("Opening process input file", Fcons (infile, Qnil));
353 }
354 /* Search for program; barf if not found. */
355 {
356 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
357
358 GCPRO4 (infile, buffer, current_dir, error_file);
359 openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK));
360 UNGCPRO;
361 }
362 if (NILP (path))
363 {
364 emacs_close (filefd);
365 report_file_error ("Searching for program", Fcons (args[0], Qnil));
366 }
367
368 /* If program file name starts with /: for quoting a magic name,
369 discard that. */
370 if (SBYTES (path) > 2 && SREF (path, 0) == '/'
371 && SREF (path, 1) == ':')
372 path = Fsubstring (path, make_number (2), Qnil);
373
374 new_argv = (const unsigned char **)
375 alloca (max (2, nargs - 2) * sizeof (char *));
376 if (nargs > 4)
377 {
378 register int i;
379 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
380
381 GCPRO5 (infile, buffer, current_dir, path, error_file);
382 argument_coding.dst_multibyte = 0;
383 for (i = 4; i < nargs; i++)
384 {
385 argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
386 if (CODING_REQUIRE_ENCODING (&argument_coding))
387 /* We must encode this argument. */
388 args[i] = encode_coding_string (&argument_coding, args[i], 1);
389 }
390 UNGCPRO;
391 for (i = 4; i < nargs; i++)
392 new_argv[i - 3] = SDATA (args[i]);
393 new_argv[i - 3] = 0;
394 }
395 else
396 new_argv[1] = 0;
397 new_argv[0] = SDATA (path);
398
399#ifdef MSDOS /* MW, July 1993 */
400 if ((outf = egetenv ("TMPDIR")))
401 strcpy (tempfile = alloca (strlen (outf) + 20), outf);
402 else
403 {
404 tempfile = alloca (20);
405 *tempfile = '\0';
406 }
407 dostounix_filename (tempfile);
408 if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
409 strcat (tempfile, "/");
410 strcat (tempfile, "detmp.XXX");
411 mktemp (tempfile);
412
413 outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
414 if (outfilefd < 0)
415 {
416 emacs_close (filefd);
417 report_file_error ("Opening process output file",
418 Fcons (build_string (tempfile), Qnil));
419 }
420 fd[0] = filefd;
421 fd[1] = outfilefd;
422#endif /* MSDOS */
423
424 if (INTEGERP (buffer))
425 fd[1] = emacs_open (NULL_DEVICE, O_WRONLY, 0), fd[0] = -1;
426 else
427 {
428#ifndef MSDOS
429 errno = 0;
430 if (pipe (fd) == -1)
431 {
432 emacs_close (filefd);
433 report_file_error ("Creating process pipe", Qnil);
434 }
435#endif
436 }
437
438 {
439 /* child_setup must clobber environ in systems with true vfork.
440 Protect it from permanent change. */
441 register char **save_environ = environ;
442 register int fd1 = fd[1];
443 int fd_error = fd1;
444#ifdef HAVE_WORKING_VFORK
445 sigset_t procmask;
446 sigset_t blocked;
447 struct sigaction sigpipe_action;
448#endif
449
450#if 0 /* Some systems don't have sigblock. */
451 mask = sigblock (sigmask (SIGCHLD));
452#endif
453
454 /* Record that we're about to create a synchronous process. */
455 synch_process_alive = 1;
456
457 /* These vars record information from process termination.
458 Clear them now before process can possibly terminate,
459 to avoid timing error if process terminates soon. */
460 synch_process_death = 0;
461 synch_process_retcode = 0;
462 synch_process_termsig = 0;
463
464 if (NILP (error_file))
465 fd_error = emacs_open (NULL_DEVICE, O_WRONLY, 0);
466 else if (STRINGP (error_file))
467 {
468#ifdef DOS_NT
469 fd_error = emacs_open (SSDATA (error_file),
470 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
471 S_IREAD | S_IWRITE);
472#else /* not DOS_NT */
473 fd_error = creat (SSDATA (error_file), 0666);
474#endif /* not DOS_NT */
475 }
476
477 if (fd_error < 0)
478 {
479 emacs_close (filefd);
480 if (fd[0] != filefd)
481 emacs_close (fd[0]);
482 if (fd1 >= 0)
483 emacs_close (fd1);
484#ifdef MSDOS
485 unlink (tempfile);
486#endif
487 if (NILP (error_file))
488 error_file = build_string (NULL_DEVICE);
489 else if (STRINGP (error_file))
490 error_file = DECODE_FILE (error_file);
491 report_file_error ("Cannot redirect stderr", Fcons (error_file, Qnil));
492 }
493
494#ifdef MSDOS /* MW, July 1993 */
495 /* Note that on MSDOS `child_setup' actually returns the child process
496 exit status, not its PID, so we assign it to `synch_process_retcode'
497 below. */
498 pid = child_setup (filefd, outfilefd, fd_error, (char **) new_argv,
499 0, current_dir);
500
501 /* Record that the synchronous process exited and note its
502 termination status. */
503 synch_process_alive = 0;
504 synch_process_retcode = pid;
505 if (synch_process_retcode < 0) /* means it couldn't be exec'ed */
506 {
507 synchronize_system_messages_locale ();
508 synch_process_death = strerror (errno);
509 }
510
511 emacs_close (outfilefd);
512 if (fd_error != outfilefd)
513 emacs_close (fd_error);
514 fd1 = -1; /* No harm in closing that one! */
515 /* Since CRLF is converted to LF within `decode_coding', we can
516 always open a file with binary mode. */
517 fd[0] = emacs_open (tempfile, O_RDONLY | O_BINARY, 0);
518 if (fd[0] < 0)
519 {
520 unlink (tempfile);
521 emacs_close (filefd);
522 report_file_error ("Cannot re-open temporary file", Qnil);
523 }
524#else /* not MSDOS */
525#ifdef WINDOWSNT
526 pid = child_setup (filefd, fd1, fd_error, (char **) new_argv,
527 0, current_dir);
528#else /* not WINDOWSNT */
529
530#ifdef HAVE_WORKING_VFORK
531 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
532 this sets the parent's signal handlers as well as the child's.
533 So delay all interrupts whose handlers the child might munge,
534 and record the current handlers so they can be restored later. */
535 sigemptyset (&blocked);
536 sigaddset (&blocked, SIGPIPE);
537 sigaction (SIGPIPE, 0, &sigpipe_action);
538 sigprocmask (SIG_BLOCK, &blocked, &procmask);
539#endif
540
541 BLOCK_INPUT;
542
543 pid = vfork ();
544
545 if (pid == 0)
546 {
547 if (fd[0] >= 0)
548 emacs_close (fd[0]);
549#ifdef HAVE_SETSID
550 setsid ();
551#endif
552#if defined (USG)
553 setpgrp ();
554#else
555 setpgrp (pid, pid);
556#endif /* USG */
557
558 /* GConf causes us to ignore SIGPIPE, make sure it is restored
559 in the child. */
560 //signal (SIGPIPE, SIG_DFL);
561#ifdef HAVE_WORKING_VFORK
562 sigprocmask (SIG_SETMASK, &procmask, 0);
563#endif
564
565 child_setup (filefd, fd1, fd_error, (char **) new_argv,
566 0, current_dir);
567 }
568
569 UNBLOCK_INPUT;
570
571#ifdef HAVE_WORKING_VFORK
572 /* Restore the signal state. */
573 sigaction (SIGPIPE, &sigpipe_action, 0);
574 sigprocmask (SIG_SETMASK, &procmask, 0);
575#endif
576
577#endif /* not WINDOWSNT */
578
579 /* The MSDOS case did this already. */
580 if (fd_error >= 0)
581 emacs_close (fd_error);
582#endif /* not MSDOS */
583
584 environ = save_environ;
585
586 /* Close most of our fd's, but not fd[0]
587 since we will use that to read input from. */
588 emacs_close (filefd);
589 if (fd1 >= 0 && fd1 != fd_error)
590 emacs_close (fd1);
591 }
592
593 if (pid < 0)
594 {
595 if (fd[0] >= 0)
596 emacs_close (fd[0]);
597 report_file_error ("Doing vfork", Qnil);
598 }
599
600 if (INTEGERP (buffer))
601 {
602 if (fd[0] >= 0)
603 emacs_close (fd[0]);
604 return Qnil;
605 }
606
607 /* Enable sending signal if user quits below. */
608 call_process_exited = 0;
609
610#if defined(MSDOS)
611 /* MSDOS needs different cleanup information. */
612 record_unwind_protect (call_process_cleanup,
613 Fcons (Fcurrent_buffer (),
614 Fcons (make_number (fd[0]),
615 build_string (tempfile))));
616#else
617 record_unwind_protect (call_process_cleanup,
618 Fcons (Fcurrent_buffer (),
619 Fcons (make_number (fd[0]), make_number (pid))));
620#endif /* not MSDOS */
621
622
623 if (BUFFERP (buffer))
624 Fset_buffer (buffer);
625
626 if (NILP (buffer))
627 {
628 /* If BUFFER is nil, we must read process output once and then
629 discard it, so setup coding system but with nil. */
630 setup_coding_system (Qnil, &process_coding);
631 }
632 else
633 {
634 Lisp_Object val, *args2;
635
636 val = Qnil;
637 if (!NILP (Vcoding_system_for_read))
638 val = Vcoding_system_for_read;
639 else
640 {
641 if (EQ (coding_systems, Qt))
642 {
643 int i;
644
645 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
646 args2[0] = Qcall_process;
647 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
648 coding_systems
649 = Ffind_operation_coding_system (nargs + 1, args2);
650 }
651 if (CONSP (coding_systems))
652 val = XCAR (coding_systems);
653 else if (CONSP (Vdefault_process_coding_system))
654 val = XCAR (Vdefault_process_coding_system);
655 else
656 val = Qnil;
657 }
658 Fcheck_coding_system (val);
659 /* In unibyte mode, character code conversion should not take
660 place but EOL conversion should. So, setup raw-text or one
661 of the subsidiary according to the information just setup. */
662 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
663 && !NILP (val))
664 val = raw_text_coding_system (val);
665 setup_coding_system (val, &process_coding);
666 }
667
668 immediate_quit = 1;
669 QUIT;
670
671 {
672 register EMACS_INT nread;
673 int first = 1;
674 EMACS_INT total_read = 0;
675 int carryover = 0;
676 int display_on_the_fly = display_p;
677 struct coding_system saved_coding;
678
679 saved_coding = process_coding;
680 while (1)
681 {
682 /* Repeatedly read until we've filled as much as possible
683 of the buffer size we have. But don't read
684 less than 1024--save that for the next bufferful. */
685 nread = carryover;
686 while (nread < bufsize - 1024)
687 {
688 int this_read = emacs_read (fd[0], buf + nread,
689 bufsize - nread);
690
691 if (this_read < 0)
692 goto give_up;
693
694 if (this_read == 0)
695 {
696 process_coding.mode |= CODING_MODE_LAST_BLOCK;
697 break;
698 }
699
700 nread += this_read;
701 total_read += this_read;
702
703 if (display_on_the_fly)
704 break;
705 }
706
707 /* Now NREAD is the total amount of data in the buffer. */
708 immediate_quit = 0;
709
710 if (!NILP (buffer))
711 {
712 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
713 && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
714 insert_1_both (buf, nread, nread, 0, 1, 0);
715 else
716 { /* We have to decode the input. */
717 Lisp_Object curbuf;
718 int count1 = SPECPDL_INDEX ();
719
720 XSETBUFFER (curbuf, current_buffer);
721 /* We cannot allow after-change-functions be run
722 during decoding, because that might modify the
723 buffer, while we rely on process_coding.produced to
724 faithfully reflect inserted text until we
725 TEMP_SET_PT_BOTH below. */
726 specbind (Qinhibit_modification_hooks, Qt);
727 decode_coding_c_string (&process_coding, (unsigned char *) buf,
728 nread, curbuf);
729 unbind_to (count1, Qnil);
730 if (display_on_the_fly
731 && CODING_REQUIRE_DETECTION (&saved_coding)
732 && ! CODING_REQUIRE_DETECTION (&process_coding))
733 {
734 /* We have detected some coding system. But,
735 there's a possibility that the detection was
736 done by insufficient data. So, we give up
737 displaying on the fly. */
738 if (process_coding.produced > 0)
739 del_range_2 (process_coding.dst_pos,
740 process_coding.dst_pos_byte,
741 process_coding.dst_pos
742 + process_coding.produced_char,
743 process_coding.dst_pos_byte
744 + process_coding.produced, 0);
745 display_on_the_fly = 0;
746 process_coding = saved_coding;
747 carryover = nread;
748 /* This is to make the above condition always
749 fails in the future. */
750 saved_coding.common_flags
751 &= ~CODING_REQUIRE_DETECTION_MASK;
752 continue;
753 }
754
755 TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
756 PT_BYTE + process_coding.produced);
757 carryover = process_coding.carryover_bytes;
758 if (carryover > 0)
759 memcpy (buf, process_coding.carryover,
760 process_coding.carryover_bytes);
761 }
762 }
763
764 if (process_coding.mode & CODING_MODE_LAST_BLOCK)
765 break;
766
767 /* Make the buffer bigger as we continue to read more data,
768 but not past CALLPROC_BUFFER_SIZE_MAX. */
769 if (bufsize < CALLPROC_BUFFER_SIZE_MAX && total_read > 32 * bufsize)
770 if ((bufsize *= 2) > CALLPROC_BUFFER_SIZE_MAX)
771 bufsize = CALLPROC_BUFFER_SIZE_MAX;
772
773 if (display_p)
774 {
775 if (first)
776 prepare_menu_bars ();
777 first = 0;
778 redisplay_preserve_echo_area (1);
779 /* This variable might have been set to 0 for code
780 detection. In that case, we set it back to 1 because
781 we should have already detected a coding system. */
782 display_on_the_fly = 1;
783 }
784 immediate_quit = 1;
785 QUIT;
786 }
787 give_up: ;
788
789 Vlast_coding_system_used = CODING_ID_NAME (process_coding.id);
790 /* If the caller required, let the buffer inherit the
791 coding-system used to decode the process output. */
792 if (inherit_process_coding_system)
793 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
794 make_number (total_read));
795 }
796
797#ifndef MSDOS
798 /* Wait for it to terminate, unless it already has. */
799 wait_for_termination (pid);
800#endif
801
802 immediate_quit = 0;
803
804 /* Don't kill any children that the subprocess may have left behind
805 when exiting. */
806 call_process_exited = 1;
807
808 unbind_to (count, Qnil);
809
810 if (synch_process_termsig)
811 {
812 const char *signame;
813
814 synchronize_system_messages_locale ();
815 signame = strsignal (synch_process_termsig);
816
817 if (signame == 0)
818 signame = "unknown";
819
820 synch_process_death = signame;
821 }
822
823 if (synch_process_death)
824 return code_convert_string_norecord (build_string (synch_process_death),
825 Vlocale_coding_system, 0);
826 return make_number (synch_process_retcode);
827}
828\f
829static Lisp_Object
830delete_temp_file (Lisp_Object name)
831{
832 /* Suppress jka-compr handling, etc. */
833 int count = SPECPDL_INDEX ();
834 specbind (intern ("file-name-handler-alist"), Qnil);
835 internal_delete_file (name);
836 unbind_to (count, Qnil);
837 return Qnil;
838}
839
840DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
841 3, MANY, 0,
842 doc: /* Send text from START to END to a synchronous process running PROGRAM.
843The remaining arguments are optional.
844Delete the text if fourth arg DELETE is non-nil.
845
846Insert output in BUFFER before point; t means current buffer;
847 nil for BUFFER means discard it; 0 means discard and don't wait.
848BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
849REAL-BUFFER says what to do with standard output, as above,
850while STDERR-FILE says what to do with standard error in the child.
851STDERR-FILE may be nil (discard standard error output),
852t (mix it with ordinary output), or a file name string.
853
854Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
855Remaining args are passed to PROGRAM at startup as command args.
856
857If BUFFER is 0, `call-process-region' returns immediately with value nil.
858Otherwise it waits for PROGRAM to terminate
859and returns a numeric exit status or a signal description string.
860If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
861
862usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
863 (int nargs, register Lisp_Object *args)
864{
865 struct gcpro gcpro1;
866 Lisp_Object filename_string;
867 register Lisp_Object start, end;
868 int count = SPECPDL_INDEX ();
869 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
870 Lisp_Object coding_systems;
871 Lisp_Object val, *args2;
872 int i;
873 char *tempfile;
874 Lisp_Object tmpdir, pattern;
875
876 if (STRINGP (Vtemporary_file_directory))
877 tmpdir = Vtemporary_file_directory;
878 else
879 {
880#ifndef DOS_NT
881 if (getenv ("TMPDIR"))
882 tmpdir = build_string (getenv ("TMPDIR"));
883 else
884 tmpdir = build_string ("/tmp/");
885#else /* DOS_NT */
886 char *outf;
887 if ((outf = egetenv ("TMPDIR"))
888 || (outf = egetenv ("TMP"))
889 || (outf = egetenv ("TEMP")))
890 tmpdir = build_string (outf);
891 else
892 tmpdir = Ffile_name_as_directory (build_string ("c:/temp"));
893#endif
894 }
895
896 pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
897 tempfile = (char *) alloca (SBYTES (pattern) + 1);
898 memcpy (tempfile, SDATA (pattern), SBYTES (pattern) + 1);
899 coding_systems = Qt;
900
901#ifdef HAVE_MKSTEMP
902 {
903 int fd;
904
905 BLOCK_INPUT;
906 fd = mkstemp (tempfile);
907 UNBLOCK_INPUT;
908 if (fd == -1)
909 report_file_error ("Failed to open temporary file",
910 Fcons (Vtemp_file_name_pattern, Qnil));
911 else
912 close (fd);
913 }
914#else
915 mktemp (tempfile);
916#endif
917
918 filename_string = build_string (tempfile);
919 GCPRO1 (filename_string);
920 start = args[0];
921 end = args[1];
922 /* Decide coding-system of the contents of the temporary file. */
923 if (!NILP (Vcoding_system_for_write))
924 val = Vcoding_system_for_write;
925 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
926 val = Qraw_text;
927 else
928 {
929 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
930 args2[0] = Qcall_process_region;
931 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
932 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
933 val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
934 }
935 val = complement_process_encoding_system (val);
936
937 {
938 int count1 = SPECPDL_INDEX ();
939
940 specbind (intern ("coding-system-for-write"), val);
941 /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
942 happen to get a ".Z" suffix. */
943 specbind (intern ("file-name-handler-alist"), Qnil);
944 Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil);
945
946 unbind_to (count1, Qnil);
947 }
948
949 /* Note that Fcall_process takes care of binding
950 coding-system-for-read. */
951
952 record_unwind_protect (delete_temp_file, filename_string);
953
954 if (nargs > 3 && !NILP (args[3]))
955 Fdelete_region (start, end);
956
957 if (nargs > 3)
958 {
959 args += 2;
960 nargs -= 2;
961 }
962 else
963 {
964 args[0] = args[2];
965 nargs = 2;
966 }
967 args[1] = filename_string;
968
969 RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args)));
970}
971\f
972#ifndef WINDOWSNT
973static int relocate_fd (int fd, int minfd);
974#endif
975
976static char **
977add_env (char **env, char **new_env, char *string)
978{
979 char **ep;
980 int ok = 1;
981 if (string == NULL)
982 return new_env;
983
984 /* See if this string duplicates any string already in the env.
985 If so, don't put it in.
986 When an env var has multiple definitions,
987 we keep the definition that comes first in process-environment. */
988 for (ep = env; ok && ep != new_env; ep++)
989 {
990 char *p = *ep, *q = string;
991 while (ok)
992 {
993 if (*q != *p)
994 break;
995 if (*q == 0)
996 /* The string is a lone variable name; keep it for now, we
997 will remove it later. It is a placeholder for a
998 variable that is not to be included in the environment. */
999 break;
1000 if (*q == '=')
1001 ok = 0;
1002 p++, q++;
1003 }
1004 }
1005 if (ok)
1006 *new_env++ = string;
1007 return new_env;
1008}
1009
1010/* This is the last thing run in a newly forked inferior
1011 either synchronous or asynchronous.
1012 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
1013 Initialize inferior's priority, pgrp, connected dir and environment.
1014 then exec another program based on new_argv.
1015
1016 This function may change environ for the superior process.
1017 Therefore, the superior process must save and restore the value
1018 of environ around the vfork and the call to this function.
1019
1020 SET_PGRP is nonzero if we should put the subprocess into a separate
1021 process group.
1022
1023 CURRENT_DIR is an elisp string giving the path of the current
1024 directory the subprocess should have. Since we can't really signal
1025 a decent error from within the child, this should be verified as an
1026 executable directory by the parent. */
1027
1028int
1029child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, Lisp_Object current_dir)
1030{
1031 char **env;
1032 char *pwd_var;
1033#ifdef WINDOWSNT
1034 int cpid;
1035 HANDLE handles[3];
1036#endif /* WINDOWSNT */
1037
1038 int pid = getpid ();
1039
1040 /* Close Emacs's descriptors that this process should not have. */
1041 close_process_descs ();
1042
1043 /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
1044 we will lose if we call close_load_descs here. */
1045#ifndef DOS_NT
1046 close_load_descs ();
1047#endif
1048
1049 /* Note that use of alloca is always safe here. It's obvious for systems
1050 that do not have true vfork or that have true (stack) alloca.
1051 If using vfork and C_ALLOCA (when Emacs used to include
1052 src/alloca.c) it is safe because that changes the superior's
1053 static variables as if the superior had done alloca and will be
1054 cleaned up in the usual way. */
1055 {
1056 register char *temp;
1057 register int i;
1058
1059 i = SBYTES (current_dir);
1060#ifdef MSDOS
1061 /* MSDOS must have all environment variables malloc'ed, because
1062 low-level libc functions that launch subsidiary processes rely
1063 on that. */
1064 pwd_var = (char *) xmalloc (i + 6);
1065#else
1066 pwd_var = (char *) alloca (i + 6);
1067#endif
1068 temp = pwd_var + 4;
1069 memcpy (pwd_var, "PWD=", 4);
1070 memcpy (temp, SDATA (current_dir), i);
1071 if (!IS_DIRECTORY_SEP (temp[i - 1])) temp[i++] = DIRECTORY_SEP;
1072 temp[i] = 0;
1073
1074#ifndef DOS_NT
1075 /* We can't signal an Elisp error here; we're in a vfork. Since
1076 the callers check the current directory before forking, this
1077 should only return an error if the directory's permissions
1078 are changed between the check and this chdir, but we should
1079 at least check. */
1080 if (chdir (temp) < 0)
1081 _exit (errno);
1082#else /* DOS_NT */
1083 /* Get past the drive letter, so that d:/ is left alone. */
1084 if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
1085 {
1086 temp += 2;
1087 i -= 2;
1088 }
1089#endif /* DOS_NT */
1090
1091 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1092 while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
1093 temp[--i] = 0;
1094 }
1095
1096 /* Set `env' to a vector of the strings in the environment. */
1097 {
1098 register Lisp_Object tem;
1099 register char **new_env;
1100 char **p, **q;
1101 register int new_length;
1102 Lisp_Object display = Qnil;
1103
1104 new_length = 0;
1105
1106 for (tem = Vprocess_environment;
1107 CONSP (tem) && STRINGP (XCAR (tem));
1108 tem = XCDR (tem))
1109 {
1110 if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0
1111 && (SDATA (XCAR (tem)) [7] == '\0'
1112 || SDATA (XCAR (tem)) [7] == '='))
1113 /* DISPLAY is specified in process-environment. */
1114 display = Qt;
1115 new_length++;
1116 }
1117
1118 /* If not provided yet, use the frame's DISPLAY. */
1119 if (NILP (display))
1120 {
1121 Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
1122 if (!STRINGP (tmp) && CONSP (Vinitial_environment))
1123 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1124 tmp = Fgetenv_internal (build_string ("DISPLAY"),
1125 Vinitial_environment);
1126 if (STRINGP (tmp))
1127 {
1128 display = tmp;
1129 new_length++;
1130 }
1131 }
1132
1133 /* new_length + 2 to include PWD and terminating 0. */
1134 env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *));
1135 /* If we have a PWD envvar, pass one down,
1136 but with corrected value. */
1137 if (egetenv ("PWD"))
1138 *new_env++ = pwd_var;
1139
1140 if (STRINGP (display))
1141 {
1142 int vlen = strlen ("DISPLAY=") + strlen (SSDATA (display)) + 1;
1143 char *vdata = (char *) alloca (vlen);
1144 strcpy (vdata, "DISPLAY=");
1145 strcat (vdata, SSDATA (display));
1146 new_env = add_env (env, new_env, vdata);
1147 }
1148
1149 /* Overrides. */
1150 for (tem = Vprocess_environment;
1151 CONSP (tem) && STRINGP (XCAR (tem));
1152 tem = XCDR (tem))
1153 new_env = add_env (env, new_env, SSDATA (XCAR (tem)));
1154
1155 *new_env = 0;
1156
1157 /* Remove variable names without values. */
1158 p = q = env;
1159 while (*p != 0)
1160 {
1161 while (*q != 0 && strchr (*q, '=') == NULL)
1162 q++;
1163 *p = *q++;
1164 if (*p != 0)
1165 p++;
1166 }
1167 }
1168
1169
1170#ifdef WINDOWSNT
1171 prepare_standard_handles (in, out, err, handles);
1172 set_process_dir (SDATA (current_dir));
1173 /* Spawn the child. (See ntproc.c:Spawnve). */
1174 cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
1175 reset_standard_handles (in, out, err, handles);
1176 if (cpid == -1)
1177 /* An error occurred while trying to spawn the process. */
1178 report_file_error ("Spawning child process", Qnil);
1179 return cpid;
1180
1181#else /* not WINDOWSNT */
1182 /* Make sure that in, out, and err are not actually already in
1183 descriptors zero, one, or two; this could happen if Emacs is
1184 started with its standard in, out, or error closed, as might
1185 happen under X. */
1186 {
1187 int oin = in, oout = out;
1188
1189 /* We have to avoid relocating the same descriptor twice! */
1190
1191 in = relocate_fd (in, 3);
1192
1193 if (out == oin)
1194 out = in;
1195 else
1196 out = relocate_fd (out, 3);
1197
1198 if (err == oin)
1199 err = in;
1200 else if (err == oout)
1201 err = out;
1202 else
1203 err = relocate_fd (err, 3);
1204 }
1205
1206#ifndef MSDOS
1207 emacs_close (0);
1208 emacs_close (1);
1209 emacs_close (2);
1210
1211 dup2 (in, 0);
1212 dup2 (out, 1);
1213 dup2 (err, 2);
1214 emacs_close (in);
1215 if (out != in)
1216 emacs_close (out);
1217 if (err != in && err != out)
1218 emacs_close (err);
1219
1220#if defined(USG)
1221#ifndef SETPGRP_RELEASES_CTTY
1222 setpgrp (); /* No arguments but equivalent in this case */
1223#endif
1224#else /* not USG */
1225 setpgrp (pid, pid);
1226#endif /* not USG */
1227
1228 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1229 tcsetpgrp (0, pid);
1230
1231 /* execvp does not accept an environment arg so the only way
1232 to pass this environment is to set environ. Our caller
1233 is responsible for restoring the ambient value of environ. */
1234 environ = env;
1235 execvp (new_argv[0], new_argv);
1236
1237 emacs_write (1, "Can't exec program: ", 20);
1238 emacs_write (1, new_argv[0], strlen (new_argv[0]));
1239 emacs_write (1, "\n", 1);
1240 _exit (1);
1241
1242#else /* MSDOS */
1243 pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
1244 xfree (pwd_var);
1245 if (pid == -1)
1246 /* An error occurred while trying to run the subprocess. */
1247 report_file_error ("Spawning child process", Qnil);
1248 return pid;
1249#endif /* MSDOS */
1250#endif /* not WINDOWSNT */
1251}
1252
1253#ifndef WINDOWSNT
1254/* Move the file descriptor FD so that its number is not less than MINFD.
1255 If the file descriptor is moved at all, the original is freed. */
1256static int
1257relocate_fd (int fd, int minfd)
1258{
1259 if (fd >= minfd)
1260 return fd;
1261 else
1262 {
1263 int new;
1264#ifdef F_DUPFD
1265 new = fcntl (fd, F_DUPFD, minfd);
1266#else
1267 new = dup (fd);
1268 if (new != -1)
1269 /* Note that we hold the original FD open while we recurse,
1270 to guarantee we'll get a new FD if we need it. */
1271 new = relocate_fd (new, minfd);
1272#endif
1273 if (new == -1)
1274 {
1275 const char *message1 = "Error while setting up child: ";
1276 const char *errmessage = strerror (errno);
1277 const char *message2 = "\n";
1278 emacs_write (2, message1, strlen (message1));
1279 emacs_write (2, errmessage, strlen (errmessage));
1280 emacs_write (2, message2, strlen (message2));
1281 _exit (1);
1282 }
1283 emacs_close (fd);
1284 return new;
1285 }
1286}
1287#endif /* not WINDOWSNT */
1288
1289static int
1290getenv_internal_1 (const char *var, int varlen, char **value, int *valuelen,
1291 Lisp_Object env)
1292{
1293 for (; CONSP (env); env = XCDR (env))
1294 {
1295 Lisp_Object entry = XCAR (env);
1296 if (STRINGP (entry)
1297 && SBYTES (entry) >= varlen
1298#ifdef WINDOWSNT
1299 /* NT environment variables are case insensitive. */
1300 && ! strnicmp (SDATA (entry), var, varlen)
1301#else /* not WINDOWSNT */
1302 && ! memcmp (SDATA (entry), var, varlen)
1303#endif /* not WINDOWSNT */
1304 )
1305 {
1306 if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
1307 {
1308 *value = SSDATA (entry) + (varlen + 1);
1309 *valuelen = SBYTES (entry) - (varlen + 1);
1310 return 1;
1311 }
1312 else if (SBYTES (entry) == varlen)
1313 {
1314 /* Lone variable names in Vprocess_environment mean that
1315 variable should be removed from the environment. */
1316 *value = NULL;
1317 return 1;
1318 }
1319 }
1320 }
1321 return 0;
1322}
1323
1324static int
1325getenv_internal (const char *var, int varlen, char **value, int *valuelen,
1326 Lisp_Object frame)
1327{
1328 /* Try to find VAR in Vprocess_environment first. */
1329 if (getenv_internal_1 (var, varlen, value, valuelen,
1330 Vprocess_environment))
1331 return *value ? 1 : 0;
1332
1333 /* For DISPLAY try to get the values from the frame or the initial env. */
1334 if (strcmp (var, "DISPLAY") == 0)
1335 {
1336 Lisp_Object display
1337 = Fframe_parameter (NILP (frame) ? selected_frame : frame, Qdisplay);
1338 if (STRINGP (display))
1339 {
1340 *value = SSDATA (display);
1341 *valuelen = SBYTES (display);
1342 return 1;
1343 }
1344 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1345 if (getenv_internal_1 (var, varlen, value, valuelen,
1346 Vinitial_environment))
1347 return *value ? 1 : 0;
1348 }
1349
1350 return 0;
1351}
1352
1353DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
1354 doc: /* Get the value of environment variable VARIABLE.
1355VARIABLE should be a string. Value is nil if VARIABLE is undefined in
1356the environment. Otherwise, value is a string.
1357
1358This function searches `process-environment' for VARIABLE.
1359
1360If optional parameter ENV is a list, then search this list instead of
1361`process-environment', and return t when encountering a negative entry
1362\(an entry for a variable with no value). */)
1363 (Lisp_Object variable, Lisp_Object env)
1364{
1365 char *value;
1366 int valuelen;
1367
1368 CHECK_STRING (variable);
1369 if (CONSP (env))
1370 {
1371 if (getenv_internal_1 (SSDATA (variable), SBYTES (variable),
1372 &value, &valuelen, env))
1373 return value ? make_string (value, valuelen) : Qt;
1374 else
1375 return Qnil;
1376 }
1377 else if (getenv_internal (SSDATA (variable), SBYTES (variable),
1378 &value, &valuelen, env))
1379 return make_string (value, valuelen);
1380 else
1381 return Qnil;
1382}
1383
1384/* A version of getenv that consults the Lisp environment lists,
1385 easily callable from C. */
1386char *
1387egetenv (const char *var)
1388{
1389 char *value;
1390 int valuelen;
1391
1392 if (getenv_internal (var, strlen (var), &value, &valuelen, Qnil))
1393 return value;
1394 else
1395 return 0;
1396}
1397
1398\f
1399/* This is run before init_cmdargs. */
1400
1401void
1402init_callproc_1 (void)
1403{
1404 char *data_dir = egetenv ("EMACSDATA");
1405 char *doc_dir = egetenv ("EMACSDOC");
1406
1407 Vdata_directory
1408 = Ffile_name_as_directory (build_string (data_dir ? data_dir
1409 : PATH_DATA));
1410 Vdoc_directory
1411 = Ffile_name_as_directory (build_string (doc_dir ? doc_dir
1412 : PATH_DOC));
1413
1414 /* Check the EMACSPATH environment variable, defaulting to the
1415 PATH_EXEC path from epaths.h. */
1416 Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
1417 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
1418 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
1419}
1420
1421/* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1422
1423void
1424init_callproc (void)
1425{
1426 char *data_dir = egetenv ("EMACSDATA");
1427
1428 register char * sh;
1429 Lisp_Object tempdir;
1430
1431 if (!NILP (Vinstallation_directory))
1432 {
1433 /* Add to the path the lib-src subdir of the installation dir. */
1434 Lisp_Object tem;
1435 tem = Fexpand_file_name (build_string ("lib-src"),
1436 Vinstallation_directory);
1437#ifndef DOS_NT
1438 /* MSDOS uses wrapped binaries, so don't do this. */
1439 if (NILP (Fmember (tem, Vexec_path)))
1440 {
1441 Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
1442 Vexec_path = Fcons (tem, Vexec_path);
1443 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
1444 }
1445
1446 Vexec_directory = Ffile_name_as_directory (tem);
1447#endif /* not DOS_NT */
1448
1449 /* Maybe use ../etc as well as ../lib-src. */
1450 if (data_dir == 0)
1451 {
1452 tem = Fexpand_file_name (build_string ("etc"),
1453 Vinstallation_directory);
1454 Vdoc_directory = Ffile_name_as_directory (tem);
1455 }
1456 }
1457
1458 /* Look for the files that should be in etc. We don't use
1459 Vinstallation_directory, because these files are never installed
1460 near the executable, and they are never in the build
1461 directory when that's different from the source directory.
1462
1463 Instead, if these files are not in the nominal place, we try the
1464 source directory. */
1465 if (data_dir == 0)
1466 {
1467 Lisp_Object tem, tem1, srcdir;
1468
1469 srcdir = Fexpand_file_name (build_string ("../src/"),
1470 build_string (PATH_DUMPLOADSEARCH));
1471 tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory);
1472 tem1 = Ffile_exists_p (tem);
1473 if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1))
1474 {
1475 Lisp_Object newdir;
1476 newdir = Fexpand_file_name (build_string ("../etc/"),
1477 build_string (PATH_DUMPLOADSEARCH));
1478 tem = Fexpand_file_name (build_string ("GNU"), newdir);
1479 tem1 = Ffile_exists_p (tem);
1480 if (!NILP (tem1))
1481 Vdata_directory = newdir;
1482 }
1483 }
1484
1485#ifndef CANNOT_DUMP
1486 if (initialized)
1487#endif
1488 {
1489 tempdir = Fdirectory_file_name (Vexec_directory);
1490 if (access (SSDATA (tempdir), 0) < 0)
1491 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1492 Vexec_directory);
1493 }
1494
1495 tempdir = Fdirectory_file_name (Vdata_directory);
1496 if (access (SSDATA (tempdir), 0) < 0)
1497 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1498 Vdata_directory);
1499
1500 sh = (char *) getenv ("SHELL");
1501 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
1502
1503#ifdef DOS_NT
1504 Vshared_game_score_directory = Qnil;
1505#else
1506 Vshared_game_score_directory = build_string (PATH_GAME);
1507 if (NILP (Ffile_directory_p (Vshared_game_score_directory)))
1508 Vshared_game_score_directory = Qnil;
1509#endif
1510}
1511
1512void
1513set_initial_environment (void)
1514{
1515 register char **envp;
1516#ifdef CANNOT_DUMP
1517 Vprocess_environment = Qnil;
1518#else
1519 if (initialized)
1520#endif
1521 {
1522 for (envp = environ; *envp; envp++)
1523 Vprocess_environment = Fcons (build_string (*envp),
1524 Vprocess_environment);
1525 /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
1526 to use `delete' and friends on process-environment. */
1527 Vinitial_environment = Fcopy_sequence (Vprocess_environment);
1528 }
1529}
1530
1531void
1532syms_of_callproc (void)
1533{
1534#ifndef DOS_NT
1535 Vtemp_file_name_pattern = build_string ("emacsXXXXXX");
1536#elif defined (WINDOWSNT)
1537 Vtemp_file_name_pattern = build_string ("emXXXXXX");
1538#else
1539 Vtemp_file_name_pattern = build_string ("detmp.XXX");
1540#endif
1541 staticpro (&Vtemp_file_name_pattern);
1542
1543 DEFVAR_LISP ("shell-file-name", Vshell_file_name,
1544 doc: /* *File name to load inferior shells from.
1545Initialized from the SHELL environment variable, or to a system-dependent
1546default if SHELL is not set. */);
1547
1548 DEFVAR_LISP ("exec-path", Vexec_path,
1549 doc: /* *List of directories to search programs to run in subprocesses.
1550Each element is a string (directory name) or nil (try default directory). */);
1551
1552 DEFVAR_LISP ("exec-suffixes", Vexec_suffixes,
1553 doc: /* *List of suffixes to try to find executable file names.
1554Each element is a string. */);
1555 Vexec_suffixes = Qnil;
1556
1557 DEFVAR_LISP ("exec-directory", Vexec_directory,
1558 doc: /* Directory for executables for Emacs to invoke.
1559More generally, this includes any architecture-dependent files
1560that are built and installed from the Emacs distribution. */);
1561
1562 DEFVAR_LISP ("data-directory", Vdata_directory,
1563 doc: /* Directory of machine-independent files that come with GNU Emacs.
1564These are files intended for Emacs to use while it runs. */);
1565
1566 DEFVAR_LISP ("doc-directory", Vdoc_directory,
1567 doc: /* Directory containing the DOC file that comes with GNU Emacs.
1568This is usually the same as `data-directory'. */);
1569
1570 DEFVAR_LISP ("configure-info-directory", Vconfigure_info_directory,
1571 doc: /* For internal use by the build procedure only.
1572This is the name of the directory in which the build procedure installed
1573Emacs's info files; the default value for `Info-default-directory-list'
1574includes this. */);
1575 Vconfigure_info_directory = build_string (PATH_INFO);
1576
1577 DEFVAR_LISP ("shared-game-score-directory", Vshared_game_score_directory,
1578 doc: /* Directory of score files for games which come with GNU Emacs.
1579If this variable is nil, then Emacs is unable to use a shared directory. */);
1580#ifdef DOS_NT
1581 Vshared_game_score_directory = Qnil;
1582#else
1583 Vshared_game_score_directory = build_string (PATH_GAME);
1584#endif
1585
1586 DEFVAR_LISP ("initial-environment", Vinitial_environment,
1587 doc: /* List of environment variables inherited from the parent process.
1588Each element should be a string of the form ENVVARNAME=VALUE.
1589The elements must normally be decoded (using `locale-coding-system') for use. */);
1590 Vinitial_environment = Qnil;
1591
1592 DEFVAR_LISP ("process-environment", Vprocess_environment,
1593 doc: /* List of overridden environment variables for subprocesses to inherit.
1594Each element should be a string of the form ENVVARNAME=VALUE.
1595
1596Entries in this list take precedence to those in the frame-local
1597environments. Therefore, let-binding `process-environment' is an easy
1598way to temporarily change the value of an environment variable,
1599irrespective of where it comes from. To use `process-environment' to
1600remove an environment variable, include only its name in the list,
1601without "=VALUE".
1602
1603This variable is set to nil when Emacs starts.
1604
1605If multiple entries define the same variable, the first one always
1606takes precedence.
1607
1608Non-ASCII characters are encoded according to the initial value of
1609`locale-coding-system', i.e. the elements must normally be decoded for
1610use.
1611
1612See `setenv' and `getenv'. */);
1613 Vprocess_environment = Qnil;
1614
1615 defsubr (&Scall_process);
1616 defsubr (&Sgetenv_internal);
1617 defsubr (&Scall_process_region);
1618}