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