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