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