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