Reworked.
[emacs/old-mirror.git] / src / callproc.c
blob9f90e9d75379c92c2172927e35fe7f38694b8aad
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 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
23 #include <config.h>
24 #include <signal.h>
25 #include <errno.h>
26 #include <stdio.h>
28 #ifndef USE_CRT_DLL
29 extern int errno;
30 #endif
32 /* Define SIGCHLD as an alias for SIGCLD. */
34 #if !defined (SIGCHLD) && defined (SIGCLD)
35 #define SIGCHLD SIGCLD
36 #endif /* SIGCLD */
38 #include <sys/types.h>
40 #ifdef HAVE_UNISTD_H
41 #include <unistd.h>
42 #endif
44 #include <sys/file.h>
45 #ifdef HAVE_FCNTL_H
46 #define INCLUDED_FCNTL
47 #include <fcntl.h>
48 #endif
50 #ifdef WINDOWSNT
51 #define NOMINMAX
52 #include <windows.h>
53 #include <stdlib.h> /* for proper declaration of environ */
54 #include <fcntl.h>
55 #include "w32.h"
56 #define _P_NOWAIT 1 /* from process.h */
57 #endif
59 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
60 #define INCLUDED_FCNTL
61 #include <fcntl.h>
62 #include <sys/stat.h>
63 #include <sys/param.h>
64 #include <errno.h>
65 #endif /* MSDOS */
67 #ifndef O_RDONLY
68 #define O_RDONLY 0
69 #endif
71 #ifndef O_WRONLY
72 #define O_WRONLY 1
73 #endif
75 #include "lisp.h"
76 #include "commands.h"
77 #include "buffer.h"
78 #include "charset.h"
79 #include "ccl.h"
80 #include "coding.h"
81 #include "composite.h"
82 #include <epaths.h>
83 #include "process.h"
84 #include "syssignal.h"
85 #include "systty.h"
86 #include "blockinput.h"
88 #ifdef MSDOS
89 #include "msdos.h"
90 #endif
92 #ifdef VMS
93 extern noshare char **environ;
94 #else
95 #ifndef USE_CRT_DLL
96 extern char **environ;
97 #endif
98 #endif
100 #ifdef HAVE_SETPGID
101 #if !defined (USG) || defined (BSD_PGRPS)
102 #undef setpgrp
103 #define setpgrp setpgid
104 #endif
105 #endif
107 Lisp_Object Vexec_path, Vexec_directory, Vexec_suffixes;
108 Lisp_Object Vdata_directory, Vdoc_directory;
109 Lisp_Object Vconfigure_info_directory, Vshared_game_score_directory;
110 Lisp_Object Vtemp_file_name_pattern;
112 Lisp_Object Vshell_file_name;
114 Lisp_Object Vprocess_environment;
116 #ifdef DOS_NT
117 Lisp_Object Qbuffer_file_type;
118 #endif /* DOS_NT */
120 /* True iff we are about to fork off a synchronous process or if we
121 are waiting for it. */
122 int synch_process_alive;
124 /* Nonzero => this is a string explaining death of synchronous subprocess. */
125 char *synch_process_death;
127 /* Nonzero => this is the signal number that terminated the subprocess. */
128 int synch_process_termsig;
130 /* If synch_process_death is zero,
131 this is exit code of synchronous subprocess. */
132 int synch_process_retcode;
134 /* Clean up when exiting Fcall_process.
135 On MSDOS, delete the temporary file on any kind of termination.
136 On Unix, kill the process and any children on termination by signal. */
138 /* Nonzero if this is termination due to exit. */
139 static int call_process_exited;
141 #ifndef VMS /* VMS version is in vmsproc.c. */
143 static Lisp_Object
144 call_process_kill (fdpid)
145 Lisp_Object fdpid;
147 emacs_close (XFASTINT (Fcar (fdpid)));
148 EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
149 synch_process_alive = 0;
150 return Qnil;
153 Lisp_Object
154 call_process_cleanup (fdpid)
155 Lisp_Object fdpid;
157 #if defined (MSDOS) || defined (MAC_OS8)
158 /* for MSDOS fdpid is really (fd . tempfile) */
159 register Lisp_Object file;
160 file = Fcdr (fdpid);
161 emacs_close (XFASTINT (Fcar (fdpid)));
162 if (strcmp (SDATA (file), NULL_DEVICE) != 0)
163 unlink (SDATA (file));
164 #else /* not MSDOS and not MAC_OS8 */
165 register int pid = XFASTINT (Fcdr (fdpid));
167 if (call_process_exited)
169 emacs_close (XFASTINT (Fcar (fdpid)));
170 return Qnil;
173 if (EMACS_KILLPG (pid, SIGINT) == 0)
175 int count = SPECPDL_INDEX ();
176 record_unwind_protect (call_process_kill, fdpid);
177 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
178 immediate_quit = 1;
179 QUIT;
180 wait_for_termination (pid);
181 immediate_quit = 0;
182 specpdl_ptr = specpdl + count; /* Discard the unwind protect. */
183 message1 ("Waiting for process to die...done");
185 synch_process_alive = 0;
186 emacs_close (XFASTINT (Fcar (fdpid)));
187 #endif /* not MSDOS */
188 return Qnil;
191 DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
192 doc: /* Call PROGRAM synchronously in separate process.
193 The remaining arguments are optional.
194 The program's input comes from file INFILE (nil means `/dev/null').
195 Insert output in BUFFER before point; t means current buffer;
196 nil for BUFFER means discard it; 0 means discard and don't wait.
197 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
198 REAL-BUFFER says what to do with standard output, as above,
199 while STDERR-FILE says what to do with standard error in the child.
200 STDERR-FILE may be nil (discard standard error output),
201 t (mix it with ordinary output), or a file name string.
203 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
204 Remaining arguments are strings passed as command arguments to PROGRAM.
206 If BUFFER is 0, `call-process' returns immediately with value nil.
207 Otherwise it waits for PROGRAM to terminate
208 and returns a numeric exit status or a signal description string.
209 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
211 usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
212 (nargs, args)
213 int nargs;
214 register Lisp_Object *args;
216 Lisp_Object infile, buffer, current_dir, path;
217 int display_p;
218 int fd[2];
219 int filefd;
220 register int pid;
221 #define CALLPROC_BUFFER_SIZE_MIN (16 * 1024)
222 #define CALLPROC_BUFFER_SIZE_MAX (4 * CALLPROC_BUFFER_SIZE_MIN)
223 char buf[CALLPROC_BUFFER_SIZE_MAX];
224 int bufsize = CALLPROC_BUFFER_SIZE_MIN;
225 int count = SPECPDL_INDEX ();
227 register const unsigned char **new_argv
228 = (const unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
229 struct buffer *old = current_buffer;
230 /* File to use for stderr in the child.
231 t means use same as standard output. */
232 Lisp_Object error_file;
233 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
234 char *outf, *tempfile;
235 int outfilefd;
236 #endif
237 #ifdef MAC_OS8
238 char *tempfile;
239 int outfilefd;
240 #endif
241 #if 0
242 int mask;
243 #endif
244 struct coding_system process_coding; /* coding-system of process output */
245 struct coding_system argument_coding; /* coding-system of arguments */
246 /* Set to the return value of Ffind_operation_coding_system. */
247 Lisp_Object coding_systems;
249 /* Qt denotes that Ffind_operation_coding_system is not yet called. */
250 coding_systems = Qt;
252 CHECK_STRING (args[0]);
254 error_file = Qt;
256 #ifndef subprocesses
257 /* Without asynchronous processes we cannot have BUFFER == 0. */
258 if (nargs >= 3
259 && (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
260 error ("Operating system cannot handle asynchronous subprocesses");
261 #endif /* subprocesses */
263 /* Decide the coding-system for giving arguments. */
265 Lisp_Object val, *args2;
266 int i;
268 /* If arguments are supplied, we may have to encode them. */
269 if (nargs >= 5)
271 int must_encode = 0;
273 for (i = 4; i < nargs; i++)
274 CHECK_STRING (args[i]);
276 for (i = 4; i < nargs; i++)
277 if (STRING_MULTIBYTE (args[i]))
278 must_encode = 1;
280 if (!NILP (Vcoding_system_for_write))
281 val = Vcoding_system_for_write;
282 else if (! must_encode)
283 val = Qnil;
284 else
286 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
287 args2[0] = Qcall_process;
288 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
289 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
290 if (CONSP (coding_systems))
291 val = XCDR (coding_systems);
292 else if (CONSP (Vdefault_process_coding_system))
293 val = XCDR (Vdefault_process_coding_system);
294 else
295 val = Qnil;
297 setup_coding_system (Fcheck_coding_system (val), &argument_coding);
301 if (nargs >= 2 && ! NILP (args[1]))
303 infile = Fexpand_file_name (args[1], current_buffer->directory);
304 CHECK_STRING (infile);
306 else
307 infile = build_string (NULL_DEVICE);
309 if (nargs >= 3)
311 buffer = args[2];
313 /* If BUFFER is a list, its meaning is
314 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
315 if (CONSP (buffer))
317 if (CONSP (XCDR (buffer)))
319 Lisp_Object stderr_file;
320 stderr_file = XCAR (XCDR (buffer));
322 if (NILP (stderr_file) || EQ (Qt, stderr_file))
323 error_file = stderr_file;
324 else
325 error_file = Fexpand_file_name (stderr_file, Qnil);
328 buffer = XCAR (buffer);
331 if (!(EQ (buffer, Qnil)
332 || EQ (buffer, Qt)
333 || INTEGERP (buffer)))
335 Lisp_Object spec_buffer;
336 spec_buffer = buffer;
337 buffer = Fget_buffer_create (buffer);
338 /* Mention the buffer name for a better error message. */
339 if (NILP (buffer))
340 CHECK_BUFFER (spec_buffer);
341 CHECK_BUFFER (buffer);
344 else
345 buffer = Qnil;
347 /* Make sure that the child will be able to chdir to the current
348 buffer's current directory, or its unhandled equivalent. We
349 can't just have the child check for an error when it does the
350 chdir, since it's in a vfork.
352 We have to GCPRO around this because Fexpand_file_name,
353 Funhandled_file_name_directory, and Ffile_accessible_directory_p
354 might call a file name handling function. The argument list is
355 protected by the caller, so all we really have to worry about is
356 buffer. */
358 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
360 current_dir = current_buffer->directory;
362 GCPRO4 (infile, buffer, current_dir, error_file);
364 current_dir
365 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
366 Qnil);
367 if (NILP (Ffile_accessible_directory_p (current_dir)))
368 report_file_error ("Setting current directory",
369 Fcons (current_buffer->directory, Qnil));
371 if (STRING_MULTIBYTE (infile))
372 infile = ENCODE_FILE (infile);
373 if (STRING_MULTIBYTE (current_dir))
374 current_dir = ENCODE_FILE (current_dir);
375 if (STRINGP (error_file) && STRING_MULTIBYTE (error_file))
376 error_file = ENCODE_FILE (error_file);
377 UNGCPRO;
380 display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
382 filefd = emacs_open (SDATA (infile), O_RDONLY, 0);
383 if (filefd < 0)
385 infile = DECODE_FILE (infile);
386 report_file_error ("Opening process input file", Fcons (infile, Qnil));
388 /* Search for program; barf if not found. */
390 struct gcpro gcpro1;
392 GCPRO1 (current_dir);
393 openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK));
394 UNGCPRO;
396 if (NILP (path))
398 emacs_close (filefd);
399 report_file_error ("Searching for program", Fcons (args[0], Qnil));
402 /* If program file name starts with /: for quoting a magic name,
403 discard that. */
404 if (SBYTES (path) > 2 && SREF (path, 0) == '/'
405 && SREF (path, 1) == ':')
406 path = Fsubstring (path, make_number (2), Qnil);
408 new_argv[0] = SDATA (path);
409 if (nargs > 4)
411 register int i;
412 struct gcpro gcpro1, gcpro2, gcpro3;
414 GCPRO3 (infile, buffer, current_dir);
415 argument_coding.dst_multibyte = 0;
416 for (i = 4; i < nargs; i++)
418 argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
419 if (CODING_REQUIRE_ENCODING (&argument_coding))
421 /* We must encode this argument. */
422 args[i] = encode_coding_string (args[i], &argument_coding, 1);
423 if (argument_coding.type == coding_type_ccl)
424 setup_ccl_program (&(argument_coding.spec.ccl.encoder), Qnil);
426 new_argv[i - 3] = SDATA (args[i]);
428 UNGCPRO;
429 new_argv[nargs - 3] = 0;
431 else
432 new_argv[1] = 0;
434 #ifdef MSDOS /* MW, July 1993 */
435 if ((outf = egetenv ("TMPDIR")))
436 strcpy (tempfile = alloca (strlen (outf) + 20), outf);
437 else
439 tempfile = alloca (20);
440 *tempfile = '\0';
442 dostounix_filename (tempfile);
443 if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
444 strcat (tempfile, "/");
445 strcat (tempfile, "detmp.XXX");
446 mktemp (tempfile);
448 outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
449 if (outfilefd < 0)
451 emacs_close (filefd);
452 report_file_error ("Opening process output file",
453 Fcons (build_string (tempfile), Qnil));
455 fd[0] = filefd;
456 fd[1] = outfilefd;
457 #endif /* MSDOS */
459 #ifdef MAC_OS8
460 /* Since we don't have pipes on the Mac, create a temporary file to
461 hold the output of the subprocess. */
462 tempfile = (char *) alloca (SBYTES (Vtemp_file_name_pattern) + 1);
463 bcopy (SDATA (Vtemp_file_name_pattern), tempfile,
464 SBYTES (Vtemp_file_name_pattern) + 1);
466 mktemp (tempfile);
468 outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
469 if (outfilefd < 0)
471 close (filefd);
472 report_file_error ("Opening process output file",
473 Fcons (build_string (tempfile), Qnil));
475 fd[0] = filefd;
476 fd[1] = outfilefd;
477 #endif /* MAC_OS8 */
479 if (INTEGERP (buffer))
480 fd[1] = emacs_open (NULL_DEVICE, O_WRONLY, 0), fd[0] = -1;
481 else
483 #ifndef MSDOS
484 #ifndef MAC_OS8
485 errno = 0;
486 if (pipe (fd) == -1)
488 emacs_close (filefd);
489 report_file_error ("Creating process pipe", Qnil);
491 #endif
492 #endif
493 #if 0
494 /* Replaced by close_process_descs */
495 set_exclusive_use (fd[0]);
496 #endif
500 /* child_setup must clobber environ in systems with true vfork.
501 Protect it from permanent change. */
502 register char **save_environ = environ;
503 register int fd1 = fd[1];
504 int fd_error = fd1;
506 #if 0 /* Some systems don't have sigblock. */
507 mask = sigblock (sigmask (SIGCHLD));
508 #endif
510 /* Record that we're about to create a synchronous process. */
511 synch_process_alive = 1;
513 /* These vars record information from process termination.
514 Clear them now before process can possibly terminate,
515 to avoid timing error if process terminates soon. */
516 synch_process_death = 0;
517 synch_process_retcode = 0;
518 synch_process_termsig = 0;
520 if (NILP (error_file))
521 fd_error = emacs_open (NULL_DEVICE, O_WRONLY, 0);
522 else if (STRINGP (error_file))
524 #ifdef DOS_NT
525 fd_error = emacs_open (SDATA (error_file),
526 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
527 S_IREAD | S_IWRITE);
528 #else /* not DOS_NT */
529 fd_error = creat (SDATA (error_file), 0666);
530 #endif /* not DOS_NT */
533 if (fd_error < 0)
535 emacs_close (filefd);
536 if (fd[0] != filefd)
537 emacs_close (fd[0]);
538 if (fd1 >= 0)
539 emacs_close (fd1);
540 #ifdef MSDOS
541 unlink (tempfile);
542 #endif
543 if (NILP (error_file))
544 error_file = build_string (NULL_DEVICE);
545 else if (STRINGP (error_file))
546 error_file = DECODE_FILE (error_file);
547 report_file_error ("Cannot redirect stderr", Fcons (error_file, Qnil));
550 #ifdef MAC_OS8
552 /* Call run_mac_command in sysdep.c here directly instead of doing
553 a child_setup as for MSDOS and other platforms. Note that this
554 code does not handle passing the environment to the synchronous
555 Mac subprocess. */
556 char *infn, *outfn, *errfn, *currdn;
558 /* close these files so subprocess can write to them */
559 close (outfilefd);
560 if (fd_error != outfilefd)
561 close (fd_error);
562 fd1 = -1; /* No harm in closing that one! */
564 infn = SDATA (infile);
565 outfn = tempfile;
566 if (NILP (error_file))
567 errfn = NULL_DEVICE;
568 else if (EQ (Qt, error_file))
569 errfn = outfn;
570 else
571 errfn = SDATA (error_file);
572 currdn = SDATA (current_dir);
573 pid = run_mac_command (new_argv, currdn, infn, outfn, errfn);
575 /* Record that the synchronous process exited and note its
576 termination status. */
577 synch_process_alive = 0;
578 synch_process_retcode = pid;
579 if (synch_process_retcode < 0) /* means it couldn't be exec'ed */
581 synchronize_system_messages_locale ();
582 synch_process_death = strerror (errno);
585 /* Since CRLF is converted to LF within `decode_coding', we can
586 always open a file with binary mode. */
587 fd[0] = open (tempfile, O_BINARY);
588 if (fd[0] < 0)
590 unlink (tempfile);
591 close (filefd);
592 report_file_error ("Cannot re-open temporary file", Qnil);
595 #else /* not MAC_OS8 */
596 #ifdef MSDOS /* MW, July 1993 */
597 /* Note that on MSDOS `child_setup' actually returns the child process
598 exit status, not its PID, so we assign it to `synch_process_retcode'
599 below. */
600 pid = child_setup (filefd, outfilefd, fd_error, (char **) new_argv,
601 0, current_dir);
603 /* Record that the synchronous process exited and note its
604 termination status. */
605 synch_process_alive = 0;
606 synch_process_retcode = pid;
607 if (synch_process_retcode < 0) /* means it couldn't be exec'ed */
609 synchronize_system_messages_locale ();
610 synch_process_death = strerror (errno);
613 emacs_close (outfilefd);
614 if (fd_error != outfilefd)
615 emacs_close (fd_error);
616 fd1 = -1; /* No harm in closing that one! */
617 /* Since CRLF is converted to LF within `decode_coding', we can
618 always open a file with binary mode. */
619 fd[0] = emacs_open (tempfile, O_RDONLY | O_BINARY, 0);
620 if (fd[0] < 0)
622 unlink (tempfile);
623 emacs_close (filefd);
624 report_file_error ("Cannot re-open temporary file", Qnil);
626 #else /* not MSDOS */
627 #ifdef WINDOWSNT
628 pid = child_setup (filefd, fd1, fd_error, (char **) new_argv,
629 0, current_dir);
630 #else /* not WINDOWSNT */
631 BLOCK_INPUT;
633 pid = vfork ();
635 if (pid == 0)
637 if (fd[0] >= 0)
638 emacs_close (fd[0]);
639 #ifdef HAVE_SETSID
640 setsid ();
641 #endif
642 #if defined (USG) && !defined (BSD_PGRPS)
643 setpgrp ();
644 #else
645 setpgrp (pid, pid);
646 #endif /* USG */
647 child_setup (filefd, fd1, fd_error, (char **) new_argv,
648 0, current_dir);
651 UNBLOCK_INPUT;
652 #endif /* not WINDOWSNT */
654 /* The MSDOS case did this already. */
655 if (fd_error >= 0)
656 emacs_close (fd_error);
657 #endif /* not MSDOS */
658 #endif /* not MAC_OS8 */
660 environ = save_environ;
662 /* Close most of our fd's, but not fd[0]
663 since we will use that to read input from. */
664 emacs_close (filefd);
665 if (fd1 >= 0 && fd1 != fd_error)
666 emacs_close (fd1);
669 if (pid < 0)
671 if (fd[0] >= 0)
672 emacs_close (fd[0]);
673 report_file_error ("Doing vfork", Qnil);
676 if (INTEGERP (buffer))
678 if (fd[0] >= 0)
679 emacs_close (fd[0]);
680 #ifndef subprocesses
681 /* If Emacs has been built with asynchronous subprocess support,
682 we don't need to do this, I think because it will then have
683 the facilities for handling SIGCHLD. */
684 wait_without_blocking ();
685 #endif /* subprocesses */
686 return Qnil;
689 /* Enable sending signal if user quits below. */
690 call_process_exited = 0;
692 #if defined(MSDOS) || defined(MAC_OS8)
693 /* MSDOS needs different cleanup information. */
694 record_unwind_protect (call_process_cleanup,
695 Fcons (make_number (fd[0]), build_string (tempfile)));
696 #else
697 record_unwind_protect (call_process_cleanup,
698 Fcons (make_number (fd[0]), make_number (pid)));
699 #endif /* not MSDOS and not MAC_OS8 */
702 if (BUFFERP (buffer))
703 Fset_buffer (buffer);
705 if (NILP (buffer))
707 /* If BUFFER is nil, we must read process output once and then
708 discard it, so setup coding system but with nil. */
709 setup_coding_system (Qnil, &process_coding);
711 else
713 Lisp_Object val, *args2;
715 val = Qnil;
716 if (!NILP (Vcoding_system_for_read))
717 val = Vcoding_system_for_read;
718 else
720 if (EQ (coding_systems, Qt))
722 int i;
724 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
725 args2[0] = Qcall_process;
726 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
727 coding_systems
728 = Ffind_operation_coding_system (nargs + 1, args2);
730 if (CONSP (coding_systems))
731 val = XCAR (coding_systems);
732 else if (CONSP (Vdefault_process_coding_system))
733 val = XCAR (Vdefault_process_coding_system);
734 else
735 val = Qnil;
737 setup_coding_system (Fcheck_coding_system (val), &process_coding);
738 /* In unibyte mode, character code conversion should not take
739 place but EOL conversion should. So, setup raw-text or one
740 of the subsidiary according to the information just setup. */
741 if (NILP (current_buffer->enable_multibyte_characters)
742 && !NILP (val))
743 setup_raw_text_coding_system (&process_coding);
745 process_coding.src_multibyte = 0;
746 process_coding.dst_multibyte
747 = (BUFFERP (buffer)
748 ? ! NILP (XBUFFER (buffer)->enable_multibyte_characters)
749 : ! NILP (current_buffer->enable_multibyte_characters));
751 immediate_quit = 1;
752 QUIT;
755 register int nread;
756 int first = 1;
757 int total_read = 0;
758 int carryover = 0;
759 int display_on_the_fly = display_p;
760 struct coding_system saved_coding;
761 int pt_orig = PT, pt_byte_orig = PT_BYTE;
762 int inserted;
764 saved_coding = process_coding;
765 if (process_coding.composing != COMPOSITION_DISABLED)
766 coding_allocate_composition_data (&process_coding, PT);
767 while (1)
769 /* Repeatedly read until we've filled as much as possible
770 of the buffer size we have. But don't read
771 less than 1024--save that for the next bufferful. */
772 nread = carryover;
773 while (nread < bufsize - 1024)
775 int this_read = emacs_read (fd[0], buf + nread,
776 bufsize - nread);
778 if (this_read < 0)
779 goto give_up;
781 if (this_read == 0)
783 process_coding.mode |= CODING_MODE_LAST_BLOCK;
784 break;
787 nread += this_read;
788 total_read += this_read;
790 if (display_on_the_fly)
791 break;
794 /* Now NREAD is the total amount of data in the buffer. */
795 immediate_quit = 0;
797 if (!NILP (buffer))
799 if (! CODING_MAY_REQUIRE_DECODING (&process_coding))
800 insert_1_both (buf, nread, nread, 0, 1, 0);
801 else
802 { /* We have to decode the input. */
803 int size;
804 char *decoding_buf;
806 repeat_decoding:
807 size = decoding_buffer_size (&process_coding, nread);
808 decoding_buf = (char *) xmalloc (size);
810 /* We can't use the macro CODING_REQUIRE_DETECTION
811 because it always returns nonzero if the coding
812 system requires EOL detection. Here, we have to
813 check only whether or not the coding system
814 requires text-encoding detection. */
815 if (process_coding.type == coding_type_undecided)
817 detect_coding (&process_coding, buf, nread);
818 if (process_coding.composing != COMPOSITION_DISABLED)
819 /* We have not yet allocated the composition
820 data because the coding type was undecided. */
821 coding_allocate_composition_data (&process_coding, PT);
823 if (process_coding.cmp_data)
824 process_coding.cmp_data->char_offset = PT;
826 decode_coding (&process_coding, buf, decoding_buf,
827 nread, size);
829 if (display_on_the_fly
830 && saved_coding.type == coding_type_undecided
831 && process_coding.type != coding_type_undecided)
833 /* We have detected some coding system. But,
834 there's a possibility that the detection was
835 done by insufficient data. So, we try the code
836 detection again with more data. */
837 xfree (decoding_buf);
838 display_on_the_fly = 0;
839 process_coding = saved_coding;
840 carryover = nread;
841 /* This is to make the above condition always
842 fails in the future. */
843 saved_coding.type = coding_type_no_conversion;
844 continue;
847 if (process_coding.produced > 0)
848 insert_1_both (decoding_buf, process_coding.produced_char,
849 process_coding.produced, 0, 1, 0);
850 xfree (decoding_buf);
852 if (process_coding.result == CODING_FINISH_INCONSISTENT_EOL)
854 Lisp_Object eol_type, coding;
856 if (process_coding.eol_type == CODING_EOL_CR)
858 /* CRs have been replaced with LFs. Undo
859 that in the text inserted above. */
860 unsigned char *p;
862 move_gap_both (PT, PT_BYTE);
864 p = BYTE_POS_ADDR (pt_byte_orig);
865 for (; p < GPT_ADDR; ++p)
866 if (*p == '\n')
867 *p = '\r';
869 else if (process_coding.eol_type == CODING_EOL_CRLF)
871 /* CR LFs have been replaced with LFs. Undo
872 that by inserting CRs in front of LFs in
873 the text inserted above. */
874 EMACS_INT bytepos, old_pt, old_pt_byte, nCR;
876 old_pt = PT;
877 old_pt_byte = PT_BYTE;
878 nCR = 0;
880 for (bytepos = PT_BYTE - 1;
881 bytepos >= pt_byte_orig;
882 --bytepos)
883 if (FETCH_BYTE (bytepos) == '\n')
885 EMACS_INT charpos = BYTE_TO_CHAR (bytepos);
886 TEMP_SET_PT_BOTH (charpos, bytepos);
887 insert_1_both ("\r", 1, 1, 0, 1, 0);
888 ++nCR;
891 TEMP_SET_PT_BOTH (old_pt + nCR, old_pt_byte + nCR);
894 /* Set the coding system symbol to that for
895 Unix-like EOL. */
896 eol_type = Fget (saved_coding.symbol, Qeol_type);
897 if (VECTORP (eol_type)
898 && ASIZE (eol_type) == 3
899 && SYMBOLP (AREF (eol_type, CODING_EOL_LF)))
900 coding = AREF (eol_type, CODING_EOL_LF);
901 else
902 coding = saved_coding.symbol;
904 process_coding.symbol = coding;
905 process_coding.eol_type = CODING_EOL_LF;
906 process_coding.mode
907 &= ~CODING_MODE_INHIBIT_INCONSISTENT_EOL;
910 nread -= process_coding.consumed;
911 carryover = nread;
912 if (carryover > 0)
913 /* As CARRYOVER should not be that large, we had
914 better avoid overhead of bcopy. */
915 BCOPY_SHORT (buf + process_coding.consumed, buf,
916 carryover);
917 if (process_coding.result == CODING_FINISH_INSUFFICIENT_CMP)
919 /* The decoding ended because of insufficient data
920 area to record information about composition.
921 We must try decoding with additional data area
922 before reading more output for the process. */
923 coding_allocate_composition_data (&process_coding, PT);
924 goto repeat_decoding;
929 if (process_coding.mode & CODING_MODE_LAST_BLOCK)
930 break;
932 #if (CALLPROC_BUFFER_SIZE_MIN != CALLPROC_BUFFER_SIZE_MAX)
933 /* Make the buffer bigger as we continue to read more data,
934 but not past CALLPROC_BUFFER_SIZE_MAX. */
935 if (bufsize < CALLPROC_BUFFER_SIZE_MAX && total_read > 32 * bufsize)
936 if ((bufsize *= 2) > CALLPROC_BUFFER_SIZE_MAX)
937 bufsize = CALLPROC_BUFFER_SIZE_MAX;
938 #endif
940 if (display_p)
942 if (first)
943 prepare_menu_bars ();
944 first = 0;
945 redisplay_preserve_echo_area (1);
946 /* This variable might have been set to 0 for code
947 detection. In that case, we set it back to 1 because
948 we should have already detected a coding system. */
949 display_on_the_fly = 1;
951 immediate_quit = 1;
952 QUIT;
954 give_up: ;
956 if (!NILP (buffer)
957 && process_coding.cmp_data)
959 coding_restore_composition (&process_coding, Fcurrent_buffer ());
960 coding_free_composition_data (&process_coding);
964 int post_read_count = SPECPDL_INDEX ();
966 record_unwind_protect (save_excursion_restore, save_excursion_save ());
967 inserted = PT - pt_orig;
968 TEMP_SET_PT_BOTH (pt_orig, pt_byte_orig);
969 if (SYMBOLP (process_coding.post_read_conversion)
970 && !NILP (Ffboundp (process_coding.post_read_conversion)))
971 call1 (process_coding.post_read_conversion, make_number (inserted));
973 Vlast_coding_system_used = process_coding.symbol;
975 /* If the caller required, let the buffer inherit the
976 coding-system used to decode the process output. */
977 if (inherit_process_coding_system)
978 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
979 make_number (total_read));
981 unbind_to (post_read_count, Qnil);
985 /* Wait for it to terminate, unless it already has. */
986 wait_for_termination (pid);
988 immediate_quit = 0;
990 set_buffer_internal (old);
992 /* Don't kill any children that the subprocess may have left behind
993 when exiting. */
994 call_process_exited = 1;
996 unbind_to (count, Qnil);
998 if (synch_process_termsig)
1000 char *signame;
1002 synchronize_system_messages_locale ();
1003 signame = strsignal (synch_process_termsig);
1005 if (signame == 0)
1006 signame = "unknown";
1008 synch_process_death = signame;
1011 if (synch_process_death)
1012 return code_convert_string_norecord (build_string (synch_process_death),
1013 Vlocale_coding_system, 0);
1014 return make_number (synch_process_retcode);
1016 #endif
1018 static Lisp_Object
1019 delete_temp_file (name)
1020 Lisp_Object name;
1022 /* Suppress jka-compr handling, etc. */
1023 int count = SPECPDL_INDEX ();
1024 specbind (intern ("file-name-handler-alist"), Qnil);
1025 internal_delete_file (name);
1026 unbind_to (count, Qnil);
1027 return Qnil;
1030 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
1031 3, MANY, 0,
1032 doc: /* Send text from START to END to a synchronous process running PROGRAM.
1033 The remaining arguments are optional.
1034 Delete the text if fourth arg DELETE is non-nil.
1036 Insert output in BUFFER before point; t means current buffer;
1037 nil for BUFFER means discard it; 0 means discard and don't wait.
1038 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
1039 REAL-BUFFER says what to do with standard output, as above,
1040 while STDERR-FILE says what to do with standard error in the child.
1041 STDERR-FILE may be nil (discard standard error output),
1042 t (mix it with ordinary output), or a file name string.
1044 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
1045 Remaining args are passed to PROGRAM at startup as command args.
1047 If BUFFER is 0, `call-process-region' returns immediately with value nil.
1048 Otherwise it waits for PROGRAM to terminate
1049 and returns a numeric exit status or a signal description string.
1050 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
1052 usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
1053 (nargs, args)
1054 int nargs;
1055 register Lisp_Object *args;
1057 struct gcpro gcpro1;
1058 Lisp_Object filename_string;
1059 register Lisp_Object start, end;
1060 int count = SPECPDL_INDEX ();
1061 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1062 Lisp_Object coding_systems;
1063 Lisp_Object val, *args2;
1064 int i;
1065 #ifdef DOS_NT
1066 char *tempfile;
1067 char *outf = '\0';
1069 if ((outf = egetenv ("TMPDIR"))
1070 || (outf = egetenv ("TMP"))
1071 || (outf = egetenv ("TEMP")))
1072 strcpy (tempfile = alloca (strlen (outf) + 20), outf);
1073 else
1075 tempfile = alloca (20);
1076 *tempfile = '\0';
1078 if (!IS_DIRECTORY_SEP (tempfile[strlen (tempfile) - 1]))
1079 strcat (tempfile, "/");
1080 if ('/' == DIRECTORY_SEP)
1081 dostounix_filename (tempfile);
1082 else
1083 unixtodos_filename (tempfile);
1084 #ifdef WINDOWSNT
1085 strcat (tempfile, "emXXXXXX");
1086 #else
1087 strcat (tempfile, "detmp.XXX");
1088 #endif
1089 #else /* not DOS_NT */
1090 char *tempfile = (char *) alloca (SBYTES (Vtemp_file_name_pattern) + 1);
1091 bcopy (SDATA (Vtemp_file_name_pattern), tempfile,
1092 SBYTES (Vtemp_file_name_pattern) + 1);
1093 #endif /* not DOS_NT */
1095 coding_systems = Qt;
1097 #ifdef HAVE_MKSTEMP
1099 int fd = mkstemp (tempfile);
1100 if (fd == -1)
1101 report_file_error ("Failed to open temporary file",
1102 Fcons (Vtemp_file_name_pattern, Qnil));
1103 else
1104 close (fd);
1106 #else
1107 mktemp (tempfile);
1108 #endif
1110 filename_string = build_string (tempfile);
1111 GCPRO1 (filename_string);
1112 start = args[0];
1113 end = args[1];
1114 /* Decide coding-system of the contents of the temporary file. */
1115 if (!NILP (Vcoding_system_for_write))
1116 val = Vcoding_system_for_write;
1117 else if (NILP (current_buffer->enable_multibyte_characters))
1118 val = Qnil;
1119 else
1121 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
1122 args2[0] = Qcall_process_region;
1123 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
1124 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1125 if (CONSP (coding_systems))
1126 val = XCDR (coding_systems);
1127 else if (CONSP (Vdefault_process_coding_system))
1128 val = XCDR (Vdefault_process_coding_system);
1129 else
1130 val = Qnil;
1134 int count1 = SPECPDL_INDEX ();
1136 specbind (intern ("coding-system-for-write"), val);
1137 /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
1138 happen to get a ".Z" suffix. */
1139 specbind (intern ("file-name-handler-alist"), Qnil);
1140 Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil);
1142 unbind_to (count1, Qnil);
1145 /* Note that Fcall_process takes care of binding
1146 coding-system-for-read. */
1148 record_unwind_protect (delete_temp_file, filename_string);
1150 if (nargs > 3 && !NILP (args[3]))
1151 Fdelete_region (start, end);
1153 if (nargs > 3)
1155 args += 2;
1156 nargs -= 2;
1158 else
1160 args[0] = args[2];
1161 nargs = 2;
1163 args[1] = filename_string;
1165 RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args)));
1168 #ifndef VMS /* VMS version is in vmsproc.c. */
1170 static int relocate_fd ();
1172 /* This is the last thing run in a newly forked inferior
1173 either synchronous or asynchronous.
1174 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
1175 Initialize inferior's priority, pgrp, connected dir and environment.
1176 then exec another program based on new_argv.
1178 This function may change environ for the superior process.
1179 Therefore, the superior process must save and restore the value
1180 of environ around the vfork and the call to this function.
1182 SET_PGRP is nonzero if we should put the subprocess into a separate
1183 process group.
1185 CURRENT_DIR is an elisp string giving the path of the current
1186 directory the subprocess should have. Since we can't really signal
1187 a decent error from within the child, this should be verified as an
1188 executable directory by the parent. */
1191 child_setup (in, out, err, new_argv, set_pgrp, current_dir)
1192 int in, out, err;
1193 register char **new_argv;
1194 int set_pgrp;
1195 Lisp_Object current_dir;
1197 char **env;
1198 char *pwd_var;
1199 #ifdef WINDOWSNT
1200 int cpid;
1201 HANDLE handles[3];
1202 #endif /* WINDOWSNT */
1204 int pid = getpid ();
1206 #ifdef SET_EMACS_PRIORITY
1208 extern EMACS_INT emacs_priority;
1210 if (emacs_priority < 0)
1211 nice (- emacs_priority);
1213 #endif
1215 #ifdef subprocesses
1216 /* Close Emacs's descriptors that this process should not have. */
1217 close_process_descs ();
1218 #endif
1219 /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
1220 we will lose if we call close_load_descs here. */
1221 #ifndef DOS_NT
1222 close_load_descs ();
1223 #endif
1225 /* Note that use of alloca is always safe here. It's obvious for systems
1226 that do not have true vfork or that have true (stack) alloca.
1227 If using vfork and C_ALLOCA it is safe because that changes
1228 the superior's static variables as if the superior had done alloca
1229 and will be cleaned up in the usual way. */
1231 register char *temp;
1232 register int i;
1234 i = SBYTES (current_dir);
1235 #ifdef MSDOS
1236 /* MSDOS must have all environment variables malloc'ed, because
1237 low-level libc functions that launch subsidiary processes rely
1238 on that. */
1239 pwd_var = (char *) xmalloc (i + 6);
1240 #else
1241 pwd_var = (char *) alloca (i + 6);
1242 #endif
1243 temp = pwd_var + 4;
1244 bcopy ("PWD=", pwd_var, 4);
1245 bcopy (SDATA (current_dir), temp, i);
1246 if (!IS_DIRECTORY_SEP (temp[i - 1])) temp[i++] = DIRECTORY_SEP;
1247 temp[i] = 0;
1249 #ifndef DOS_NT
1250 /* We can't signal an Elisp error here; we're in a vfork. Since
1251 the callers check the current directory before forking, this
1252 should only return an error if the directory's permissions
1253 are changed between the check and this chdir, but we should
1254 at least check. */
1255 if (chdir (temp) < 0)
1256 _exit (errno);
1257 #endif
1259 #ifdef DOS_NT
1260 /* Get past the drive letter, so that d:/ is left alone. */
1261 if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
1263 temp += 2;
1264 i -= 2;
1266 #endif
1268 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1269 while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
1270 temp[--i] = 0;
1273 /* Set `env' to a vector of the strings in Vprocess_environment. */
1275 register Lisp_Object tem;
1276 register char **new_env;
1277 register int new_length;
1279 new_length = 0;
1280 for (tem = Vprocess_environment;
1281 CONSP (tem) && STRINGP (XCAR (tem));
1282 tem = XCDR (tem))
1283 new_length++;
1285 /* new_length + 2 to include PWD and terminating 0. */
1286 env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *));
1288 /* If we have a PWD envvar, pass one down,
1289 but with corrected value. */
1290 if (getenv ("PWD"))
1291 *new_env++ = pwd_var;
1293 /* Copy the Vprocess_environment strings into new_env. */
1294 for (tem = Vprocess_environment;
1295 CONSP (tem) && STRINGP (XCAR (tem));
1296 tem = XCDR (tem))
1298 char **ep = env;
1299 char *string = (char *) SDATA (XCAR (tem));
1300 /* See if this string duplicates any string already in the env.
1301 If so, don't put it in.
1302 When an env var has multiple definitions,
1303 we keep the definition that comes first in process-environment. */
1304 for (; ep != new_env; ep++)
1306 char *p = *ep, *q = string;
1307 while (1)
1309 if (*q == 0)
1310 /* The string is malformed; might as well drop it. */
1311 goto duplicate;
1312 if (*q != *p)
1313 break;
1314 if (*q == '=')
1315 goto duplicate;
1316 p++, q++;
1319 *new_env++ = string;
1320 duplicate: ;
1322 *new_env = 0;
1324 #ifdef WINDOWSNT
1325 prepare_standard_handles (in, out, err, handles);
1326 set_process_dir (SDATA (current_dir));
1327 #else /* not WINDOWSNT */
1328 /* Make sure that in, out, and err are not actually already in
1329 descriptors zero, one, or two; this could happen if Emacs is
1330 started with its standard in, out, or error closed, as might
1331 happen under X. */
1333 int oin = in, oout = out;
1335 /* We have to avoid relocating the same descriptor twice! */
1337 in = relocate_fd (in, 3);
1339 if (out == oin)
1340 out = in;
1341 else
1342 out = relocate_fd (out, 3);
1344 if (err == oin)
1345 err = in;
1346 else if (err == oout)
1347 err = out;
1348 else
1349 err = relocate_fd (err, 3);
1352 #ifndef MSDOS
1353 emacs_close (0);
1354 emacs_close (1);
1355 emacs_close (2);
1357 dup2 (in, 0);
1358 dup2 (out, 1);
1359 dup2 (err, 2);
1360 emacs_close (in);
1361 emacs_close (out);
1362 emacs_close (err);
1363 #endif /* not MSDOS */
1364 #endif /* not WINDOWSNT */
1366 #if defined(USG) && !defined(BSD_PGRPS)
1367 #ifndef SETPGRP_RELEASES_CTTY
1368 setpgrp (); /* No arguments but equivalent in this case */
1369 #endif
1370 #else
1371 setpgrp (pid, pid);
1372 #endif /* USG */
1373 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1374 EMACS_SET_TTY_PGRP (0, &pid);
1376 #ifdef MSDOS
1377 pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
1378 xfree (pwd_var);
1379 if (pid == -1)
1380 /* An error occurred while trying to run the subprocess. */
1381 report_file_error ("Spawning child process", Qnil);
1382 return pid;
1383 #else /* not MSDOS */
1384 #ifdef WINDOWSNT
1385 /* Spawn the child. (See ntproc.c:Spawnve). */
1386 cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
1387 reset_standard_handles (in, out, err, handles);
1388 if (cpid == -1)
1389 /* An error occurred while trying to spawn the process. */
1390 report_file_error ("Spawning child process", Qnil);
1391 return cpid;
1392 #else /* not WINDOWSNT */
1393 /* execvp does not accept an environment arg so the only way
1394 to pass this environment is to set environ. Our caller
1395 is responsible for restoring the ambient value of environ. */
1396 environ = env;
1397 execvp (new_argv[0], new_argv);
1399 emacs_write (1, "Can't exec program: ", 20);
1400 emacs_write (1, new_argv[0], strlen (new_argv[0]));
1401 emacs_write (1, "\n", 1);
1402 _exit (1);
1403 #endif /* not WINDOWSNT */
1404 #endif /* not MSDOS */
1407 /* Move the file descriptor FD so that its number is not less than MINFD.
1408 If the file descriptor is moved at all, the original is freed. */
1409 static int
1410 relocate_fd (fd, minfd)
1411 int fd, minfd;
1413 if (fd >= minfd)
1414 return fd;
1415 else
1417 int new = dup (fd);
1418 if (new == -1)
1420 char *message1 = "Error while setting up child: ";
1421 char *errmessage = strerror (errno);
1422 char *message2 = "\n";
1423 emacs_write (2, message1, strlen (message1));
1424 emacs_write (2, errmessage, strlen (errmessage));
1425 emacs_write (2, message2, strlen (message2));
1426 _exit (1);
1428 /* Note that we hold the original FD open while we recurse,
1429 to guarantee we'll get a new FD if we need it. */
1430 new = relocate_fd (new, minfd);
1431 emacs_close (fd);
1432 return new;
1436 static int
1437 getenv_internal (var, varlen, value, valuelen)
1438 char *var;
1439 int varlen;
1440 char **value;
1441 int *valuelen;
1443 Lisp_Object scan;
1445 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
1447 Lisp_Object entry;
1449 entry = XCAR (scan);
1450 if (STRINGP (entry)
1451 && SBYTES (entry) > varlen
1452 && SREF (entry, varlen) == '='
1453 #ifdef WINDOWSNT
1454 /* NT environment variables are case insensitive. */
1455 && ! strnicmp (SDATA (entry), var, varlen)
1456 #else /* not WINDOWSNT */
1457 && ! bcmp (SDATA (entry), var, varlen)
1458 #endif /* not WINDOWSNT */
1461 *value = (char *) SDATA (entry) + (varlen + 1);
1462 *valuelen = SBYTES (entry) - (varlen + 1);
1463 return 1;
1467 return 0;
1470 DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 1, 0,
1471 doc: /* Return the value of environment variable VAR, as a string.
1472 VAR should be a string. Value is nil if VAR is undefined in the environment.
1473 This function consults the variable ``process-environment'' for its value. */)
1474 (var)
1475 Lisp_Object var;
1477 char *value;
1478 int valuelen;
1480 CHECK_STRING (var);
1481 if (getenv_internal (SDATA (var), SBYTES (var),
1482 &value, &valuelen))
1483 return make_string (value, valuelen);
1484 else
1485 return Qnil;
1488 /* A version of getenv that consults process_environment, easily
1489 callable from C. */
1490 char *
1491 egetenv (var)
1492 char *var;
1494 char *value;
1495 int valuelen;
1497 if (getenv_internal (var, strlen (var), &value, &valuelen))
1498 return value;
1499 else
1500 return 0;
1503 #endif /* not VMS */
1505 /* This is run before init_cmdargs. */
1507 void
1508 init_callproc_1 ()
1510 char *data_dir = egetenv ("EMACSDATA");
1511 char *doc_dir = egetenv ("EMACSDOC");
1513 Vdata_directory
1514 = Ffile_name_as_directory (build_string (data_dir ? data_dir
1515 : PATH_DATA));
1516 Vdoc_directory
1517 = Ffile_name_as_directory (build_string (doc_dir ? doc_dir
1518 : PATH_DOC));
1520 /* Check the EMACSPATH environment variable, defaulting to the
1521 PATH_EXEC path from epaths.h. */
1522 Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
1523 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
1524 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
1527 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1529 void
1530 init_callproc ()
1532 char *data_dir = egetenv ("EMACSDATA");
1534 register char * sh;
1535 Lisp_Object tempdir;
1537 if (!NILP (Vinstallation_directory))
1539 /* Add to the path the lib-src subdir of the installation dir. */
1540 Lisp_Object tem;
1541 tem = Fexpand_file_name (build_string ("lib-src"),
1542 Vinstallation_directory);
1543 #ifndef DOS_NT
1544 /* MSDOS uses wrapped binaries, so don't do this. */
1545 if (NILP (Fmember (tem, Vexec_path)))
1547 Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
1548 Vexec_path = Fcons (tem, Vexec_path);
1549 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
1552 Vexec_directory = Ffile_name_as_directory (tem);
1553 #endif /* not DOS_NT */
1555 /* Maybe use ../etc as well as ../lib-src. */
1556 if (data_dir == 0)
1558 tem = Fexpand_file_name (build_string ("etc"),
1559 Vinstallation_directory);
1560 Vdoc_directory = Ffile_name_as_directory (tem);
1564 /* Look for the files that should be in etc. We don't use
1565 Vinstallation_directory, because these files are never installed
1566 near the executable, and they are never in the build
1567 directory when that's different from the source directory.
1569 Instead, if these files are not in the nominal place, we try the
1570 source directory. */
1571 if (data_dir == 0)
1573 Lisp_Object tem, tem1, srcdir;
1575 srcdir = Fexpand_file_name (build_string ("../src/"),
1576 build_string (PATH_DUMPLOADSEARCH));
1577 tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory);
1578 tem1 = Ffile_exists_p (tem);
1579 if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1))
1581 Lisp_Object newdir;
1582 newdir = Fexpand_file_name (build_string ("../etc/"),
1583 build_string (PATH_DUMPLOADSEARCH));
1584 tem = Fexpand_file_name (build_string ("GNU"), newdir);
1585 tem1 = Ffile_exists_p (tem);
1586 if (!NILP (tem1))
1587 Vdata_directory = newdir;
1591 #ifndef CANNOT_DUMP
1592 if (initialized)
1593 #endif
1595 tempdir = Fdirectory_file_name (Vexec_directory);
1596 if (access (SDATA (tempdir), 0) < 0)
1597 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1598 Vexec_directory);
1601 tempdir = Fdirectory_file_name (Vdata_directory);
1602 if (access (SDATA (tempdir), 0) < 0)
1603 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1604 Vdata_directory);
1606 #ifdef VMS
1607 Vshell_file_name = build_string ("*dcl*");
1608 #else
1609 sh = (char *) getenv ("SHELL");
1610 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
1611 #endif
1613 #ifdef VMS
1614 Vtemp_file_name_pattern = build_string ("tmp:emacsXXXXXX.");
1615 #else
1616 if (getenv ("TMPDIR"))
1618 char *dir = getenv ("TMPDIR");
1619 Vtemp_file_name_pattern
1620 = Fexpand_file_name (build_string ("emacsXXXXXX"),
1621 build_string (dir));
1623 else
1624 Vtemp_file_name_pattern = build_string ("/tmp/emacsXXXXXX");
1625 #endif
1627 #ifdef DOS_NT
1628 Vshared_game_score_directory = Qnil;
1629 #else
1630 Vshared_game_score_directory = build_string (PATH_GAME);
1631 if (NILP (Ffile_directory_p (Vshared_game_score_directory)))
1632 Vshared_game_score_directory = Qnil;
1633 #endif
1636 void
1637 set_process_environment ()
1639 register char **envp;
1641 Vprocess_environment = Qnil;
1642 #ifndef CANNOT_DUMP
1643 if (initialized)
1644 #endif
1645 for (envp = environ; *envp; envp++)
1646 Vprocess_environment = Fcons (build_string (*envp),
1647 Vprocess_environment);
1650 void
1651 syms_of_callproc ()
1653 #ifdef DOS_NT
1654 Qbuffer_file_type = intern ("buffer-file-type");
1655 staticpro (&Qbuffer_file_type);
1656 #endif /* DOS_NT */
1658 DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
1659 doc: /* *File name to load inferior shells from.
1660 Initialized from the SHELL environment variable. */);
1662 DEFVAR_LISP ("exec-path", &Vexec_path,
1663 doc: /* *List of directories to search programs to run in subprocesses.
1664 Each element is a string (directory name) or nil (try default directory). */);
1666 DEFVAR_LISP ("exec-suffixes", &Vexec_suffixes,
1667 doc: /* *List of suffixes to try to find executable file names.
1668 Each element is a string. */);
1669 Vexec_suffixes = Qnil;
1671 DEFVAR_LISP ("exec-directory", &Vexec_directory,
1672 doc: /* Directory for executables for Emacs to invoke.
1673 More generally, this includes any architecture-dependent files
1674 that are built and installed from the Emacs distribution. */);
1676 DEFVAR_LISP ("data-directory", &Vdata_directory,
1677 doc: /* Directory of machine-independent files that come with GNU Emacs.
1678 These are files intended for Emacs to use while it runs. */);
1680 DEFVAR_LISP ("doc-directory", &Vdoc_directory,
1681 doc: /* Directory containing the DOC file that comes with GNU Emacs.
1682 This is usually the same as data-directory. */);
1684 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory,
1685 doc: /* For internal use by the build procedure only.
1686 This is the name of the directory in which the build procedure installed
1687 Emacs's info files; the default value for Info-default-directory-list
1688 includes this. */);
1689 Vconfigure_info_directory = build_string (PATH_INFO);
1691 DEFVAR_LISP ("shared-game-score-directory", &Vshared_game_score_directory,
1692 doc: /* Directory of score files for games which come with GNU Emacs.
1693 If this variable is nil, then Emacs is unable to use a shared directory. */);
1694 #ifdef DOS_NT
1695 Vshared_game_score_directory = Qnil;
1696 #else
1697 Vshared_game_score_directory = build_string (PATH_GAME);
1698 #endif
1700 DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern,
1701 doc: /* Pattern for making names for temporary files.
1702 This is used by `call-process-region'. */);
1703 /* This variable is initialized in init_callproc. */
1705 DEFVAR_LISP ("process-environment", &Vprocess_environment,
1706 doc: /* List of environment variables for subprocesses to inherit.
1707 Each element should be a string of the form ENVVARNAME=VALUE.
1708 If multiple entries define the same variable, the first one always
1709 takes precedence.
1710 The environment which Emacs inherits is placed in this variable
1711 when Emacs starts.
1712 Non-ASCII characters are encoded according to the initial value of
1713 `locale-coding-system', i.e. the elements must normally be decoded for use.
1714 See `setenv' and `getenv'. */);
1716 #ifndef VMS
1717 defsubr (&Scall_process);
1718 defsubr (&Sgetenv_internal);
1719 #endif
1720 defsubr (&Scall_process_region);
1723 /* arch-tag: 769b8045-1df7-4d2b-8968-e3fb49017f95
1724 (do not change this comment) */