Encode non-ASCII SVG texts
[emacs.git] / src / callproc.c
blob8f13e98fd11664df178c0d90f621f0e791b80f53
1 /* Synchronous subprocess invocation for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-1995, 1999-2017 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 bool volatile sa_must_free_volatile = sa_must_free;
603 int volatile fd_error_volatile = fd_error;
604 int volatile filefd_volatile = filefd;
605 ptrdiff_t volatile count_volatile = count;
606 ptrdiff_t volatile sa_avail_volatile = sa_avail;
607 ptrdiff_t volatile sa_count_volatile = sa_count;
608 char **volatile new_argv_volatile = new_argv;
609 int volatile callproc_fd_volatile[CALLPROC_FDS];
610 for (i = 0; i < CALLPROC_FDS; i++)
611 callproc_fd_volatile[i] = callproc_fd[i];
613 pid = vfork ();
615 buffer = buffer_volatile;
616 coding_systems = coding_systems_volatile;
617 current_dir = current_dir_volatile;
618 display_p = display_p_volatile;
619 sa_must_free = sa_must_free_volatile;
620 fd_error = fd_error_volatile;
621 filefd = filefd_volatile;
622 count = count_volatile;
623 sa_avail = sa_avail_volatile;
624 sa_count = sa_count_volatile;
625 new_argv = new_argv_volatile;
627 for (i = 0; i < CALLPROC_FDS; i++)
628 callproc_fd[i] = callproc_fd_volatile[i];
629 fd_output = callproc_fd[CALLPROC_STDOUT];
632 if (pid == 0)
634 #ifdef DARWIN_OS
635 /* Work around a macOS bug, where SIGCHLD is apparently
636 delivered to a vforked child instead of to its parent. See:
637 https://lists.gnu.org/archive/html/emacs-devel/2017-05/msg00342.html
639 signal (SIGCHLD, SIG_DFL);
640 #endif
642 unblock_child_signal (&oldset);
644 #ifdef DARWIN_OS
645 /* Darwin doesn't let us run setsid after a vfork, so use
646 TIOCNOTTY when necessary. */
647 int j = emacs_open (DEV_TTY, O_RDWR, 0);
648 if (j >= 0)
650 ioctl (j, TIOCNOTTY, 0);
651 emacs_close (j);
653 #else
654 setsid ();
655 #endif
657 /* Emacs ignores SIGPIPE, but the child should not. */
658 signal (SIGPIPE, SIG_DFL);
659 /* Likewise for SIGPROF. */
660 #ifdef SIGPROF
661 signal (SIGPROF, SIG_DFL);
662 #endif
664 child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir);
667 #endif /* not WINDOWSNT */
669 child_errno = errno;
671 if (pid > 0)
673 synch_process_pid = pid;
675 if (INTEGERP (buffer))
677 if (tempfile_index < 0)
678 record_deleted_pid (pid, Qnil);
679 else
681 eassert (1 < nargs);
682 record_deleted_pid (pid, args[1]);
683 clear_unwind_protect (tempfile_index);
685 synch_process_pid = 0;
689 unblock_child_signal (&oldset);
690 unblock_input ();
692 if (pid < 0)
693 report_file_errno ("Doing vfork", Qnil, child_errno);
695 /* Close our file descriptors, except for callproc_fd[CALLPROC_PIPEREAD]
696 since we will use that to read input from. */
697 for (i = 0; i < CALLPROC_FDS; i++)
698 if (i != CALLPROC_PIPEREAD && 0 <= callproc_fd[i])
700 emacs_close (callproc_fd[i]);
701 callproc_fd[i] = -1;
703 emacs_close (filefd);
704 clear_unwind_protect (count - 1);
706 #endif /* not MSDOS */
708 if (INTEGERP (buffer))
709 return unbind_to (count, Qnil);
711 if (BUFFERP (buffer))
712 Fset_buffer (buffer);
714 fd0 = callproc_fd[CALLPROC_PIPEREAD];
716 if (0 <= fd0)
718 Lisp_Object val, *args2;
720 val = Qnil;
721 if (!NILP (Vcoding_system_for_read))
722 val = Vcoding_system_for_read;
723 else
725 if (EQ (coding_systems, Qt))
727 ptrdiff_t i;
729 SAFE_NALLOCA (args2, 1, nargs + 1);
730 args2[0] = Qcall_process;
731 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
732 coding_systems
733 = Ffind_operation_coding_system (nargs + 1, args2);
735 if (CONSP (coding_systems))
736 val = XCAR (coding_systems);
737 else if (CONSP (Vdefault_process_coding_system))
738 val = XCAR (Vdefault_process_coding_system);
739 else
740 val = Qnil;
742 Fcheck_coding_system (val);
743 /* In unibyte mode, character code conversion should not take
744 place but EOL conversion should. So, setup raw-text or one
745 of the subsidiary according to the information just setup. */
746 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
747 && !NILP (val))
748 val = raw_text_coding_system (val);
749 setup_coding_system (val, &process_coding);
750 process_coding.dst_multibyte
751 = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
752 process_coding.src_multibyte = 0;
755 if (0 <= fd0)
757 enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 };
758 enum { CALLPROC_BUFFER_SIZE_MAX = 4 * CALLPROC_BUFFER_SIZE_MIN };
759 char buf[CALLPROC_BUFFER_SIZE_MAX];
760 int bufsize = CALLPROC_BUFFER_SIZE_MIN;
761 int nread;
762 EMACS_INT total_read = 0;
763 int carryover = 0;
764 bool display_on_the_fly = display_p;
765 struct coding_system saved_coding = process_coding;
767 while (1)
769 /* Repeatedly read until we've filled as much as possible
770 of the buffer size we have. But don't read
771 less than 1024--save that for the next bufferful. */
772 nread = carryover;
773 while (nread < bufsize - 1024)
775 int this_read = emacs_read_quit (fd0, buf + nread,
776 bufsize - nread);
778 if (this_read < 0)
779 goto give_up;
781 if (this_read == 0)
783 process_coding.mode |= CODING_MODE_LAST_BLOCK;
784 break;
787 nread += this_read;
788 total_read += this_read;
790 if (display_on_the_fly)
791 break;
794 /* Now NREAD is the total amount of data in the buffer. */
796 if (!nread)
798 else if (NILP (BVAR (current_buffer, enable_multibyte_characters))
799 && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
800 insert_1_both (buf, nread, nread, 0, 1, 0);
801 else
802 { /* We have to decode the input. */
803 Lisp_Object curbuf;
804 ptrdiff_t count1 = SPECPDL_INDEX ();
806 XSETBUFFER (curbuf, current_buffer);
807 /* FIXME: Call signal_after_change! */
808 prepare_to_modify_buffer (PT, PT, NULL);
809 /* We cannot allow after-change-functions be run
810 during decoding, because that might modify the
811 buffer, while we rely on process_coding.produced to
812 faithfully reflect inserted text until we
813 TEMP_SET_PT_BOTH below. */
814 specbind (Qinhibit_modification_hooks, Qt);
815 decode_coding_c_string (&process_coding,
816 (unsigned char *) buf, nread, curbuf);
817 unbind_to (count1, Qnil);
818 if (display_on_the_fly
819 && CODING_REQUIRE_DETECTION (&saved_coding)
820 && ! CODING_REQUIRE_DETECTION (&process_coding))
822 /* We have detected some coding system, but the
823 detection may have been via insufficient data.
824 So give up displaying on the fly. */
825 if (process_coding.produced > 0)
826 del_range_2 (process_coding.dst_pos,
827 process_coding.dst_pos_byte,
828 (process_coding.dst_pos
829 + process_coding.produced_char),
830 (process_coding.dst_pos_byte
831 + process_coding.produced),
833 display_on_the_fly = false;
834 process_coding = saved_coding;
835 carryover = nread;
836 /* Make the above condition always fail in the future. */
837 saved_coding.common_flags
838 &= ~CODING_REQUIRE_DETECTION_MASK;
839 continue;
842 TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
843 PT_BYTE + process_coding.produced);
844 carryover = process_coding.carryover_bytes;
845 if (carryover > 0)
846 memcpy (buf, process_coding.carryover,
847 process_coding.carryover_bytes);
850 if (process_coding.mode & CODING_MODE_LAST_BLOCK)
851 break;
853 /* Make the buffer bigger as we continue to read more data,
854 but not past CALLPROC_BUFFER_SIZE_MAX. */
855 if (bufsize < CALLPROC_BUFFER_SIZE_MAX && total_read > 32 * bufsize)
856 if ((bufsize *= 2) > CALLPROC_BUFFER_SIZE_MAX)
857 bufsize = CALLPROC_BUFFER_SIZE_MAX;
859 if (display_p)
861 redisplay_preserve_echo_area (1);
862 /* This variable might have been set to 0 for code
863 detection. In that case, set it back to 1 because
864 we should have already detected a coding system. */
865 display_on_the_fly = true;
868 give_up: ;
870 Vlast_coding_system_used = CODING_ID_NAME (process_coding.id);
871 /* If the caller required, let the buffer inherit the
872 coding-system used to decode the process output. */
873 if (inherit_process_coding_system)
874 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
875 make_number (total_read));
878 bool wait_ok = true;
879 #ifndef MSDOS
880 /* Wait for it to terminate, unless it already has. */
881 wait_ok = wait_for_termination (pid, &status, fd0 < 0);
882 #endif
884 /* Don't kill any children that the subprocess may have left behind
885 when exiting. */
886 synch_process_pid = 0;
888 SAFE_FREE ();
889 unbind_to (count, Qnil);
891 if (!wait_ok)
892 return build_unibyte_string ("internal error");
894 if (WIFSIGNALED (status))
896 const char *signame;
898 synchronize_system_messages_locale ();
899 signame = strsignal (WTERMSIG (status));
901 if (signame == 0)
902 signame = "unknown";
904 return code_convert_string_norecord (build_string (signame),
905 Vlocale_coding_system, 0);
908 eassert (WIFEXITED (status));
909 return make_number (WEXITSTATUS (status));
912 /* Create a temporary file suitable for storing the input data of
913 call-process-region. NARGS and ARGS are the same as for
914 call-process-region. Store into *FILENAME_STRING_PTR a Lisp string
915 naming the file, and return a file descriptor for reading.
916 Unwind-protect the file, so that the file descriptor will be closed
917 and the file removed when the caller unwinds the specpdl stack. */
919 static int
920 create_temp_file (ptrdiff_t nargs, Lisp_Object *args,
921 Lisp_Object *filename_string_ptr)
923 int fd;
924 Lisp_Object filename_string;
925 Lisp_Object val, start, end;
926 Lisp_Object tmpdir;
928 if (STRINGP (Vtemporary_file_directory))
929 tmpdir = Vtemporary_file_directory;
930 else
932 char *outf;
933 #ifndef DOS_NT
934 outf = getenv ("TMPDIR");
935 tmpdir = build_string (outf ? outf : "/tmp/");
936 #else /* DOS_NT */
937 if ((outf = egetenv ("TMPDIR"))
938 || (outf = egetenv ("TMP"))
939 || (outf = egetenv ("TEMP")))
940 tmpdir = build_string (outf);
941 else
942 tmpdir = Ffile_name_as_directory (build_string ("c:/temp"));
943 #endif
947 Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
948 char *tempfile;
949 ptrdiff_t count;
951 #ifdef WINDOWSNT
952 /* Cannot use the result of Fexpand_file_name, because it
953 downcases the XXXXXX part of the pattern, and mktemp then
954 doesn't recognize it. */
955 if (!NILP (Vw32_downcase_file_names))
957 Lisp_Object dirname = Ffile_name_directory (pattern);
959 if (NILP (dirname))
960 pattern = Vtemp_file_name_pattern;
961 else
962 pattern = concat2 (dirname, Vtemp_file_name_pattern);
964 #endif
966 filename_string = Fcopy_sequence (ENCODE_FILE (pattern));
967 tempfile = SSDATA (filename_string);
969 count = SPECPDL_INDEX ();
970 record_unwind_protect_nothing ();
971 fd = mkostemp (tempfile, O_BINARY | O_CLOEXEC);
972 if (fd < 0)
973 report_file_error ("Failed to open temporary file using pattern",
974 pattern);
975 set_unwind_protect (count, delete_temp_file, filename_string);
976 record_unwind_protect_int (close_file_unwind, fd);
979 start = args[0];
980 end = args[1];
981 /* Decide coding-system of the contents of the temporary file. */
982 if (!NILP (Vcoding_system_for_write))
983 val = Vcoding_system_for_write;
984 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
985 val = Qraw_text;
986 else
988 Lisp_Object coding_systems;
989 Lisp_Object *args2;
990 USE_SAFE_ALLOCA;
991 SAFE_NALLOCA (args2, 1, nargs + 1);
992 args2[0] = Qcall_process_region;
993 memcpy (args2 + 1, args, nargs * sizeof *args);
994 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
995 val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
996 SAFE_FREE ();
998 val = complement_process_encoding_system (val);
1001 ptrdiff_t count1 = SPECPDL_INDEX ();
1003 specbind (intern ("coding-system-for-write"), val);
1004 /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
1005 happen to get a ".Z" suffix. */
1006 specbind (Qfile_name_handler_alist, Qnil);
1007 write_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil, fd);
1009 unbind_to (count1, Qnil);
1012 if (lseek (fd, 0, SEEK_SET) < 0)
1013 report_file_error ("Setting file position", filename_string);
1015 /* Note that Fcall_process takes care of binding
1016 coding-system-for-read. */
1018 *filename_string_ptr = filename_string;
1019 return fd;
1022 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
1023 3, MANY, 0,
1024 doc: /* Send text from START to END to a synchronous process running PROGRAM.
1026 START and END are normally buffer positions specifying the part of the
1027 buffer to send to the process.
1028 If START is nil, that means to use the entire buffer contents; END is
1029 ignored.
1030 If START is a string, then send that string to the process
1031 instead of any buffer contents; END is ignored.
1032 The remaining arguments are optional.
1033 Delete the text if fourth arg DELETE is non-nil.
1035 Insert output in BUFFER before point; t means current buffer; nil for
1036 BUFFER means discard it; 0 means discard and don't wait; and `(:file
1037 FILE)', where FILE is a file name string, means that it should be
1038 written to that file (if the file already exists it is overwritten).
1039 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
1040 REAL-BUFFER says what to do with standard output, as above,
1041 while STDERR-FILE says what to do with standard error in the child.
1042 STDERR-FILE may be nil (discard standard error output),
1043 t (mix it with ordinary output), or a file name string.
1045 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
1046 Remaining args are passed to PROGRAM at startup as command args.
1048 If BUFFER is 0, `call-process-region' returns immediately with value nil.
1049 Otherwise it waits for PROGRAM to terminate
1050 and returns a numeric exit status or a signal description string.
1051 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
1053 usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
1054 (ptrdiff_t nargs, Lisp_Object *args)
1056 Lisp_Object infile, val;
1057 ptrdiff_t count = SPECPDL_INDEX ();
1058 Lisp_Object start = args[0];
1059 Lisp_Object end = args[1];
1060 bool empty_input;
1061 int fd;
1063 if (STRINGP (start))
1064 empty_input = SCHARS (start) == 0;
1065 else if (NILP (start))
1066 empty_input = BEG == Z;
1067 else
1069 validate_region (&args[0], &args[1]);
1070 start = args[0];
1071 end = args[1];
1072 empty_input = XINT (start) == XINT (end);
1075 if (!empty_input)
1076 fd = create_temp_file (nargs, args, &infile);
1077 else
1079 infile = Qnil;
1080 fd = emacs_open (NULL_DEVICE, O_RDONLY, 0);
1081 if (fd < 0)
1082 report_file_error ("Opening null device", Qnil);
1083 record_unwind_protect_int (close_file_unwind, fd);
1086 if (nargs > 3 && !NILP (args[3]))
1087 Fdelete_region (start, end);
1089 if (nargs > 3)
1091 args += 2;
1092 nargs -= 2;
1094 else
1096 args[0] = args[2];
1097 nargs = 2;
1099 args[1] = infile;
1101 val = call_process (nargs, args, fd, empty_input ? -1 : count);
1102 return unbind_to (count, val);
1105 static char **
1106 add_env (char **env, char **new_env, char *string)
1108 char **ep;
1109 bool ok = 1;
1110 if (string == NULL)
1111 return new_env;
1113 /* See if this string duplicates any string already in the env.
1114 If so, don't put it in.
1115 When an env var has multiple definitions,
1116 we keep the definition that comes first in process-environment. */
1117 for (ep = env; ok && ep != new_env; ep++)
1119 char *p = *ep, *q = string;
1120 while (ok)
1122 if (*p && *q != *p)
1123 break;
1124 if (*q == 0)
1125 /* The string is a lone variable name; keep it for now, we
1126 will remove it later. It is a placeholder for a
1127 variable that is not to be included in the environment. */
1128 break;
1129 if (*q == '=')
1130 ok = 0;
1131 p++, q++;
1134 if (ok)
1135 *new_env++ = string;
1136 return new_env;
1139 #ifndef DOS_NT
1141 /* 'exec' failed inside a child running NAME, with error number ERR.
1142 Possibly a vforked child needed to allocate a large vector on the
1143 stack; such a child cannot fall back on malloc because that might
1144 mess up the allocator's data structures in the parent.
1145 Report the error and exit the child. */
1147 static _Noreturn void
1148 exec_failed (char const *name, int err)
1150 /* Avoid deadlock if the child's perror writes to a full pipe; the
1151 pipe's reader is the parent, but with vfork the parent can't
1152 run until the child exits. Truncate the diagnostic instead. */
1153 fcntl (STDERR_FILENO, F_SETFL, O_NONBLOCK);
1155 errno = err;
1156 emacs_perror (name);
1157 _exit (err == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE);
1160 #else
1162 /* Do nothing. There is no need to fail, as DOS_NT platforms do not
1163 fork and exec, and handle alloca exhaustion in a different way. */
1165 static void
1166 exec_failed (char const *name, int err)
1170 #endif
1172 /* This is the last thing run in a newly forked inferior
1173 either synchronous or asynchronous.
1174 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
1175 Initialize inferior's priority, pgrp, connected dir and environment.
1176 then exec another program based on new_argv.
1178 If SET_PGRP, put the subprocess into a separate process group.
1180 CURRENT_DIR is an elisp string giving the path of the current
1181 directory the subprocess should have. Since we can't really signal
1182 a decent error from within the child, this should be verified as an
1183 executable directory by the parent.
1185 On GNUish hosts, either exec or return an error number.
1186 On MS-Windows, either return a pid or signal an error.
1187 On MS-DOS, either return an exit status or signal an error. */
1189 CHILD_SETUP_TYPE
1190 child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
1191 Lisp_Object current_dir)
1193 char **env;
1194 char *pwd_var;
1195 #ifdef WINDOWSNT
1196 int cpid;
1197 HANDLE handles[3];
1198 #else
1199 pid_t pid = getpid ();
1200 #endif /* WINDOWSNT */
1202 /* Note that use of alloca is always safe here. It's obvious for systems
1203 that do not have true vfork or that have true (stack) alloca.
1204 If using vfork and C_ALLOCA (when Emacs used to include
1205 src/alloca.c) it is safe because that changes the superior's
1206 static variables as if the superior had done alloca and will be
1207 cleaned up in the usual way. */
1209 char *temp;
1210 ptrdiff_t i;
1212 i = SBYTES (current_dir);
1213 #ifdef MSDOS
1214 /* MSDOS must have all environment variables malloc'ed, because
1215 low-level libc functions that launch subsidiary processes rely
1216 on that. */
1217 pwd_var = xmalloc (i + 5);
1218 #else
1219 if (MAX_ALLOCA - 5 < i)
1220 exec_failed (new_argv[0], ENOMEM);
1221 pwd_var = alloca (i + 5);
1222 #endif
1223 temp = pwd_var + 4;
1224 memcpy (pwd_var, "PWD=", 4);
1225 lispstpcpy (temp, current_dir);
1227 #ifndef DOS_NT
1228 /* We can't signal an Elisp error here; we're in a vfork. Since
1229 the callers check the current directory before forking, this
1230 should only return an error if the directory's permissions
1231 are changed between the check and this chdir, but we should
1232 at least check. */
1233 if (chdir (temp) < 0)
1234 _exit (EXIT_CANCELED);
1235 #else /* DOS_NT */
1236 /* Get past the drive letter, so that d:/ is left alone. */
1237 if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
1239 temp += 2;
1240 i -= 2;
1242 #endif /* DOS_NT */
1244 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1245 while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
1246 temp[--i] = 0;
1249 /* Set `env' to a vector of the strings in the environment. */
1251 register Lisp_Object tem;
1252 register char **new_env;
1253 char **p, **q;
1254 register int new_length;
1255 Lisp_Object display = Qnil;
1257 new_length = 0;
1259 for (tem = Vprocess_environment;
1260 CONSP (tem) && STRINGP (XCAR (tem));
1261 tem = XCDR (tem))
1263 if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0
1264 && (SDATA (XCAR (tem)) [7] == '\0'
1265 || SDATA (XCAR (tem)) [7] == '='))
1266 /* DISPLAY is specified in process-environment. */
1267 display = Qt;
1268 new_length++;
1271 /* If not provided yet, use the frame's DISPLAY. */
1272 if (NILP (display))
1274 Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
1275 if (!STRINGP (tmp) && CONSP (Vinitial_environment))
1276 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1277 tmp = Fgetenv_internal (build_string ("DISPLAY"),
1278 Vinitial_environment);
1279 if (STRINGP (tmp))
1281 display = tmp;
1282 new_length++;
1286 /* new_length + 2 to include PWD and terminating 0. */
1287 if (MAX_ALLOCA / sizeof *env - 2 < new_length)
1288 exec_failed (new_argv[0], ENOMEM);
1289 env = new_env = alloca ((new_length + 2) * sizeof *env);
1290 /* If we have a PWD envvar, pass one down,
1291 but with corrected value. */
1292 if (egetenv ("PWD"))
1293 *new_env++ = pwd_var;
1295 if (STRINGP (display))
1297 if (MAX_ALLOCA - sizeof "DISPLAY=" < SBYTES (display))
1298 exec_failed (new_argv[0], ENOMEM);
1299 char *vdata = alloca (sizeof "DISPLAY=" + SBYTES (display));
1300 lispstpcpy (stpcpy (vdata, "DISPLAY="), display);
1301 new_env = add_env (env, new_env, vdata);
1304 /* Overrides. */
1305 for (tem = Vprocess_environment;
1306 CONSP (tem) && STRINGP (XCAR (tem));
1307 tem = XCDR (tem))
1308 new_env = add_env (env, new_env, SSDATA (XCAR (tem)));
1310 *new_env = 0;
1312 /* Remove variable names without values. */
1313 p = q = env;
1314 while (*p != 0)
1316 while (*q != 0 && strchr (*q, '=') == NULL)
1317 q++;
1318 *p = *q++;
1319 if (*p != 0)
1320 p++;
1325 #ifdef WINDOWSNT
1326 prepare_standard_handles (in, out, err, handles);
1327 set_process_dir (SSDATA (current_dir));
1328 /* Spawn the child. (See w32proc.c:sys_spawnve). */
1329 cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
1330 reset_standard_handles (in, out, err, handles);
1331 if (cpid == -1)
1332 /* An error occurred while trying to spawn the process. */
1333 report_file_error ("Spawning child process", Qnil);
1334 return cpid;
1336 #else /* not WINDOWSNT */
1338 #ifndef MSDOS
1340 restore_nofile_limit ();
1342 /* Redirect file descriptors and clear the close-on-exec flag on the
1343 redirected ones. IN, OUT, and ERR are close-on-exec so they
1344 need not be closed explicitly. */
1345 dup2 (in, STDIN_FILENO);
1346 dup2 (out, STDOUT_FILENO);
1347 dup2 (err, STDERR_FILENO);
1349 setpgid (0, 0);
1350 tcsetpgrp (0, pid);
1352 int errnum = emacs_exec_file (new_argv[0], new_argv, env);
1353 exec_failed (new_argv[0], errnum);
1355 #else /* MSDOS */
1356 pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
1357 xfree (pwd_var);
1358 if (pid == -1)
1359 /* An error occurred while trying to run the subprocess. */
1360 report_file_error ("Spawning child process", Qnil);
1361 return pid;
1362 #endif /* MSDOS */
1363 #endif /* not WINDOWSNT */
1366 static bool
1367 getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
1368 ptrdiff_t *valuelen, Lisp_Object env)
1370 for (; CONSP (env); env = XCDR (env))
1372 Lisp_Object entry = XCAR (env);
1373 if (STRINGP (entry)
1374 && SBYTES (entry) >= varlen
1375 #ifdef WINDOWSNT
1376 /* NT environment variables are case insensitive. */
1377 && ! strnicmp (SSDATA (entry), var, varlen)
1378 #else /* not WINDOWSNT */
1379 && ! memcmp (SDATA (entry), var, varlen)
1380 #endif /* not WINDOWSNT */
1383 if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
1385 *value = SSDATA (entry) + (varlen + 1);
1386 *valuelen = SBYTES (entry) - (varlen + 1);
1387 return 1;
1389 else if (SBYTES (entry) == varlen)
1391 /* Lone variable names in Vprocess_environment mean that
1392 variable should be removed from the environment. */
1393 *value = NULL;
1394 return 1;
1398 return 0;
1401 static bool
1402 getenv_internal (const char *var, ptrdiff_t varlen, char **value,
1403 ptrdiff_t *valuelen, Lisp_Object frame)
1405 /* Try to find VAR in Vprocess_environment first. */
1406 if (getenv_internal_1 (var, varlen, value, valuelen,
1407 Vprocess_environment))
1408 return *value ? 1 : 0;
1410 /* On Windows we make some modifications to Emacs' environment
1411 without recording them in Vprocess_environment. */
1412 #ifdef WINDOWSNT
1414 char *tmpval = getenv (var);
1415 if (tmpval)
1417 *value = tmpval;
1418 *valuelen = strlen (tmpval);
1419 return 1;
1422 #endif
1424 /* For DISPLAY try to get the values from the frame or the initial env. */
1425 if (strcmp (var, "DISPLAY") == 0)
1427 Lisp_Object display
1428 = Fframe_parameter (NILP (frame) ? selected_frame : frame, Qdisplay);
1429 if (STRINGP (display))
1431 *value = SSDATA (display);
1432 *valuelen = SBYTES (display);
1433 return 1;
1435 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1436 if (getenv_internal_1 (var, varlen, value, valuelen,
1437 Vinitial_environment))
1438 return *value ? 1 : 0;
1441 return 0;
1444 DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
1445 doc: /* Get the value of environment variable VARIABLE.
1446 VARIABLE should be a string. Value is nil if VARIABLE is undefined in
1447 the environment. Otherwise, value is a string.
1449 This function searches `process-environment' for VARIABLE.
1451 If optional parameter ENV is a list, then search this list instead of
1452 `process-environment', and return t when encountering a negative entry
1453 \(an entry for a variable with no value). */)
1454 (Lisp_Object variable, Lisp_Object env)
1456 char *value;
1457 ptrdiff_t valuelen;
1459 CHECK_STRING (variable);
1460 if (CONSP (env))
1462 if (getenv_internal_1 (SSDATA (variable), SBYTES (variable),
1463 &value, &valuelen, env))
1464 return value ? make_string (value, valuelen) : Qt;
1465 else
1466 return Qnil;
1468 else if (getenv_internal (SSDATA (variable), SBYTES (variable),
1469 &value, &valuelen, env))
1470 return make_string (value, valuelen);
1471 else
1472 return Qnil;
1475 /* A version of getenv that consults the Lisp environment lists,
1476 easily callable from C. This is usually called from egetenv. */
1477 char *
1478 egetenv_internal (const char *var, ptrdiff_t len)
1480 char *value;
1481 ptrdiff_t valuelen;
1483 if (getenv_internal (var, len, &value, &valuelen, Qnil))
1484 return value;
1485 else
1486 return 0;
1490 /* This is run before init_cmdargs. */
1492 void
1493 init_callproc_1 (void)
1495 #ifdef HAVE_NS
1496 const char *etc_dir = ns_etc_directory ();
1497 const char *path_exec = ns_exec_path ();
1498 #endif
1500 Vdata_directory = decode_env_path ("EMACSDATA",
1501 #ifdef HAVE_NS
1502 etc_dir ? etc_dir :
1503 #endif
1504 PATH_DATA, 0);
1505 Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory));
1507 Vdoc_directory = decode_env_path ("EMACSDOC",
1508 #ifdef HAVE_NS
1509 etc_dir ? etc_dir :
1510 #endif
1511 PATH_DOC, 0);
1512 Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory));
1514 /* Check the EMACSPATH environment variable, defaulting to the
1515 PATH_EXEC path from epaths.h. */
1516 Vexec_path = decode_env_path ("EMACSPATH",
1517 #ifdef HAVE_NS
1518 path_exec ? path_exec :
1519 #endif
1520 PATH_EXEC, 0);
1521 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
1522 /* FIXME? For ns, path_exec should go at the front? */
1523 Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
1526 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1528 void
1529 init_callproc (void)
1531 bool data_dir = egetenv ("EMACSDATA") != 0;
1533 char *sh;
1534 Lisp_Object tempdir;
1535 #ifdef HAVE_NS
1536 if (data_dir == 0)
1537 data_dir = ns_etc_directory () != 0;
1538 #endif
1540 if (!NILP (Vinstallation_directory))
1542 /* Add to the path the lib-src subdir of the installation dir. */
1543 Lisp_Object tem;
1544 tem = Fexpand_file_name (build_string ("lib-src"),
1545 Vinstallation_directory);
1546 #ifndef MSDOS
1547 /* MSDOS uses wrapped binaries, so don't do this. */
1548 if (NILP (Fmember (tem, Vexec_path)))
1550 #ifdef HAVE_NS
1551 const char *path_exec = ns_exec_path ();
1552 #endif
1553 /* Running uninstalled, so default to tem rather than PATH_EXEC. */
1554 Vexec_path = decode_env_path ("EMACSPATH",
1555 #ifdef HAVE_NS
1556 path_exec ? path_exec :
1557 #endif
1558 SSDATA (tem), 0);
1559 Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
1562 Vexec_directory = Ffile_name_as_directory (tem);
1563 #endif /* not MSDOS */
1565 /* Maybe use ../etc as well as ../lib-src. */
1566 if (data_dir == 0)
1568 tem = Fexpand_file_name (build_string ("etc"),
1569 Vinstallation_directory);
1570 Vdoc_directory = Ffile_name_as_directory (tem);
1574 /* Look for the files that should be in etc. We don't use
1575 Vinstallation_directory, because these files are never installed
1576 near the executable, and they are never in the build
1577 directory when that's different from the source directory.
1579 Instead, if these files are not in the nominal place, we try the
1580 source directory. */
1581 if (data_dir == 0)
1583 Lisp_Object tem, tem1, srcdir;
1584 Lisp_Object lispdir = Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0));
1586 srcdir = Fexpand_file_name (build_string ("../src/"), lispdir);
1588 tem = Fexpand_file_name (build_string ("NEWS"), Vdata_directory);
1589 tem1 = Ffile_exists_p (tem);
1590 if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1))
1592 Lisp_Object newdir;
1593 newdir = Fexpand_file_name (build_string ("../etc/"), lispdir);
1594 tem = Fexpand_file_name (build_string ("NEWS"), newdir);
1595 tem1 = Ffile_exists_p (tem);
1596 if (!NILP (tem1))
1597 Vdata_directory = newdir;
1601 #ifndef CANNOT_DUMP
1602 if (initialized)
1603 #endif
1605 tempdir = Fdirectory_file_name (Vexec_directory);
1606 if (! file_accessible_directory_p (tempdir))
1607 dir_warning ("arch-dependent data dir", Vexec_directory);
1610 tempdir = Fdirectory_file_name (Vdata_directory);
1611 if (! file_accessible_directory_p (tempdir))
1612 dir_warning ("arch-independent data dir", Vdata_directory);
1614 sh = getenv ("SHELL");
1615 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
1617 Lisp_Object gamedir = Qnil;
1618 if (PATH_GAME)
1620 Lisp_Object path_game = build_unibyte_string (PATH_GAME);
1621 if (file_accessible_directory_p (path_game))
1622 gamedir = path_game;
1624 Vshared_game_score_directory = gamedir;
1627 void
1628 set_initial_environment (void)
1630 char **envp;
1631 for (envp = environ; *envp; envp++)
1632 Vprocess_environment = Fcons (build_string (*envp),
1633 Vprocess_environment);
1634 /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
1635 to use `delete' and friends on process-environment. */
1636 Vinitial_environment = Fcopy_sequence (Vprocess_environment);
1639 void
1640 syms_of_callproc (void)
1642 #ifndef DOS_NT
1643 Vtemp_file_name_pattern = build_string ("emacsXXXXXX");
1644 #else /* DOS_NT */
1645 Vtemp_file_name_pattern = build_string ("emXXXXXX");
1646 #endif
1647 staticpro (&Vtemp_file_name_pattern);
1649 #ifdef MSDOS
1650 synch_process_tempfile = make_number (0);
1651 staticpro (&synch_process_tempfile);
1652 #endif
1654 DEFVAR_LISP ("shell-file-name", Vshell_file_name,
1655 doc: /* File name to load inferior shells from.
1656 Initialized from the SHELL environment variable, or to a system-dependent
1657 default if SHELL is unset. See Info node `(elisp)Security Considerations'. */);
1659 DEFVAR_LISP ("exec-path", Vexec_path,
1660 doc: /* List of directories to search programs to run in subprocesses.
1661 Each element is a string (directory name) or nil (try default directory).
1663 By default the last element of this list is `exec-directory'. The
1664 last element is not always used, for example in shell completion
1665 \(`shell-dynamic-complete-command'). */);
1667 DEFVAR_LISP ("exec-suffixes", Vexec_suffixes,
1668 doc: /* List of suffixes to try to find executable file names.
1669 Each element is a string. */);
1670 Vexec_suffixes = Qnil;
1672 DEFVAR_LISP ("exec-directory", Vexec_directory,
1673 doc: /* Directory for executables for Emacs to invoke.
1674 More generally, this includes any architecture-dependent files
1675 that are built and installed from the Emacs distribution. */);
1677 DEFVAR_LISP ("data-directory", Vdata_directory,
1678 doc: /* Directory of machine-independent files that come with GNU Emacs.
1679 These are files intended for Emacs to use while it runs. */);
1681 DEFVAR_LISP ("doc-directory", Vdoc_directory,
1682 doc: /* Directory containing the DOC file that comes with GNU Emacs.
1683 This is usually the same as `data-directory'. */);
1685 DEFVAR_LISP ("configure-info-directory", Vconfigure_info_directory,
1686 doc: /* For internal use by the build procedure only.
1687 This is the name of the directory in which the build procedure installed
1688 Emacs's info files; the default value for `Info-default-directory-list'
1689 includes this. */);
1690 Vconfigure_info_directory = build_string (PATH_INFO);
1692 DEFVAR_LISP ("shared-game-score-directory", Vshared_game_score_directory,
1693 doc: /* Directory of score files for games which come with GNU Emacs.
1694 If this variable is nil, then Emacs is unable to use a shared directory. */);
1696 DEFVAR_LISP ("initial-environment", Vinitial_environment,
1697 doc: /* List of environment variables inherited from the parent process.
1698 Each element should be a string of the form ENVVARNAME=VALUE.
1699 The elements must normally be decoded (using `locale-coding-system') for use. */);
1700 Vinitial_environment = Qnil;
1702 DEFVAR_LISP ("process-environment", Vprocess_environment,
1703 doc: /* List of overridden environment variables for subprocesses to inherit.
1704 Each element should be a string of the form ENVVARNAME=VALUE.
1706 Entries in this list take precedence to those in the frame-local
1707 environments. Therefore, let-binding `process-environment' is an easy
1708 way to temporarily change the value of an environment variable,
1709 irrespective of where it comes from. To use `process-environment' to
1710 remove an environment variable, include only its name in the list,
1711 without "=VALUE".
1713 This variable is set to nil when Emacs starts.
1715 If multiple entries define the same variable, the first one always
1716 takes precedence.
1718 Non-ASCII characters are encoded according to the initial value of
1719 `locale-coding-system', i.e. the elements must normally be decoded for
1720 use.
1722 See `setenv' and `getenv'. */);
1723 Vprocess_environment = Qnil;
1725 defsubr (&Scall_process);
1726 defsubr (&Sgetenv_internal);
1727 defsubr (&Scall_process_region);