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