* lisp/comint.el: Clean up namespace
[emacs.git] / src / callproc.c
blob17eb8132d966275620208cea9a7b15c00dbbebe7
1 /* Synchronous subprocess invocation for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-1995, 1999-2018 Free Software Foundation,
4 Inc.
6 This file is part of GNU Emacs.
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 (at
11 your option) any later version.
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.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
22 #include <config.h>
23 #include <errno.h>
24 #include <stdio.h>
25 #include <stdlib.h>
26 #include <sys/types.h>
27 #include <unistd.h>
29 #include <sys/file.h>
30 #include <fcntl.h>
32 #include "lisp.h"
34 #ifdef WINDOWSNT
35 #include <sys/socket.h> /* for fcntl */
36 #include <windows.h>
37 #include "w32.h"
38 #define _P_NOWAIT 1 /* from process.h */
39 #endif
41 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
42 #include <sys/stat.h>
43 #include <sys/param.h>
44 #endif /* MSDOS */
46 #include "commands.h"
47 #include "buffer.h"
48 #include "coding.h"
49 #include <epaths.h>
50 #include "process.h"
51 #include "syssignal.h"
52 #include "syswait.h"
53 #include "blockinput.h"
54 #include "frame.h"
55 #include "systty.h"
56 #include "keyboard.h"
58 #ifdef MSDOS
59 #include "msdos.h"
60 #endif
62 #ifdef HAVE_NS
63 #include "nsterm.h"
64 #endif
66 /* Pattern used by call-process-region to make temp files. */
67 static Lisp_Object Vtemp_file_name_pattern;
69 /* The next two variables are used while record-unwind-protect is in place
70 during call-process for a subprocess for which record_deleted_pid has
71 not yet been called. At other times, synch_process_pid is zero and
72 synch_process_tempfile's contents are irrelevant. Doing this via static
73 C variables is more convenient than putting them into the arguments
74 of record-unwind-protect, as they need to be updated at randomish
75 times in the code, and Lisp cannot always store these values as
76 Emacs integers. It's safe to use static variables here, as the
77 code is never invoked reentrantly. */
79 /* If nonzero, a process-ID that has not been reaped. */
80 static pid_t synch_process_pid;
82 /* If a string, the name of a temp file that has not been removed. */
83 #ifdef MSDOS
84 static Lisp_Object synch_process_tempfile;
85 #else
86 # define synch_process_tempfile make_number (0)
87 #endif
89 /* Indexes of file descriptors that need closing on call_process_kill. */
90 enum
92 /* The subsidiary process's stdout and stderr. stdin is handled
93 separately, in either Fcall_process_region or create_temp_file. */
94 CALLPROC_STDOUT, CALLPROC_STDERR,
96 /* How to read from a pipe (or substitute) from the subsidiary process. */
97 CALLPROC_PIPEREAD,
99 /* A bound on the number of file descriptors. */
100 CALLPROC_FDS
103 static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int, ptrdiff_t);
105 /* Return the current buffer's working directory, or the home
106 directory if it's unreachable, as a string suitable for a system call.
107 Signal an error if the result would not be an accessible directory. */
109 Lisp_Object
110 encode_current_directory (void)
112 Lisp_Object dir;
114 dir = BVAR (current_buffer, directory);
116 dir = Funhandled_file_name_directory (dir);
118 /* If the file name handler says that dir is unreachable, use
119 a sensible default. */
120 if (NILP (dir))
121 dir = build_string ("~");
123 dir = expand_and_dir_to_file (dir);
125 if (NILP (Ffile_accessible_directory_p (dir)))
126 report_file_error ("Setting current directory",
127 BVAR (current_buffer, directory));
129 /* Remove "/:" from DIR and encode it. */
130 dir = ENCODE_FILE (remove_slash_colon (dir));
132 if (! file_accessible_directory_p (dir))
133 report_file_error ("Setting current directory",
134 BVAR (current_buffer, directory));
136 return dir;
139 /* If P is reapable, record it as a deleted process and kill it.
140 Do this in a critical section. Unless PID is wedged it will be
141 reaped on receipt of the first SIGCHLD after the critical section. */
143 void
144 record_kill_process (struct Lisp_Process *p, Lisp_Object tempfile)
146 #ifndef MSDOS
147 sigset_t oldset;
148 block_child_signal (&oldset);
150 if (p->alive)
152 record_deleted_pid (p->pid, tempfile);
153 p->alive = 0;
154 kill (- p->pid, SIGKILL);
157 unblock_child_signal (&oldset);
158 #endif /* !MSDOS */
161 /* Clean up files, file descriptors and processes created by Fcall_process. */
163 static void
164 delete_temp_file (Lisp_Object name)
166 unlink (SSDATA (name));
169 static void
170 call_process_kill (void *ptr)
172 int *callproc_fd = ptr;
173 int i;
174 for (i = 0; i < CALLPROC_FDS; i++)
175 if (0 <= callproc_fd[i])
176 emacs_close (callproc_fd[i]);
178 if (synch_process_pid)
180 struct Lisp_Process proc;
181 proc.alive = 1;
182 proc.pid = synch_process_pid;
183 record_kill_process (&proc, synch_process_tempfile);
184 synch_process_pid = 0;
186 else if (STRINGP (synch_process_tempfile))
187 delete_temp_file (synch_process_tempfile);
190 /* Clean up when exiting Fcall_process: restore the buffer, and
191 kill the subsidiary process group if the process still exists. */
193 static void
194 call_process_cleanup (Lisp_Object buffer)
196 Fset_buffer (buffer);
198 #ifndef MSDOS
199 if (synch_process_pid)
201 kill (-synch_process_pid, SIGINT);
202 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
204 /* This will quit on C-g. */
205 bool wait_ok = wait_for_termination (synch_process_pid, NULL, true);
206 synch_process_pid = 0;
207 message1 (wait_ok
208 ? "Waiting for process to die...done"
209 : "Waiting for process to die...internal error");
211 #endif /* !MSDOS */
214 #ifdef DOS_NT
215 static mode_t const default_output_mode = S_IREAD | S_IWRITE;
216 #else
217 static mode_t const default_output_mode = 0666;
218 #endif
220 DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
221 doc: /* Call PROGRAM synchronously in separate process.
222 The remaining arguments are optional.
223 The program's input comes from file INFILE (nil means `/dev/null').
224 Insert output in DESTINATION before point; t means current buffer; nil for DESTINATION
225 means discard it; 0 means discard and don't wait; and `(:file FILE)', where
226 FILE is a file name string, means that it should be written to that file
227 (if the file already exists it is overwritten).
228 DESTINATION can also have the form (REAL-BUFFER STDERR-FILE); in that case,
229 REAL-BUFFER says what to do with standard output, as above,
230 while STDERR-FILE says what to do with standard error in the child.
231 STDERR-FILE may be nil (discard standard error output),
232 t (mix it with ordinary output), or a file name string.
234 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
235 Remaining arguments are strings passed as command arguments to PROGRAM.
237 If executable PROGRAM can't be found as an executable, `call-process'
238 signals a Lisp error. `call-process' reports errors in execution of
239 the program only through its return and output.
241 If DESTINATION is 0, `call-process' returns immediately with value nil.
242 Otherwise it waits for PROGRAM to terminate
243 and returns a numeric exit status or a signal description string.
244 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
246 The process runs in `default-directory' if that is local (as
247 determined by `unhandled-file-name-directory'), or "~" otherwise. If
248 you want to run a process in a remote directory use `process-file'.
250 usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) */)
251 (ptrdiff_t nargs, Lisp_Object *args)
253 Lisp_Object infile, encoded_infile;
254 int filefd;
255 ptrdiff_t count = SPECPDL_INDEX ();
257 if (nargs >= 2 && ! NILP (args[1]))
259 infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory));
260 CHECK_STRING (infile);
262 else
263 infile = build_string (NULL_DEVICE);
265 encoded_infile = ENCODE_FILE (infile);
267 filefd = emacs_open (SSDATA (encoded_infile), O_RDONLY, 0);
268 if (filefd < 0)
269 report_file_error ("Opening process input file", infile);
270 record_unwind_protect_int (close_file_unwind, filefd);
271 return unbind_to (count, call_process (nargs, args, filefd, -1));
274 /* Like Fcall_process (NARGS, ARGS), except use FILEFD as the input file.
276 If TEMPFILE_INDEX is nonnegative, it is the specpdl index of an
277 unwinder that is intended to remove the input temporary file; in
278 this case NARGS must be at least 2 and ARGS[1] is the file's name.
280 At entry, the specpdl stack top entry must be close_file_unwind (FILEFD). */
282 static Lisp_Object
283 call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
284 ptrdiff_t tempfile_index)
286 Lisp_Object buffer, current_dir, path;
287 bool display_p;
288 int fd0;
289 int callproc_fd[CALLPROC_FDS];
290 int status;
291 ptrdiff_t i;
292 ptrdiff_t count = SPECPDL_INDEX ();
293 USE_SAFE_ALLOCA;
295 char **new_argv;
296 /* File to use for stderr in the child.
297 t means use same as standard output. */
298 Lisp_Object error_file;
299 Lisp_Object output_file = Qnil;
300 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
301 char *tempfile = NULL;
302 #else
303 sigset_t oldset;
304 pid_t pid;
305 #endif
306 int child_errno;
307 int fd_output, fd_error;
308 struct coding_system process_coding; /* coding-system of process output */
309 struct coding_system argument_coding; /* coding-system of arguments */
310 /* Set to the return value of Ffind_operation_coding_system. */
311 Lisp_Object coding_systems;
312 bool discard_output;
314 if (synch_process_pid)
315 error ("call-process invoked recursively");
317 /* Qt denotes that Ffind_operation_coding_system is not yet called. */
318 coding_systems = Qt;
320 CHECK_STRING (args[0]);
322 error_file = Qt;
324 #ifndef subprocesses
325 /* Without asynchronous processes we cannot have BUFFER == 0. */
326 if (nargs >= 3
327 && (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
328 error ("Operating system cannot handle asynchronous subprocesses");
329 #endif /* subprocesses */
331 /* Decide the coding-system for giving arguments. */
333 Lisp_Object val, *args2;
335 /* If arguments are supplied, we may have to encode them. */
336 if (nargs >= 5)
338 bool must_encode = 0;
339 Lisp_Object coding_attrs;
341 for (i = 4; i < nargs; i++)
342 CHECK_STRING (args[i]);
344 for (i = 4; i < nargs; i++)
345 if (STRING_MULTIBYTE (args[i]))
346 must_encode = 1;
348 if (!NILP (Vcoding_system_for_write))
349 val = Vcoding_system_for_write;
350 else if (! must_encode)
351 val = Qraw_text;
352 else
354 SAFE_NALLOCA (args2, 1, nargs + 1);
355 args2[0] = Qcall_process;
356 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
357 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
358 val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
360 val = complement_process_encoding_system (val);
361 setup_coding_system (Fcheck_coding_system (val), &argument_coding);
362 coding_attrs = CODING_ID_ATTRS (argument_coding.id);
363 if (NILP (CODING_ATTR_ASCII_COMPAT (coding_attrs)))
365 /* We should not use an ASCII incompatible coding system. */
366 val = raw_text_coding_system (val);
367 setup_coding_system (val, &argument_coding);
372 if (nargs < 3)
373 buffer = Qnil;
374 else
376 buffer = args[2];
378 /* If BUFFER is a list, its meaning is (BUFFER-FOR-STDOUT
379 FILE-FOR-STDERR), unless the first element is :file, in which case see
380 the next paragraph. */
381 if (CONSP (buffer) && !EQ (XCAR (buffer), QCfile))
383 if (CONSP (XCDR (buffer)))
385 Lisp_Object stderr_file;
386 stderr_file = XCAR (XCDR (buffer));
388 if (NILP (stderr_file) || EQ (Qt, stderr_file))
389 error_file = stderr_file;
390 else
391 error_file = Fexpand_file_name (stderr_file, Qnil);
394 buffer = XCAR (buffer);
397 /* If the buffer is (still) a list, it might be a (:file "file") spec. */
398 if (CONSP (buffer) && EQ (XCAR (buffer), QCfile))
400 output_file = Fexpand_file_name (XCAR (XCDR (buffer)),
401 BVAR (current_buffer, directory));
402 CHECK_STRING (output_file);
403 buffer = Qnil;
406 if (! (NILP (buffer) || EQ (buffer, Qt) || INTEGERP (buffer)))
408 Lisp_Object spec_buffer;
409 spec_buffer = buffer;
410 buffer = Fget_buffer_create (buffer);
411 /* Mention the buffer name for a better error message. */
412 if (NILP (buffer))
413 CHECK_BUFFER (spec_buffer);
414 CHECK_BUFFER (buffer);
418 /* Make sure that the child will be able to chdir to the current
419 buffer's current directory, or its unhandled equivalent. We
420 can't just have the child check for an error when it does the
421 chdir, since it's in a vfork. */
422 current_dir = encode_current_directory ();
424 if (STRINGP (error_file))
425 error_file = ENCODE_FILE (error_file);
426 if (STRINGP (output_file))
427 output_file = ENCODE_FILE (output_file);
429 display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
431 for (i = 0; i < CALLPROC_FDS; i++)
432 callproc_fd[i] = -1;
433 #ifdef MSDOS
434 synch_process_tempfile = make_number (0);
435 #endif
436 record_unwind_protect_ptr (call_process_kill, callproc_fd);
438 /* Search for program; barf if not found. */
440 int ok;
442 ok = openp (Vexec_path, args[0], Vexec_suffixes, &path,
443 make_number (X_OK), false);
444 if (ok < 0)
445 report_file_error ("Searching for program", args[0]);
448 /* Remove "/:" from PATH. */
449 path = remove_slash_colon (path);
451 SAFE_NALLOCA (new_argv, 1, nargs < 4 ? 2 : nargs - 2);
453 if (nargs > 4)
455 ptrdiff_t i;
457 argument_coding.dst_multibyte = 0;
458 for (i = 4; i < nargs; i++)
460 argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
461 if (CODING_REQUIRE_ENCODING (&argument_coding))
462 /* We must encode this argument. */
463 args[i] = encode_coding_string (&argument_coding, args[i], 1);
465 for (i = 4; i < nargs; i++)
466 new_argv[i - 3] = SSDATA (args[i]);
467 new_argv[i - 3] = 0;
469 else
470 new_argv[1] = 0;
471 path = ENCODE_FILE (path);
472 new_argv[0] = SSDATA (path);
474 discard_output = INTEGERP (buffer) || (NILP (buffer) && NILP (output_file));
476 #ifdef MSDOS
477 if (! discard_output && ! STRINGP (output_file))
479 char const *tmpdir = egetenv ("TMPDIR");
480 char const *outf = tmpdir ? tmpdir : "";
481 tempfile = alloca (strlen (outf) + 20);
482 strcpy (tempfile, outf);
483 dostounix_filename (tempfile);
484 if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
485 strcat (tempfile, "/");
486 strcat (tempfile, "emXXXXXX");
487 mktemp (tempfile);
488 if (!*tempfile)
489 report_file_error ("Opening process output file", Qnil);
490 output_file = build_string (tempfile);
491 synch_process_tempfile = output_file;
493 #endif
495 if (discard_output)
497 fd_output = emacs_open (NULL_DEVICE, O_WRONLY, 0);
498 if (fd_output < 0)
499 report_file_error ("Opening null device", Qnil);
501 else if (STRINGP (output_file))
503 fd_output = emacs_open (SSDATA (output_file),
504 O_WRONLY | O_CREAT | O_TRUNC | O_TEXT,
505 default_output_mode);
506 if (fd_output < 0)
508 int open_errno = errno;
509 output_file = DECODE_FILE (output_file);
510 report_file_errno ("Opening process output file",
511 output_file, open_errno);
514 else
516 int fd[2];
517 if (emacs_pipe (fd) != 0)
518 report_file_error ("Creating process pipe", Qnil);
519 callproc_fd[CALLPROC_PIPEREAD] = fd[0];
520 fd_output = fd[1];
522 callproc_fd[CALLPROC_STDOUT] = fd_output;
524 fd_error = fd_output;
526 if (STRINGP (error_file) || (NILP (error_file) && !discard_output))
528 fd_error = emacs_open ((STRINGP (error_file)
529 ? SSDATA (error_file)
530 : NULL_DEVICE),
531 O_WRONLY | O_CREAT | O_TRUNC | O_TEXT,
532 default_output_mode);
533 if (fd_error < 0)
535 int open_errno = errno;
536 report_file_errno ("Cannot redirect stderr",
537 (STRINGP (error_file)
538 ? DECODE_FILE (error_file)
539 : build_string (NULL_DEVICE)),
540 open_errno);
542 callproc_fd[CALLPROC_STDERR] = fd_error;
545 #ifdef MSDOS /* MW, July 1993 */
546 status = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir);
548 if (status < 0)
550 child_errno = errno;
551 unbind_to (count, Qnil);
552 synchronize_system_messages_locale ();
553 return
554 code_convert_string_norecord (build_string (strerror (child_errno)),
555 Vlocale_coding_system, 0);
558 for (i = 0; i < CALLPROC_FDS; i++)
559 if (0 <= callproc_fd[i])
561 emacs_close (callproc_fd[i]);
562 callproc_fd[i] = -1;
564 emacs_close (filefd);
565 clear_unwind_protect (count - 1);
567 if (tempfile)
569 /* Since CRLF is converted to LF within `decode_coding', we
570 can always open a file with binary mode. */
571 callproc_fd[CALLPROC_PIPEREAD] = emacs_open (tempfile, O_RDONLY, 0);
572 if (callproc_fd[CALLPROC_PIPEREAD] < 0)
574 int open_errno = errno;
575 report_file_errno ("Cannot re-open temporary file",
576 build_string (tempfile), open_errno);
580 #endif /* MSDOS */
582 /* Do the unwind-protect now, even though the pid is not known, so
583 that no storage allocation is done in the critical section.
584 The actual PID will be filled in during the critical section. */
585 record_unwind_protect (call_process_cleanup, Fcurrent_buffer ());
587 #ifndef MSDOS
589 block_input ();
590 block_child_signal (&oldset);
592 #ifdef WINDOWSNT
593 pid = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir);
594 #else /* not WINDOWSNT */
596 /* vfork, and prevent local vars from being clobbered by the vfork. */
598 Lisp_Object volatile buffer_volatile = buffer;
599 Lisp_Object volatile coding_systems_volatile = coding_systems;
600 Lisp_Object volatile current_dir_volatile = current_dir;
601 bool volatile display_p_volatile = display_p;
602 int volatile fd_error_volatile = fd_error;
603 int volatile filefd_volatile = filefd;
604 ptrdiff_t volatile count_volatile = count;
605 ptrdiff_t volatile sa_avail_volatile = sa_avail;
606 ptrdiff_t volatile sa_count_volatile = sa_count;
607 char **volatile new_argv_volatile = new_argv;
608 int volatile callproc_fd_volatile[CALLPROC_FDS];
609 for (i = 0; i < CALLPROC_FDS; i++)
610 callproc_fd_volatile[i] = callproc_fd[i];
612 pid = vfork ();
614 buffer = buffer_volatile;
615 coding_systems = coding_systems_volatile;
616 current_dir = current_dir_volatile;
617 display_p = display_p_volatile;
618 fd_error = fd_error_volatile;
619 filefd = filefd_volatile;
620 count = count_volatile;
621 sa_avail = sa_avail_volatile;
622 sa_count = sa_count_volatile;
623 new_argv = new_argv_volatile;
625 for (i = 0; i < CALLPROC_FDS; i++)
626 callproc_fd[i] = callproc_fd_volatile[i];
627 fd_output = callproc_fd[CALLPROC_STDOUT];
630 if (pid == 0)
632 #ifdef DARWIN_OS
633 /* Work around a macOS bug, where SIGCHLD is apparently
634 delivered to a vforked child instead of to its parent. See:
635 https://lists.gnu.org/r/emacs-devel/2017-05/msg00342.html
637 signal (SIGCHLD, SIG_DFL);
638 #endif
640 unblock_child_signal (&oldset);
642 #ifdef DARWIN_OS
643 /* Darwin doesn't let us run setsid after a vfork, so use
644 TIOCNOTTY when necessary. */
645 int j = emacs_open (DEV_TTY, O_RDWR, 0);
646 if (j >= 0)
648 ioctl (j, TIOCNOTTY, 0);
649 emacs_close (j);
651 #else
652 setsid ();
653 #endif
655 /* Emacs ignores SIGPIPE, but the child should not. */
656 signal (SIGPIPE, SIG_DFL);
657 /* Likewise for SIGPROF. */
658 #ifdef SIGPROF
659 signal (SIGPROF, SIG_DFL);
660 #endif
662 child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir);
665 #endif /* not WINDOWSNT */
667 child_errno = errno;
669 if (pid > 0)
671 synch_process_pid = pid;
673 if (INTEGERP (buffer))
675 if (tempfile_index < 0)
676 record_deleted_pid (pid, Qnil);
677 else
679 eassert (1 < nargs);
680 record_deleted_pid (pid, args[1]);
681 clear_unwind_protect (tempfile_index);
683 synch_process_pid = 0;
687 unblock_child_signal (&oldset);
688 unblock_input ();
690 if (pid < 0)
691 report_file_errno ("Doing vfork", Qnil, child_errno);
693 /* Close our file descriptors, except for callproc_fd[CALLPROC_PIPEREAD]
694 since we will use that to read input from. */
695 for (i = 0; i < CALLPROC_FDS; i++)
696 if (i != CALLPROC_PIPEREAD && 0 <= callproc_fd[i])
698 emacs_close (callproc_fd[i]);
699 callproc_fd[i] = -1;
701 emacs_close (filefd);
702 clear_unwind_protect (count - 1);
704 #endif /* not MSDOS */
706 if (INTEGERP (buffer))
707 return unbind_to (count, Qnil);
709 if (BUFFERP (buffer))
710 Fset_buffer (buffer);
712 fd0 = callproc_fd[CALLPROC_PIPEREAD];
714 if (0 <= fd0)
716 Lisp_Object val, *args2;
718 val = Qnil;
719 if (!NILP (Vcoding_system_for_read))
720 val = Vcoding_system_for_read;
721 else
723 if (EQ (coding_systems, Qt))
725 ptrdiff_t i;
727 SAFE_NALLOCA (args2, 1, nargs + 1);
728 args2[0] = Qcall_process;
729 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
730 coding_systems
731 = Ffind_operation_coding_system (nargs + 1, args2);
733 if (CONSP (coding_systems))
734 val = XCAR (coding_systems);
735 else if (CONSP (Vdefault_process_coding_system))
736 val = XCAR (Vdefault_process_coding_system);
737 else
738 val = Qnil;
740 Fcheck_coding_system (val);
741 /* In unibyte mode, character code conversion should not take
742 place but EOL conversion should. So, setup raw-text or one
743 of the subsidiary according to the information just setup. */
744 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
745 && !NILP (val))
746 val = raw_text_coding_system (val);
747 setup_coding_system (val, &process_coding);
748 process_coding.dst_multibyte
749 = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
750 process_coding.src_multibyte = 0;
753 if (0 <= fd0)
755 enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 };
756 enum { CALLPROC_BUFFER_SIZE_MAX = 4 * CALLPROC_BUFFER_SIZE_MIN };
757 char buf[CALLPROC_BUFFER_SIZE_MAX];
758 int bufsize = CALLPROC_BUFFER_SIZE_MIN;
759 int nread;
760 EMACS_INT total_read = 0;
761 int carryover = 0;
762 bool display_on_the_fly = display_p;
763 struct coding_system saved_coding = process_coding;
765 while (1)
767 /* Repeatedly read until we've filled as much as possible
768 of the buffer size we have. But don't read
769 less than 1024--save that for the next bufferful. */
770 nread = carryover;
771 while (nread < bufsize - 1024)
773 int this_read = emacs_read_quit (fd0, buf + nread,
774 bufsize - nread);
776 if (this_read < 0)
777 goto give_up;
779 if (this_read == 0)
781 process_coding.mode |= CODING_MODE_LAST_BLOCK;
782 break;
785 nread += this_read;
786 total_read += this_read;
788 if (display_on_the_fly)
789 break;
792 /* Now NREAD is the total amount of data in the buffer. */
794 if (!nread)
796 else if (NILP (BVAR (current_buffer, enable_multibyte_characters))
797 && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
798 insert_1_both (buf, nread, nread, 0, 1, 0);
799 else
800 { /* We have to decode the input. */
801 Lisp_Object curbuf;
802 ptrdiff_t count1 = SPECPDL_INDEX ();
804 XSETBUFFER (curbuf, current_buffer);
805 /* FIXME: Call signal_after_change! */
806 prepare_to_modify_buffer (PT, PT, NULL);
807 /* We cannot allow after-change-functions be run
808 during decoding, because that might modify the
809 buffer, while we rely on process_coding.produced to
810 faithfully reflect inserted text until we
811 TEMP_SET_PT_BOTH below. */
812 specbind (Qinhibit_modification_hooks, Qt);
813 decode_coding_c_string (&process_coding,
814 (unsigned char *) buf, nread, curbuf);
815 unbind_to (count1, Qnil);
816 if (display_on_the_fly
817 && CODING_REQUIRE_DETECTION (&saved_coding)
818 && ! CODING_REQUIRE_DETECTION (&process_coding))
820 /* We have detected some coding system, but the
821 detection may have been via insufficient data.
822 So give up displaying on the fly. */
823 if (process_coding.produced > 0)
824 del_range_2 (process_coding.dst_pos,
825 process_coding.dst_pos_byte,
826 (process_coding.dst_pos
827 + process_coding.produced_char),
828 (process_coding.dst_pos_byte
829 + process_coding.produced),
831 display_on_the_fly = false;
832 process_coding = saved_coding;
833 carryover = nread;
834 /* Make the above condition always fail in the future. */
835 saved_coding.common_flags
836 &= ~CODING_REQUIRE_DETECTION_MASK;
837 continue;
840 TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
841 PT_BYTE + process_coding.produced);
842 carryover = process_coding.carryover_bytes;
843 if (carryover > 0)
844 memcpy (buf, process_coding.carryover,
845 process_coding.carryover_bytes);
848 if (process_coding.mode & CODING_MODE_LAST_BLOCK)
849 break;
851 /* Make the buffer bigger as we continue to read more data,
852 but not past CALLPROC_BUFFER_SIZE_MAX. */
853 if (bufsize < CALLPROC_BUFFER_SIZE_MAX && total_read > 32 * bufsize)
854 if ((bufsize *= 2) > CALLPROC_BUFFER_SIZE_MAX)
855 bufsize = CALLPROC_BUFFER_SIZE_MAX;
857 if (display_p)
859 redisplay_preserve_echo_area (1);
860 /* This variable might have been set to 0 for code
861 detection. In that case, set it back to 1 because
862 we should have already detected a coding system. */
863 display_on_the_fly = true;
866 give_up: ;
868 Vlast_coding_system_used = CODING_ID_NAME (process_coding.id);
869 /* If the caller required, let the buffer inherit the
870 coding-system used to decode the process output. */
871 if (inherit_process_coding_system)
872 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
873 make_number (total_read));
876 bool wait_ok = true;
877 #ifndef MSDOS
878 /* Wait for it to terminate, unless it already has. */
879 wait_ok = wait_for_termination (pid, &status, fd0 < 0);
880 #endif
882 /* Don't kill any children that the subprocess may have left behind
883 when exiting. */
884 synch_process_pid = 0;
886 SAFE_FREE_UNBIND_TO (count, Qnil);
888 if (!wait_ok)
889 return build_unibyte_string ("internal error");
891 if (WIFSIGNALED (status))
893 const char *signame;
895 synchronize_system_messages_locale ();
896 signame = strsignal (WTERMSIG (status));
898 if (signame == 0)
899 signame = "unknown";
901 return code_convert_string_norecord (build_string (signame),
902 Vlocale_coding_system, 0);
905 eassert (WIFEXITED (status));
906 return make_number (WEXITSTATUS (status));
909 /* Create a temporary file suitable for storing the input data of
910 call-process-region. NARGS and ARGS are the same as for
911 call-process-region. Store into *FILENAME_STRING_PTR a Lisp string
912 naming the file, and return a file descriptor for reading.
913 Unwind-protect the file, so that the file descriptor will be closed
914 and the file removed when the caller unwinds the specpdl stack. */
916 static int
917 create_temp_file (ptrdiff_t nargs, Lisp_Object *args,
918 Lisp_Object *filename_string_ptr)
920 int fd;
921 Lisp_Object filename_string;
922 Lisp_Object val, start, end;
923 Lisp_Object tmpdir;
925 if (STRINGP (Vtemporary_file_directory))
926 tmpdir = Vtemporary_file_directory;
927 else
929 char *outf;
930 #ifndef DOS_NT
931 outf = getenv ("TMPDIR");
932 tmpdir = build_string (outf ? outf : "/tmp/");
933 #else /* DOS_NT */
934 if ((outf = egetenv ("TMPDIR"))
935 || (outf = egetenv ("TMP"))
936 || (outf = egetenv ("TEMP")))
937 tmpdir = build_string (outf);
938 else
939 tmpdir = Ffile_name_as_directory (build_string ("c:/temp"));
940 #endif
944 Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
945 char *tempfile;
946 ptrdiff_t count;
948 #ifdef WINDOWSNT
949 /* Cannot use the result of Fexpand_file_name, because it
950 downcases the XXXXXX part of the pattern, and mktemp then
951 doesn't recognize it. */
952 if (!NILP (Vw32_downcase_file_names))
954 Lisp_Object dirname = Ffile_name_directory (pattern);
956 if (NILP (dirname))
957 pattern = Vtemp_file_name_pattern;
958 else
959 pattern = concat2 (dirname, Vtemp_file_name_pattern);
961 #endif
963 filename_string = Fcopy_sequence (ENCODE_FILE (pattern));
964 tempfile = SSDATA (filename_string);
966 count = SPECPDL_INDEX ();
967 record_unwind_protect_nothing ();
968 fd = mkostemp (tempfile, O_BINARY | O_CLOEXEC);
969 if (fd < 0)
970 report_file_error ("Failed to open temporary file using pattern",
971 pattern);
972 set_unwind_protect (count, delete_temp_file, filename_string);
973 record_unwind_protect_int (close_file_unwind, fd);
976 start = args[0];
977 end = args[1];
978 /* Decide coding-system of the contents of the temporary file. */
979 if (!NILP (Vcoding_system_for_write))
980 val = Vcoding_system_for_write;
981 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
982 val = Qraw_text;
983 else
985 Lisp_Object coding_systems;
986 Lisp_Object *args2;
987 USE_SAFE_ALLOCA;
988 SAFE_NALLOCA (args2, 1, nargs + 1);
989 args2[0] = Qcall_process_region;
990 memcpy (args2 + 1, args, nargs * sizeof *args);
991 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
992 val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
993 SAFE_FREE ();
995 val = complement_process_encoding_system (val);
998 ptrdiff_t count1 = SPECPDL_INDEX ();
1000 specbind (intern ("coding-system-for-write"), val);
1001 /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
1002 happen to get a ".Z" suffix. */
1003 specbind (Qfile_name_handler_alist, Qnil);
1004 write_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil, fd);
1006 unbind_to (count1, Qnil);
1009 if (lseek (fd, 0, SEEK_SET) < 0)
1010 report_file_error ("Setting file position", filename_string);
1012 /* Note that Fcall_process takes care of binding
1013 coding-system-for-read. */
1015 *filename_string_ptr = filename_string;
1016 return fd;
1019 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
1020 3, MANY, 0,
1021 doc: /* Send text from START to END to a synchronous process running PROGRAM.
1023 START and END are normally buffer positions specifying the part of the
1024 buffer to send to the process.
1025 If START is nil, that means to use the entire buffer contents; END is
1026 ignored.
1027 If START is a string, then send that string to the process
1028 instead of any buffer contents; END is ignored.
1029 The remaining arguments are optional.
1030 Delete the text if fourth arg DELETE is non-nil.
1032 Insert output in BUFFER before point; t means current buffer; nil for
1033 BUFFER means discard it; 0 means discard and don't wait; and `(:file
1034 FILE)', where FILE is a file name string, means that it should be
1035 written to that file (if the file already exists it is overwritten).
1036 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
1037 REAL-BUFFER says what to do with standard output, as above,
1038 while STDERR-FILE says what to do with standard error in the child.
1039 STDERR-FILE may be nil (discard standard error output),
1040 t (mix it with ordinary output), or a file name string.
1042 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
1043 Remaining args are passed to PROGRAM at startup as command args.
1045 If BUFFER is 0, `call-process-region' returns immediately with value nil.
1046 Otherwise it waits for PROGRAM to terminate
1047 and returns a numeric exit status or a signal description string.
1048 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
1050 usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
1051 (ptrdiff_t nargs, Lisp_Object *args)
1053 Lisp_Object infile, val;
1054 ptrdiff_t count = SPECPDL_INDEX ();
1055 Lisp_Object start = args[0];
1056 Lisp_Object end = args[1];
1057 bool empty_input;
1058 int fd;
1060 if (STRINGP (start))
1061 empty_input = SCHARS (start) == 0;
1062 else if (NILP (start))
1063 empty_input = BEG == Z;
1064 else
1066 validate_region (&args[0], &args[1]);
1067 start = args[0];
1068 end = args[1];
1069 empty_input = XINT (start) == XINT (end);
1072 if (!empty_input)
1073 fd = create_temp_file (nargs, args, &infile);
1074 else
1076 infile = Qnil;
1077 fd = emacs_open (NULL_DEVICE, O_RDONLY, 0);
1078 if (fd < 0)
1079 report_file_error ("Opening null device", Qnil);
1080 record_unwind_protect_int (close_file_unwind, fd);
1083 if (nargs > 3 && !NILP (args[3]))
1084 Fdelete_region (start, end);
1086 if (nargs > 3)
1088 args += 2;
1089 nargs -= 2;
1091 else
1093 args[0] = args[2];
1094 nargs = 2;
1096 args[1] = infile;
1098 val = call_process (nargs, args, fd, empty_input ? -1 : count);
1099 return unbind_to (count, val);
1102 static char **
1103 add_env (char **env, char **new_env, char *string)
1105 char **ep;
1106 bool ok = 1;
1107 if (string == NULL)
1108 return new_env;
1110 /* See if this string duplicates any string already in the env.
1111 If so, don't put it in.
1112 When an env var has multiple definitions,
1113 we keep the definition that comes first in process-environment. */
1114 for (ep = env; ok && ep != new_env; ep++)
1116 char *p = *ep, *q = string;
1117 while (ok)
1119 if (*p && *q != *p)
1120 break;
1121 if (*q == 0)
1122 /* The string is a lone variable name; keep it for now, we
1123 will remove it later. It is a placeholder for a
1124 variable that is not to be included in the environment. */
1125 break;
1126 if (*q == '=')
1127 ok = 0;
1128 p++, q++;
1131 if (ok)
1132 *new_env++ = string;
1133 return new_env;
1136 #ifndef DOS_NT
1138 /* 'exec' failed inside a child running NAME, with error number ERR.
1139 Possibly a vforked child needed to allocate a large vector on the
1140 stack; such a child cannot fall back on malloc because that might
1141 mess up the allocator's data structures in the parent.
1142 Report the error and exit the child. */
1144 static _Noreturn void
1145 exec_failed (char const *name, int err)
1147 /* Avoid deadlock if the child's perror writes to a full pipe; the
1148 pipe's reader is the parent, but with vfork the parent can't
1149 run until the child exits. Truncate the diagnostic instead. */
1150 fcntl (STDERR_FILENO, F_SETFL, O_NONBLOCK);
1152 errno = err;
1153 emacs_perror (name);
1154 _exit (err == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE);
1157 #else
1159 /* Do nothing. There is no need to fail, as DOS_NT platforms do not
1160 fork and exec, and handle alloca exhaustion in a different way. */
1162 static void
1163 exec_failed (char const *name, int err)
1167 #endif
1169 /* This is the last thing run in a newly forked inferior
1170 either synchronous or asynchronous.
1171 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
1172 Initialize inferior's priority, pgrp, connected dir and environment.
1173 then exec another program based on new_argv.
1175 If SET_PGRP, put the subprocess into a separate process group.
1177 CURRENT_DIR is an elisp string giving the path of the current
1178 directory the subprocess should have. Since we can't really signal
1179 a decent error from within the child, this should be verified as an
1180 executable directory by the parent.
1182 On GNUish hosts, either exec or return an error number.
1183 On MS-Windows, either return a pid or signal an error.
1184 On MS-DOS, either return an exit status or signal an error. */
1186 CHILD_SETUP_TYPE
1187 child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
1188 Lisp_Object current_dir)
1190 char **env;
1191 char *pwd_var;
1192 #ifdef WINDOWSNT
1193 int cpid;
1194 HANDLE handles[3];
1195 #else
1196 pid_t pid = getpid ();
1197 #endif /* WINDOWSNT */
1199 /* Note that use of alloca is always safe here. It's obvious for systems
1200 that do not have true vfork or that have true (stack) alloca.
1201 If using vfork and C_ALLOCA (when Emacs used to include
1202 src/alloca.c) it is safe because that changes the superior's
1203 static variables as if the superior had done alloca and will be
1204 cleaned up in the usual way. */
1206 char *temp;
1207 ptrdiff_t i;
1209 i = SBYTES (current_dir);
1210 #ifdef MSDOS
1211 /* MSDOS must have all environment variables malloc'ed, because
1212 low-level libc functions that launch subsidiary processes rely
1213 on that. */
1214 pwd_var = xmalloc (i + 5);
1215 #else
1216 if (MAX_ALLOCA - 5 < i)
1217 exec_failed (new_argv[0], ENOMEM);
1218 pwd_var = alloca (i + 5);
1219 #endif
1220 temp = pwd_var + 4;
1221 memcpy (pwd_var, "PWD=", 4);
1222 lispstpcpy (temp, current_dir);
1224 #ifndef DOS_NT
1225 /* We can't signal an Elisp error here; we're in a vfork. Since
1226 the callers check the current directory before forking, this
1227 should only return an error if the directory's permissions
1228 are changed between the check and this chdir, but we should
1229 at least check. */
1230 if (chdir (temp) < 0)
1231 _exit (EXIT_CANCELED);
1232 #else /* DOS_NT */
1233 /* Get past the drive letter, so that d:/ is left alone. */
1234 if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
1236 temp += 2;
1237 i -= 2;
1239 #endif /* DOS_NT */
1241 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1242 while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
1243 temp[--i] = 0;
1246 /* Set `env' to a vector of the strings in the environment. */
1248 register Lisp_Object tem;
1249 register char **new_env;
1250 char **p, **q;
1251 register int new_length;
1252 Lisp_Object display = Qnil;
1254 new_length = 0;
1256 for (tem = Vprocess_environment;
1257 CONSP (tem) && STRINGP (XCAR (tem));
1258 tem = XCDR (tem))
1260 if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0
1261 && (SDATA (XCAR (tem)) [7] == '\0'
1262 || SDATA (XCAR (tem)) [7] == '='))
1263 /* DISPLAY is specified in process-environment. */
1264 display = Qt;
1265 new_length++;
1268 /* If not provided yet, use the frame's DISPLAY. */
1269 if (NILP (display))
1271 Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
1272 if (!STRINGP (tmp) && CONSP (Vinitial_environment))
1273 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1274 tmp = Fgetenv_internal (build_string ("DISPLAY"),
1275 Vinitial_environment);
1276 if (STRINGP (tmp))
1278 display = tmp;
1279 new_length++;
1283 /* new_length + 2 to include PWD and terminating 0. */
1284 if (MAX_ALLOCA / sizeof *env - 2 < new_length)
1285 exec_failed (new_argv[0], ENOMEM);
1286 env = new_env = alloca ((new_length + 2) * sizeof *env);
1287 /* If we have a PWD envvar, pass one down,
1288 but with corrected value. */
1289 if (egetenv ("PWD"))
1290 *new_env++ = pwd_var;
1292 if (STRINGP (display))
1294 if (MAX_ALLOCA - sizeof "DISPLAY=" < SBYTES (display))
1295 exec_failed (new_argv[0], ENOMEM);
1296 char *vdata = alloca (sizeof "DISPLAY=" + SBYTES (display));
1297 lispstpcpy (stpcpy (vdata, "DISPLAY="), display);
1298 new_env = add_env (env, new_env, vdata);
1301 /* Overrides. */
1302 for (tem = Vprocess_environment;
1303 CONSP (tem) && STRINGP (XCAR (tem));
1304 tem = XCDR (tem))
1305 new_env = add_env (env, new_env, SSDATA (XCAR (tem)));
1307 *new_env = 0;
1309 /* Remove variable names without values. */
1310 p = q = env;
1311 while (*p != 0)
1313 while (*q != 0 && strchr (*q, '=') == NULL)
1314 q++;
1315 *p = *q++;
1316 if (*p != 0)
1317 p++;
1322 #ifdef WINDOWSNT
1323 prepare_standard_handles (in, out, err, handles);
1324 set_process_dir (SSDATA (current_dir));
1325 /* Spawn the child. (See w32proc.c:sys_spawnve). */
1326 cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
1327 reset_standard_handles (in, out, err, handles);
1328 if (cpid == -1)
1329 /* An error occurred while trying to spawn the process. */
1330 report_file_error ("Spawning child process", Qnil);
1331 return cpid;
1333 #else /* not WINDOWSNT */
1335 #ifndef MSDOS
1337 restore_nofile_limit ();
1339 /* Redirect file descriptors and clear the close-on-exec flag on the
1340 redirected ones. IN, OUT, and ERR are close-on-exec so they
1341 need not be closed explicitly. */
1342 dup2 (in, STDIN_FILENO);
1343 dup2 (out, STDOUT_FILENO);
1344 dup2 (err, STDERR_FILENO);
1346 setpgid (0, 0);
1347 tcsetpgrp (0, pid);
1349 int errnum = emacs_exec_file (new_argv[0], new_argv, env);
1350 exec_failed (new_argv[0], errnum);
1352 #else /* MSDOS */
1353 pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
1354 xfree (pwd_var);
1355 if (pid == -1)
1356 /* An error occurred while trying to run the subprocess. */
1357 report_file_error ("Spawning child process", Qnil);
1358 return pid;
1359 #endif /* MSDOS */
1360 #endif /* not WINDOWSNT */
1363 static bool
1364 getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
1365 ptrdiff_t *valuelen, Lisp_Object env)
1367 for (; CONSP (env); env = XCDR (env))
1369 Lisp_Object entry = XCAR (env);
1370 if (STRINGP (entry)
1371 && SBYTES (entry) >= varlen
1372 #ifdef WINDOWSNT
1373 /* NT environment variables are case insensitive. */
1374 && ! strnicmp (SSDATA (entry), var, varlen)
1375 #else /* not WINDOWSNT */
1376 && ! memcmp (SDATA (entry), var, varlen)
1377 #endif /* not WINDOWSNT */
1380 if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
1382 *value = SSDATA (entry) + (varlen + 1);
1383 *valuelen = SBYTES (entry) - (varlen + 1);
1384 return 1;
1386 else if (SBYTES (entry) == varlen)
1388 /* Lone variable names in Vprocess_environment mean that
1389 variable should be removed from the environment. */
1390 *value = NULL;
1391 return 1;
1395 return 0;
1398 static bool
1399 getenv_internal (const char *var, ptrdiff_t varlen, char **value,
1400 ptrdiff_t *valuelen, Lisp_Object frame)
1402 /* Try to find VAR in Vprocess_environment first. */
1403 if (getenv_internal_1 (var, varlen, value, valuelen,
1404 Vprocess_environment))
1405 return *value ? 1 : 0;
1407 /* On Windows we make some modifications to Emacs' environment
1408 without recording them in Vprocess_environment. */
1409 #ifdef WINDOWSNT
1411 char *tmpval = getenv (var);
1412 if (tmpval)
1414 *value = tmpval;
1415 *valuelen = strlen (tmpval);
1416 return 1;
1419 #endif
1421 /* For DISPLAY try to get the values from the frame or the initial env. */
1422 if (strcmp (var, "DISPLAY") == 0)
1424 Lisp_Object display
1425 = Fframe_parameter (NILP (frame) ? selected_frame : frame, Qdisplay);
1426 if (STRINGP (display))
1428 *value = SSDATA (display);
1429 *valuelen = SBYTES (display);
1430 return 1;
1432 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1433 if (getenv_internal_1 (var, varlen, value, valuelen,
1434 Vinitial_environment))
1435 return *value ? 1 : 0;
1438 return 0;
1441 DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
1442 doc: /* Get the value of environment variable VARIABLE.
1443 VARIABLE should be a string. Value is nil if VARIABLE is undefined in
1444 the environment. Otherwise, value is a string.
1446 This function searches `process-environment' for VARIABLE.
1448 If optional parameter ENV is a list, then search this list instead of
1449 `process-environment', and return t when encountering a negative entry
1450 \(an entry for a variable with no value). */)
1451 (Lisp_Object variable, Lisp_Object env)
1453 char *value;
1454 ptrdiff_t valuelen;
1456 CHECK_STRING (variable);
1457 if (CONSP (env))
1459 if (getenv_internal_1 (SSDATA (variable), SBYTES (variable),
1460 &value, &valuelen, env))
1461 return value ? make_string (value, valuelen) : Qt;
1462 else
1463 return Qnil;
1465 else if (getenv_internal (SSDATA (variable), SBYTES (variable),
1466 &value, &valuelen, env))
1467 return make_string (value, valuelen);
1468 else
1469 return Qnil;
1472 /* A version of getenv that consults the Lisp environment lists,
1473 easily callable from C. This is usually called from egetenv. */
1474 char *
1475 egetenv_internal (const char *var, ptrdiff_t len)
1477 char *value;
1478 ptrdiff_t valuelen;
1480 if (getenv_internal (var, len, &value, &valuelen, Qnil))
1481 return value;
1482 else
1483 return 0;
1487 /* This is run before init_cmdargs. */
1489 void
1490 init_callproc_1 (void)
1492 #ifdef HAVE_NS
1493 const char *etc_dir = ns_etc_directory ();
1494 const char *path_exec = ns_exec_path ();
1495 #endif
1497 Vdata_directory = decode_env_path ("EMACSDATA",
1498 #ifdef HAVE_NS
1499 etc_dir ? etc_dir :
1500 #endif
1501 PATH_DATA, 0);
1502 Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory));
1504 Vdoc_directory = decode_env_path ("EMACSDOC",
1505 #ifdef HAVE_NS
1506 etc_dir ? etc_dir :
1507 #endif
1508 PATH_DOC, 0);
1509 Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory));
1511 /* Check the EMACSPATH environment variable, defaulting to the
1512 PATH_EXEC path from epaths.h. */
1513 Vexec_path = decode_env_path ("EMACSPATH",
1514 #ifdef HAVE_NS
1515 path_exec ? path_exec :
1516 #endif
1517 PATH_EXEC, 0);
1518 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
1519 /* FIXME? For ns, path_exec should go at the front? */
1520 Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
1523 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1525 void
1526 init_callproc (void)
1528 bool data_dir = egetenv ("EMACSDATA") != 0;
1530 char *sh;
1531 Lisp_Object tempdir;
1532 #ifdef HAVE_NS
1533 if (data_dir == 0)
1534 data_dir = ns_etc_directory () != 0;
1535 #endif
1537 if (!NILP (Vinstallation_directory))
1539 /* Add to the path the lib-src subdir of the installation dir. */
1540 Lisp_Object tem;
1541 tem = Fexpand_file_name (build_string ("lib-src"),
1542 Vinstallation_directory);
1543 #ifndef MSDOS
1544 /* MSDOS uses wrapped binaries, so don't do this. */
1545 if (NILP (Fmember (tem, Vexec_path)))
1547 #ifdef HAVE_NS
1548 const char *path_exec = ns_exec_path ();
1549 #endif
1550 /* Running uninstalled, so default to tem rather than PATH_EXEC. */
1551 Vexec_path = decode_env_path ("EMACSPATH",
1552 #ifdef HAVE_NS
1553 path_exec ? path_exec :
1554 #endif
1555 SSDATA (tem), 0);
1556 Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
1559 Vexec_directory = Ffile_name_as_directory (tem);
1560 #endif /* not MSDOS */
1562 /* Maybe use ../etc as well as ../lib-src. */
1563 if (data_dir == 0)
1565 tem = Fexpand_file_name (build_string ("etc"),
1566 Vinstallation_directory);
1567 Vdoc_directory = Ffile_name_as_directory (tem);
1571 /* Look for the files that should be in etc. We don't use
1572 Vinstallation_directory, because these files are never installed
1573 near the executable, and they are never in the build
1574 directory when that's different from the source directory.
1576 Instead, if these files are not in the nominal place, we try the
1577 source directory. */
1578 if (data_dir == 0)
1580 Lisp_Object tem, tem1, srcdir;
1581 Lisp_Object lispdir = Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0));
1583 srcdir = Fexpand_file_name (build_string ("../src/"), lispdir);
1585 tem = Fexpand_file_name (build_string ("NEWS"), Vdata_directory);
1586 tem1 = Ffile_exists_p (tem);
1587 if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1))
1589 Lisp_Object newdir;
1590 newdir = Fexpand_file_name (build_string ("../etc/"), lispdir);
1591 tem = Fexpand_file_name (build_string ("NEWS"), newdir);
1592 tem1 = Ffile_exists_p (tem);
1593 if (!NILP (tem1))
1594 Vdata_directory = newdir;
1598 #ifndef CANNOT_DUMP
1599 if (initialized)
1600 #endif
1602 tempdir = Fdirectory_file_name (Vexec_directory);
1603 if (! file_accessible_directory_p (tempdir))
1604 dir_warning ("arch-dependent data dir", Vexec_directory);
1607 tempdir = Fdirectory_file_name (Vdata_directory);
1608 if (! file_accessible_directory_p (tempdir))
1609 dir_warning ("arch-independent data dir", Vdata_directory);
1611 sh = getenv ("SHELL");
1612 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
1614 Lisp_Object gamedir = Qnil;
1615 if (PATH_GAME)
1617 Lisp_Object path_game = build_unibyte_string (PATH_GAME);
1618 if (file_accessible_directory_p (path_game))
1619 gamedir = path_game;
1621 Vshared_game_score_directory = gamedir;
1624 void
1625 set_initial_environment (void)
1627 char **envp;
1628 for (envp = environ; *envp; envp++)
1629 Vprocess_environment = Fcons (build_string (*envp),
1630 Vprocess_environment);
1631 /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
1632 to use `delete' and friends on process-environment. */
1633 Vinitial_environment = Fcopy_sequence (Vprocess_environment);
1636 void
1637 syms_of_callproc (void)
1639 #ifndef DOS_NT
1640 Vtemp_file_name_pattern = build_string ("emacsXXXXXX");
1641 #else /* DOS_NT */
1642 Vtemp_file_name_pattern = build_string ("emXXXXXX");
1643 #endif
1644 staticpro (&Vtemp_file_name_pattern);
1646 #ifdef MSDOS
1647 synch_process_tempfile = make_number (0);
1648 staticpro (&synch_process_tempfile);
1649 #endif
1651 DEFVAR_LISP ("shell-file-name", Vshell_file_name,
1652 doc: /* File name to load inferior shells from.
1653 Initialized from the SHELL environment variable, or to a system-dependent
1654 default if SHELL is unset. See Info node `(elisp)Security Considerations'. */);
1656 DEFVAR_LISP ("exec-path", Vexec_path,
1657 doc: /* List of directories to search programs to run in subprocesses.
1658 Each element is a string (directory name) or nil (try default directory).
1660 By default the last element of this list is `exec-directory'. The
1661 last element is not always used, for example in shell completion
1662 \(`shell-dynamic-complete-command'). */);
1664 DEFVAR_LISP ("exec-suffixes", Vexec_suffixes,
1665 doc: /* List of suffixes to try to find executable file names.
1666 Each element is a string. */);
1667 Vexec_suffixes = Qnil;
1669 DEFVAR_LISP ("exec-directory", Vexec_directory,
1670 doc: /* Directory for executables for Emacs to invoke.
1671 More generally, this includes any architecture-dependent files
1672 that are built and installed from the Emacs distribution. */);
1674 DEFVAR_LISP ("data-directory", Vdata_directory,
1675 doc: /* Directory of machine-independent files that come with GNU Emacs.
1676 These are files intended for Emacs to use while it runs. */);
1678 DEFVAR_LISP ("doc-directory", Vdoc_directory,
1679 doc: /* Directory containing the DOC file that comes with GNU Emacs.
1680 This is usually the same as `data-directory'. */);
1682 DEFVAR_LISP ("configure-info-directory", Vconfigure_info_directory,
1683 doc: /* For internal use by the build procedure only.
1684 This is the name of the directory in which the build procedure installed
1685 Emacs's info files; the default value for `Info-default-directory-list'
1686 includes this. */);
1687 Vconfigure_info_directory = build_string (PATH_INFO);
1689 DEFVAR_LISP ("shared-game-score-directory", Vshared_game_score_directory,
1690 doc: /* Directory of score files for games which come with GNU Emacs.
1691 If this variable is nil, then Emacs is unable to use a shared directory. */);
1693 DEFVAR_LISP ("initial-environment", Vinitial_environment,
1694 doc: /* List of environment variables inherited from the parent process.
1695 Each element should be a string of the form ENVVARNAME=VALUE.
1696 The elements must normally be decoded (using `locale-coding-system') for use. */);
1697 Vinitial_environment = Qnil;
1699 DEFVAR_LISP ("process-environment", Vprocess_environment,
1700 doc: /* List of overridden environment variables for subprocesses to inherit.
1701 Each element should be a string of the form ENVVARNAME=VALUE.
1703 Entries in this list take precedence to those in the frame-local
1704 environments. Therefore, let-binding `process-environment' is an easy
1705 way to temporarily change the value of an environment variable,
1706 irrespective of where it comes from. To use `process-environment' to
1707 remove an environment variable, include only its name in the list,
1708 without "=VALUE".
1710 This variable is set to nil when Emacs starts.
1712 If multiple entries define the same variable, the first one always
1713 takes precedence.
1715 Non-ASCII characters are encoded according to the initial value of
1716 `locale-coding-system', i.e. the elements must normally be decoded for
1717 use.
1719 See `setenv' and `getenv'. */);
1720 Vprocess_environment = Qnil;
1722 defsubr (&Scall_process);
1723 defsubr (&Sgetenv_internal);
1724 defsubr (&Scall_process_region);