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