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