* gdb-mi.el (gdb-done-or-error): Guard against "%" in gdb output (tiny change)
[emacs.git] / src / callproc.c
blobc4177d5044c19d4d955f8a42ab8684eaa4388c80
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 "syswait.h"
55 #include "blockinput.h"
56 #include "frame.h"
57 #include "termhooks.h"
59 #ifdef MSDOS
60 #include "msdos.h"
61 #endif
63 #ifdef HAVE_NS
64 #include "nsterm.h"
65 #endif
67 /* Pattern used by call-process-region to make temp files. */
68 static Lisp_Object Vtemp_file_name_pattern;
70 /* True if we are about to fork off a synchronous process or if we
71 are waiting for it. */
72 bool synch_process_alive;
74 /* Nonzero => this is a string explaining death of synchronous subprocess. */
75 const char *synch_process_death;
77 /* Nonzero => this is the signal number that terminated the subprocess. */
78 int synch_process_termsig;
80 /* If synch_process_death is zero,
81 this is exit code of synchronous subprocess. */
82 int synch_process_retcode;
85 /* Clean up when exiting Fcall_process.
86 On MSDOS, delete the temporary file on any kind of termination.
87 On Unix, kill the process and any children on termination by signal. */
89 /* True if this is termination due to exit. */
90 static bool call_process_exited;
92 static Lisp_Object
93 call_process_kill (Lisp_Object fdpid)
95 int fd;
96 pid_t pid;
97 CONS_TO_INTEGER (Fcar (fdpid), int, fd);
98 CONS_TO_INTEGER (Fcdr (fdpid), pid_t, pid);
99 emacs_close (fd);
100 EMACS_KILLPG (pid, SIGKILL);
101 synch_process_alive = 0;
102 return Qnil;
105 static Lisp_Object
106 call_process_cleanup (Lisp_Object arg)
108 Lisp_Object fdpid = Fcdr (arg);
109 int fd;
110 #if defined (MSDOS)
111 Lisp_Object file;
112 #else
113 pid_t pid;
114 #endif
116 Fset_buffer (Fcar (arg));
117 CONS_TO_INTEGER (Fcar (fdpid), int, fd);
119 #if defined (MSDOS)
120 /* for MSDOS fdpid is really (fd . tempfile) */
121 file = Fcdr (fdpid);
122 /* FD is -1 and FILE is "" when we didn't actually create a
123 temporary file in call-process. */
124 if (fd >= 0)
125 emacs_close (fd);
126 if (!(strcmp (SDATA (file), NULL_DEVICE) == 0 || SREF (file, 0) == '\0'))
127 unlink (SDATA (file));
128 #else /* not MSDOS */
129 CONS_TO_INTEGER (Fcdr (fdpid), pid_t, pid);
131 if (call_process_exited)
133 emacs_close (fd);
134 return Qnil;
137 if (EMACS_KILLPG (pid, SIGINT) == 0)
139 ptrdiff_t count = SPECPDL_INDEX ();
140 record_unwind_protect (call_process_kill, fdpid);
141 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
142 immediate_quit = 1;
143 QUIT;
144 wait_for_termination (pid);
145 immediate_quit = 0;
146 specpdl_ptr = specpdl + count; /* Discard the unwind protect. */
147 message1 ("Waiting for process to die...done");
149 synch_process_alive = 0;
150 emacs_close (fd);
151 #endif /* not MSDOS */
152 return Qnil;
155 DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
156 doc: /* Call PROGRAM synchronously in separate process.
157 The remaining arguments are optional.
158 The program's input comes from file INFILE (nil means `/dev/null').
159 Insert output in BUFFER before point; t means current buffer; nil for BUFFER
160 means discard it; 0 means discard and don't wait; and `(:file FILE)', where
161 FILE is a file name string, means that it should be written to that file
162 \(if the file already exists it is overwritten).
163 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
164 REAL-BUFFER says what to do with standard output, as above,
165 while STDERR-FILE says what to do with standard error in the child.
166 STDERR-FILE may be nil (discard standard error output),
167 t (mix it with ordinary output), or a file name string.
169 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
170 Remaining arguments are strings passed as command arguments to PROGRAM.
172 If executable PROGRAM can't be found as an executable, `call-process'
173 signals a Lisp error. `call-process' reports errors in execution of
174 the program only through its return and output.
176 If BUFFER is 0, `call-process' returns immediately with value nil.
177 Otherwise it waits for PROGRAM to terminate
178 and returns a numeric exit status or a signal description string.
179 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
181 usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
182 (ptrdiff_t nargs, Lisp_Object *args)
184 Lisp_Object infile, buffer, current_dir, path, cleanup_info_tail;
185 bool display_p;
186 int fd[2];
187 int filefd;
188 #define CALLPROC_BUFFER_SIZE_MIN (16 * 1024)
189 #define CALLPROC_BUFFER_SIZE_MAX (4 * CALLPROC_BUFFER_SIZE_MIN)
190 char buf[CALLPROC_BUFFER_SIZE_MAX];
191 int bufsize = CALLPROC_BUFFER_SIZE_MIN;
192 ptrdiff_t count = SPECPDL_INDEX ();
193 USE_SAFE_ALLOCA;
195 register const unsigned char **new_argv;
196 /* File to use for stderr in the child.
197 t means use same as standard output. */
198 Lisp_Object error_file;
199 Lisp_Object output_file = Qnil;
200 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
201 char *outf, *tempfile = NULL;
202 int outfilefd;
203 int pid;
204 #else
205 pid_t pid;
206 #endif
207 int fd_output = -1;
208 struct coding_system process_coding; /* coding-system of process output */
209 struct coding_system argument_coding; /* coding-system of arguments */
210 /* Set to the return value of Ffind_operation_coding_system. */
211 Lisp_Object coding_systems;
212 bool output_to_buffer = 1;
214 /* Qt denotes that Ffind_operation_coding_system is not yet called. */
215 coding_systems = Qt;
217 CHECK_STRING (args[0]);
219 error_file = Qt;
221 #ifndef subprocesses
222 /* Without asynchronous processes we cannot have BUFFER == 0. */
223 if (nargs >= 3
224 && (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
225 error ("Operating system cannot handle asynchronous subprocesses");
226 #endif /* subprocesses */
228 /* Decide the coding-system for giving arguments. */
230 Lisp_Object val, *args2;
231 ptrdiff_t i;
233 /* If arguments are supplied, we may have to encode them. */
234 if (nargs >= 5)
236 bool must_encode = 0;
237 Lisp_Object coding_attrs;
239 for (i = 4; i < nargs; i++)
240 CHECK_STRING (args[i]);
242 for (i = 4; i < nargs; i++)
243 if (STRING_MULTIBYTE (args[i]))
244 must_encode = 1;
246 if (!NILP (Vcoding_system_for_write))
247 val = Vcoding_system_for_write;
248 else if (! must_encode)
249 val = Qraw_text;
250 else
252 SAFE_NALLOCA (args2, 1, nargs + 1);
253 args2[0] = Qcall_process;
254 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
255 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
256 val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
258 val = complement_process_encoding_system (val);
259 setup_coding_system (Fcheck_coding_system (val), &argument_coding);
260 coding_attrs = CODING_ID_ATTRS (argument_coding.id);
261 if (NILP (CODING_ATTR_ASCII_COMPAT (coding_attrs)))
263 /* We should not use an ASCII incompatible coding system. */
264 val = raw_text_coding_system (val);
265 setup_coding_system (val, &argument_coding);
270 if (nargs >= 2 && ! NILP (args[1]))
272 infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory));
273 CHECK_STRING (infile);
275 else
276 infile = build_string (NULL_DEVICE);
278 if (nargs >= 3)
280 buffer = args[2];
282 /* If BUFFER is a list, its meaning is (BUFFER-FOR-STDOUT
283 FILE-FOR-STDERR), unless the first element is :file, in which case see
284 the next paragraph. */
285 if (CONSP (buffer)
286 && (! SYMBOLP (XCAR (buffer))
287 || strcmp (SSDATA (SYMBOL_NAME (XCAR (buffer))), ":file")))
289 if (CONSP (XCDR (buffer)))
291 Lisp_Object stderr_file;
292 stderr_file = XCAR (XCDR (buffer));
294 if (NILP (stderr_file) || EQ (Qt, stderr_file))
295 error_file = stderr_file;
296 else
297 error_file = Fexpand_file_name (stderr_file, Qnil);
300 buffer = XCAR (buffer);
303 /* If the buffer is (still) a list, it might be a (:file "file") spec. */
304 if (CONSP (buffer)
305 && SYMBOLP (XCAR (buffer))
306 && ! strcmp (SSDATA (SYMBOL_NAME (XCAR (buffer))), ":file"))
308 output_file = Fexpand_file_name (XCAR (XCDR (buffer)),
309 BVAR (current_buffer, directory));
310 CHECK_STRING (output_file);
311 buffer = Qnil;
314 if (!(EQ (buffer, Qnil)
315 || EQ (buffer, Qt)
316 || INTEGERP (buffer)))
318 Lisp_Object spec_buffer;
319 spec_buffer = buffer;
320 buffer = Fget_buffer_create (buffer);
321 /* Mention the buffer name for a better error message. */
322 if (NILP (buffer))
323 CHECK_BUFFER (spec_buffer);
324 CHECK_BUFFER (buffer);
327 else
328 buffer = Qnil;
330 /* Make sure that the child will be able to chdir to the current
331 buffer's current directory, or its unhandled equivalent. We
332 can't just have the child check for an error when it does the
333 chdir, since it's in a vfork.
335 We have to GCPRO around this because Fexpand_file_name,
336 Funhandled_file_name_directory, and Ffile_accessible_directory_p
337 might call a file name handling function. The argument list is
338 protected by the caller, so all we really have to worry about is
339 buffer. */
341 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
343 current_dir = BVAR (current_buffer, directory);
345 GCPRO5 (infile, buffer, current_dir, error_file, output_file);
347 current_dir = Funhandled_file_name_directory (current_dir);
348 if (NILP (current_dir))
349 /* If the file name handler says that current_dir is unreachable, use
350 a sensible default. */
351 current_dir = build_string ("~/");
352 current_dir = expand_and_dir_to_file (current_dir, Qnil);
353 current_dir = Ffile_name_as_directory (current_dir);
355 if (NILP (Ffile_accessible_directory_p (current_dir)))
356 report_file_error ("Setting current directory",
357 Fcons (BVAR (current_buffer, directory), Qnil));
359 if (STRING_MULTIBYTE (infile))
360 infile = ENCODE_FILE (infile);
361 if (STRING_MULTIBYTE (current_dir))
362 current_dir = ENCODE_FILE (current_dir);
363 if (STRINGP (error_file) && STRING_MULTIBYTE (error_file))
364 error_file = ENCODE_FILE (error_file);
365 if (STRINGP (output_file) && STRING_MULTIBYTE (output_file))
366 output_file = ENCODE_FILE (output_file);
367 UNGCPRO;
370 display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
372 filefd = emacs_open (SSDATA (infile), O_RDONLY, 0);
373 if (filefd < 0)
375 infile = DECODE_FILE (infile);
376 report_file_error ("Opening process input file", Fcons (infile, Qnil));
379 if (STRINGP (output_file))
381 #ifdef DOS_NT
382 fd_output = emacs_open (SSDATA (output_file),
383 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
384 S_IREAD | S_IWRITE);
385 #else /* not DOS_NT */
386 fd_output = creat (SSDATA (output_file), 0666);
387 #endif /* not DOS_NT */
388 if (fd_output < 0)
390 output_file = DECODE_FILE (output_file);
391 report_file_error ("Opening process output file",
392 Fcons (output_file, Qnil));
394 if (STRINGP (error_file) || NILP (error_file))
395 output_to_buffer = 0;
398 /* Search for program; barf if not found. */
400 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
402 GCPRO4 (infile, buffer, current_dir, error_file);
403 openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK));
404 UNGCPRO;
406 if (NILP (path))
408 emacs_close (filefd);
409 report_file_error ("Searching for program", Fcons (args[0], Qnil));
412 /* If program file name starts with /: for quoting a magic name,
413 discard that. */
414 if (SBYTES (path) > 2 && SREF (path, 0) == '/'
415 && SREF (path, 1) == ':')
416 path = Fsubstring (path, make_number (2), Qnil);
418 new_argv = SAFE_ALLOCA ((nargs > 4 ? nargs - 2 : 2) * sizeof *new_argv);
421 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
423 GCPRO5 (infile, buffer, current_dir, path, error_file);
424 if (nargs > 4)
426 ptrdiff_t i;
428 argument_coding.dst_multibyte = 0;
429 for (i = 4; i < nargs; i++)
431 argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
432 if (CODING_REQUIRE_ENCODING (&argument_coding))
433 /* We must encode this argument. */
434 args[i] = encode_coding_string (&argument_coding, args[i], 1);
436 for (i = 4; i < nargs; i++)
437 new_argv[i - 3] = SDATA (args[i]);
438 new_argv[i - 3] = 0;
440 else
441 new_argv[1] = 0;
442 if (STRING_MULTIBYTE (path))
443 path = ENCODE_FILE (path);
444 new_argv[0] = SDATA (path);
445 UNGCPRO;
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]);
621 #ifdef HAVE_SETSID
622 setsid ();
623 #else
624 setpgid (0, 0);
625 #endif
627 /* Emacs ignores SIGPIPE, but the child should not. */
628 signal (SIGPIPE, SIG_DFL);
630 child_setup (filefd, fd1, fd_error, (char **) new_argv,
631 0, current_dir);
634 unblock_input ();
636 #endif /* not WINDOWSNT */
638 /* The MSDOS case did this already. */
639 if (fd_error >= 0)
640 emacs_close (fd_error);
641 #endif /* not MSDOS */
643 environ = save_environ;
645 /* Close most of our fd's, but not fd[0]
646 since we will use that to read input from. */
647 emacs_close (filefd);
648 if (fd_output >= 0)
649 emacs_close (fd_output);
650 if (fd1 >= 0 && fd1 != fd_error)
651 emacs_close (fd1);
654 if (pid < 0)
656 if (fd[0] >= 0)
657 emacs_close (fd[0]);
658 report_file_error ("Doing vfork", Qnil);
661 if (INTEGERP (buffer))
663 if (fd[0] >= 0)
664 emacs_close (fd[0]);
665 return Qnil;
668 /* Enable sending signal if user quits below. */
669 call_process_exited = 0;
671 #if defined (MSDOS)
672 /* MSDOS needs different cleanup information. */
673 cleanup_info_tail = build_string (tempfile ? tempfile : "");
674 #else
675 cleanup_info_tail = INTEGER_TO_CONS (pid);
676 #endif /* not MSDOS */
677 record_unwind_protect (call_process_cleanup,
678 Fcons (Fcurrent_buffer (),
679 Fcons (INTEGER_TO_CONS (fd[0]),
680 cleanup_info_tail)));
682 if (BUFFERP (buffer))
683 Fset_buffer (buffer);
685 if (NILP (buffer))
687 /* If BUFFER is nil, we must read process output once and then
688 discard it, so setup coding system but with nil. */
689 setup_coding_system (Qnil, &process_coding);
690 process_coding.dst_multibyte = 0;
692 else
694 Lisp_Object val, *args2;
696 val = Qnil;
697 if (!NILP (Vcoding_system_for_read))
698 val = Vcoding_system_for_read;
699 else
701 if (EQ (coding_systems, Qt))
703 ptrdiff_t i;
705 SAFE_NALLOCA (args2, 1, nargs + 1);
706 args2[0] = Qcall_process;
707 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
708 coding_systems
709 = Ffind_operation_coding_system (nargs + 1, args2);
711 if (CONSP (coding_systems))
712 val = XCAR (coding_systems);
713 else if (CONSP (Vdefault_process_coding_system))
714 val = XCAR (Vdefault_process_coding_system);
715 else
716 val = Qnil;
718 Fcheck_coding_system (val);
719 /* In unibyte mode, character code conversion should not take
720 place but EOL conversion should. So, setup raw-text or one
721 of the subsidiary according to the information just setup. */
722 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
723 && !NILP (val))
724 val = raw_text_coding_system (val);
725 setup_coding_system (val, &process_coding);
726 process_coding.dst_multibyte
727 = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
729 process_coding.src_multibyte = 0;
731 immediate_quit = 1;
732 QUIT;
734 if (output_to_buffer)
736 int nread;
737 bool first = 1;
738 EMACS_INT total_read = 0;
739 int carryover = 0;
740 bool display_on_the_fly = display_p;
741 struct coding_system saved_coding;
743 saved_coding = process_coding;
744 while (1)
746 /* Repeatedly read until we've filled as much as possible
747 of the buffer size we have. But don't read
748 less than 1024--save that for the next bufferful. */
749 nread = carryover;
750 while (nread < bufsize - 1024)
752 int this_read = emacs_read (fd[0], buf + nread,
753 bufsize - nread);
755 if (this_read < 0)
756 goto give_up;
758 if (this_read == 0)
760 process_coding.mode |= CODING_MODE_LAST_BLOCK;
761 break;
764 nread += this_read;
765 total_read += this_read;
767 if (display_on_the_fly)
768 break;
771 /* Now NREAD is the total amount of data in the buffer. */
772 immediate_quit = 0;
774 if (!NILP (buffer))
776 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
777 && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
778 insert_1_both (buf, nread, nread, 0, 1, 0);
779 else
780 { /* We have to decode the input. */
781 Lisp_Object curbuf;
782 ptrdiff_t count1 = SPECPDL_INDEX ();
784 XSETBUFFER (curbuf, current_buffer);
785 /* We cannot allow after-change-functions be run
786 during decoding, because that might modify the
787 buffer, while we rely on process_coding.produced to
788 faithfully reflect inserted text until we
789 TEMP_SET_PT_BOTH below. */
790 specbind (Qinhibit_modification_hooks, Qt);
791 decode_coding_c_string (&process_coding,
792 (unsigned char *) buf, nread, curbuf);
793 unbind_to (count1, Qnil);
794 if (display_on_the_fly
795 && CODING_REQUIRE_DETECTION (&saved_coding)
796 && ! CODING_REQUIRE_DETECTION (&process_coding))
798 /* We have detected some coding system. But,
799 there's a possibility that the detection was
800 done by insufficient data. So, we give up
801 displaying on the fly. */
802 if (process_coding.produced > 0)
803 del_range_2 (process_coding.dst_pos,
804 process_coding.dst_pos_byte,
805 process_coding.dst_pos
806 + process_coding.produced_char,
807 process_coding.dst_pos_byte
808 + process_coding.produced, 0);
809 display_on_the_fly = 0;
810 process_coding = saved_coding;
811 carryover = nread;
812 /* This is to make the above condition always
813 fails in the future. */
814 saved_coding.common_flags
815 &= ~CODING_REQUIRE_DETECTION_MASK;
816 continue;
819 TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
820 PT_BYTE + process_coding.produced);
821 carryover = process_coding.carryover_bytes;
822 if (carryover > 0)
823 memcpy (buf, process_coding.carryover,
824 process_coding.carryover_bytes);
828 if (process_coding.mode & CODING_MODE_LAST_BLOCK)
829 break;
831 /* Make the buffer bigger as we continue to read more data,
832 but not past CALLPROC_BUFFER_SIZE_MAX. */
833 if (bufsize < CALLPROC_BUFFER_SIZE_MAX && total_read > 32 * bufsize)
834 if ((bufsize *= 2) > CALLPROC_BUFFER_SIZE_MAX)
835 bufsize = CALLPROC_BUFFER_SIZE_MAX;
837 if (display_p)
839 if (first)
840 prepare_menu_bars ();
841 first = 0;
842 redisplay_preserve_echo_area (1);
843 /* This variable might have been set to 0 for code
844 detection. In that case, we set it back to 1 because
845 we should have already detected a coding system. */
846 display_on_the_fly = 1;
848 immediate_quit = 1;
849 QUIT;
851 give_up: ;
853 Vlast_coding_system_used = CODING_ID_NAME (process_coding.id);
854 /* If the caller required, let the buffer inherit the
855 coding-system used to decode the process output. */
856 if (inherit_process_coding_system)
857 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
858 make_number (total_read));
861 #ifndef MSDOS
862 /* Wait for it to terminate, unless it already has. */
863 if (output_to_buffer)
864 wait_for_termination (pid);
865 else
866 interruptible_wait_for_termination (pid);
867 #endif
869 immediate_quit = 0;
871 /* Don't kill any children that the subprocess may have left behind
872 when exiting. */
873 call_process_exited = 1;
875 SAFE_FREE ();
876 unbind_to (count, Qnil);
878 if (synch_process_termsig)
880 const char *signame;
882 synchronize_system_messages_locale ();
883 signame = strsignal (synch_process_termsig);
885 if (signame == 0)
886 signame = "unknown";
888 synch_process_death = signame;
891 if (synch_process_death)
892 return code_convert_string_norecord (build_string (synch_process_death),
893 Vlocale_coding_system, 0);
894 return make_number (synch_process_retcode);
897 static Lisp_Object
898 delete_temp_file (Lisp_Object name)
900 /* Suppress jka-compr handling, etc. */
901 ptrdiff_t count = SPECPDL_INDEX ();
902 specbind (intern ("file-name-handler-alist"), Qnil);
903 internal_delete_file (name);
904 unbind_to (count, Qnil);
905 return Qnil;
908 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
909 3, MANY, 0,
910 doc: /* Send text from START to END to a synchronous process running PROGRAM.
911 The remaining arguments are optional.
912 Delete the text if fourth arg DELETE is non-nil.
914 Insert output in BUFFER before point; t means current buffer; nil for
915 BUFFER means discard it; 0 means discard and don't wait; and `(:file
916 FILE)', where FILE is a file name string, means that it should be
917 written to that file (if the file already exists it is overwritten).
918 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
919 REAL-BUFFER says what to do with standard output, as above,
920 while STDERR-FILE says what to do with standard error in the child.
921 STDERR-FILE may be nil (discard standard error output),
922 t (mix it with ordinary output), or a file name string.
924 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
925 Remaining args are passed to PROGRAM at startup as command args.
927 If BUFFER is 0, `call-process-region' returns immediately with value nil.
928 Otherwise it waits for PROGRAM to terminate
929 and returns a numeric exit status or a signal description string.
930 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
932 usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
933 (ptrdiff_t nargs, Lisp_Object *args)
935 struct gcpro gcpro1;
936 Lisp_Object filename_string;
937 register Lisp_Object start, end;
938 ptrdiff_t count = SPECPDL_INDEX ();
939 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
940 Lisp_Object coding_systems;
941 Lisp_Object val, *args2;
942 ptrdiff_t i;
943 Lisp_Object tmpdir;
945 if (STRINGP (Vtemporary_file_directory))
946 tmpdir = Vtemporary_file_directory;
947 else
949 #ifndef DOS_NT
950 if (getenv ("TMPDIR"))
951 tmpdir = build_string (getenv ("TMPDIR"));
952 else
953 tmpdir = build_string ("/tmp/");
954 #else /* DOS_NT */
955 char *outf;
956 if ((outf = egetenv ("TMPDIR"))
957 || (outf = egetenv ("TMP"))
958 || (outf = egetenv ("TEMP")))
959 tmpdir = build_string (outf);
960 else
961 tmpdir = Ffile_name_as_directory (build_string ("c:/temp"));
962 #endif
966 USE_SAFE_ALLOCA;
967 Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
968 Lisp_Object encoded_tem = ENCODE_FILE (pattern);
969 char *tempfile = SAFE_ALLOCA (SBYTES (encoded_tem) + 1);
970 memcpy (tempfile, SDATA (encoded_tem), SBYTES (encoded_tem) + 1);
971 coding_systems = Qt;
973 #ifdef HAVE_MKSTEMP
975 int fd;
977 block_input ();
978 fd = mkstemp (tempfile);
979 unblock_input ();
980 if (fd == -1)
981 report_file_error ("Failed to open temporary file",
982 Fcons (build_string (tempfile), Qnil));
983 else
984 close (fd);
986 #else
987 errno = 0;
988 mktemp (tempfile);
989 if (!*tempfile)
991 if (!errno)
992 errno = EEXIST;
993 report_file_error ("Failed to open temporary file using pattern",
994 Fcons (pattern, Qnil));
996 #endif
998 filename_string = build_string (tempfile);
999 GCPRO1 (filename_string);
1000 SAFE_FREE ();
1003 start = args[0];
1004 end = args[1];
1005 /* Decide coding-system of the contents of the temporary file. */
1006 if (!NILP (Vcoding_system_for_write))
1007 val = Vcoding_system_for_write;
1008 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
1009 val = Qraw_text;
1010 else
1012 USE_SAFE_ALLOCA;
1013 SAFE_NALLOCA (args2, 1, nargs + 1);
1014 args2[0] = Qcall_process_region;
1015 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
1016 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1017 val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
1018 SAFE_FREE ();
1020 val = complement_process_encoding_system (val);
1023 ptrdiff_t count1 = SPECPDL_INDEX ();
1025 specbind (intern ("coding-system-for-write"), val);
1026 /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
1027 happen to get a ".Z" suffix. */
1028 specbind (intern ("file-name-handler-alist"), Qnil);
1029 Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil);
1031 unbind_to (count1, Qnil);
1034 /* Note that Fcall_process takes care of binding
1035 coding-system-for-read. */
1037 record_unwind_protect (delete_temp_file, filename_string);
1039 if (nargs > 3 && !NILP (args[3]))
1040 Fdelete_region (start, end);
1042 if (nargs > 3)
1044 args += 2;
1045 nargs -= 2;
1047 else
1049 args[0] = args[2];
1050 nargs = 2;
1052 args[1] = filename_string;
1054 RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args)));
1057 #ifndef WINDOWSNT
1058 static int relocate_fd (int fd, int minfd);
1059 #endif
1061 static char **
1062 add_env (char **env, char **new_env, char *string)
1064 char **ep;
1065 bool ok = 1;
1066 if (string == NULL)
1067 return new_env;
1069 /* See if this string duplicates any string already in the env.
1070 If so, don't put it in.
1071 When an env var has multiple definitions,
1072 we keep the definition that comes first in process-environment. */
1073 for (ep = env; ok && ep != new_env; ep++)
1075 char *p = *ep, *q = string;
1076 while (ok)
1078 if (*q != *p)
1079 break;
1080 if (*q == 0)
1081 /* The string is a lone variable name; keep it for now, we
1082 will remove it later. It is a placeholder for a
1083 variable that is not to be included in the environment. */
1084 break;
1085 if (*q == '=')
1086 ok = 0;
1087 p++, q++;
1090 if (ok)
1091 *new_env++ = string;
1092 return new_env;
1095 /* This is the last thing run in a newly forked inferior
1096 either synchronous or asynchronous.
1097 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
1098 Initialize inferior's priority, pgrp, connected dir and environment.
1099 then exec another program based on new_argv.
1101 This function may change environ for the superior process.
1102 Therefore, the superior process must save and restore the value
1103 of environ around the vfork and the call to this function.
1105 If SET_PGRP, put the subprocess into a separate process group.
1107 CURRENT_DIR is an elisp string giving the path of the current
1108 directory the subprocess should have. Since we can't really signal
1109 a decent error from within the child, this should be verified as an
1110 executable directory by the parent. */
1113 child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
1114 Lisp_Object current_dir)
1116 char **env;
1117 char *pwd_var;
1118 #ifdef WINDOWSNT
1119 int cpid;
1120 HANDLE handles[3];
1121 #endif /* WINDOWSNT */
1123 pid_t pid = getpid ();
1125 /* Close Emacs's descriptors that this process should not have. */
1126 close_process_descs ();
1128 /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
1129 we will lose if we call close_load_descs here. */
1130 #ifndef DOS_NT
1131 close_load_descs ();
1132 #endif
1134 /* Note that use of alloca is always safe here. It's obvious for systems
1135 that do not have true vfork or that have true (stack) alloca.
1136 If using vfork and C_ALLOCA (when Emacs used to include
1137 src/alloca.c) it is safe because that changes the superior's
1138 static variables as if the superior had done alloca and will be
1139 cleaned up in the usual way. */
1141 register char *temp;
1142 size_t i; /* size_t, because ptrdiff_t might overflow here! */
1144 i = SBYTES (current_dir);
1145 #ifdef MSDOS
1146 /* MSDOS must have all environment variables malloc'ed, because
1147 low-level libc functions that launch subsidiary processes rely
1148 on that. */
1149 pwd_var = xmalloc (i + 6);
1150 #else
1151 pwd_var = alloca (i + 6);
1152 #endif
1153 temp = pwd_var + 4;
1154 memcpy (pwd_var, "PWD=", 4);
1155 memcpy (temp, SDATA (current_dir), i);
1156 if (!IS_DIRECTORY_SEP (temp[i - 1])) temp[i++] = DIRECTORY_SEP;
1157 temp[i] = 0;
1159 #ifndef DOS_NT
1160 /* We can't signal an Elisp error here; we're in a vfork. Since
1161 the callers check the current directory before forking, this
1162 should only return an error if the directory's permissions
1163 are changed between the check and this chdir, but we should
1164 at least check. */
1165 if (chdir (temp) < 0)
1166 _exit (errno);
1167 #else /* DOS_NT */
1168 /* Get past the drive letter, so that d:/ is left alone. */
1169 if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
1171 temp += 2;
1172 i -= 2;
1174 #endif /* DOS_NT */
1176 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1177 while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
1178 temp[--i] = 0;
1181 /* Set `env' to a vector of the strings in the environment. */
1183 register Lisp_Object tem;
1184 register char **new_env;
1185 char **p, **q;
1186 register int new_length;
1187 Lisp_Object display = Qnil;
1189 new_length = 0;
1191 for (tem = Vprocess_environment;
1192 CONSP (tem) && STRINGP (XCAR (tem));
1193 tem = XCDR (tem))
1195 if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0
1196 && (SDATA (XCAR (tem)) [7] == '\0'
1197 || SDATA (XCAR (tem)) [7] == '='))
1198 /* DISPLAY is specified in process-environment. */
1199 display = Qt;
1200 new_length++;
1203 /* If not provided yet, use the frame's DISPLAY. */
1204 if (NILP (display))
1206 Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
1207 if (!STRINGP (tmp) && CONSP (Vinitial_environment))
1208 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1209 tmp = Fgetenv_internal (build_string ("DISPLAY"),
1210 Vinitial_environment);
1211 if (STRINGP (tmp))
1213 display = tmp;
1214 new_length++;
1218 /* new_length + 2 to include PWD and terminating 0. */
1219 env = new_env = alloca ((new_length + 2) * sizeof *env);
1220 /* If we have a PWD envvar, pass one down,
1221 but with corrected value. */
1222 if (egetenv ("PWD"))
1223 *new_env++ = pwd_var;
1225 if (STRINGP (display))
1227 char *vdata = alloca (sizeof "DISPLAY=" + SBYTES (display));
1228 strcpy (vdata, "DISPLAY=");
1229 strcat (vdata, SSDATA (display));
1230 new_env = add_env (env, new_env, vdata);
1233 /* Overrides. */
1234 for (tem = Vprocess_environment;
1235 CONSP (tem) && STRINGP (XCAR (tem));
1236 tem = XCDR (tem))
1237 new_env = add_env (env, new_env, SSDATA (XCAR (tem)));
1239 *new_env = 0;
1241 /* Remove variable names without values. */
1242 p = q = env;
1243 while (*p != 0)
1245 while (*q != 0 && strchr (*q, '=') == NULL)
1246 q++;
1247 *p = *q++;
1248 if (*p != 0)
1249 p++;
1254 #ifdef WINDOWSNT
1255 prepare_standard_handles (in, out, err, handles);
1256 set_process_dir (SDATA (current_dir));
1257 /* Spawn the child. (See ntproc.c:Spawnve). */
1258 cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
1259 reset_standard_handles (in, out, err, handles);
1260 if (cpid == -1)
1261 /* An error occurred while trying to spawn the process. */
1262 report_file_error ("Spawning child process", Qnil);
1263 return cpid;
1265 #else /* not WINDOWSNT */
1266 /* Make sure that in, out, and err are not actually already in
1267 descriptors zero, one, or two; this could happen if Emacs is
1268 started with its standard in, out, or error closed, as might
1269 happen under X. */
1271 int oin = in, oout = out;
1273 /* We have to avoid relocating the same descriptor twice! */
1275 in = relocate_fd (in, 3);
1277 if (out == oin)
1278 out = in;
1279 else
1280 out = relocate_fd (out, 3);
1282 if (err == oin)
1283 err = in;
1284 else if (err == oout)
1285 err = out;
1286 else
1287 err = relocate_fd (err, 3);
1290 #ifndef MSDOS
1291 emacs_close (0);
1292 emacs_close (1);
1293 emacs_close (2);
1295 dup2 (in, 0);
1296 dup2 (out, 1);
1297 dup2 (err, 2);
1298 emacs_close (in);
1299 if (out != in)
1300 emacs_close (out);
1301 if (err != in && err != out)
1302 emacs_close (err);
1304 #if defined HAVE_SETPGID || ! (defined USG && defined SETPGRP_RELEASES_CTTY)
1305 setpgid (pid, pid);
1306 #endif
1308 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1309 tcsetpgrp (0, pid);
1311 /* execvp does not accept an environment arg so the only way
1312 to pass this environment is to set environ. Our caller
1313 is responsible for restoring the ambient value of environ. */
1314 environ = env;
1315 execvp (new_argv[0], new_argv);
1317 emacs_write (1, "Can't exec program: ", 20);
1318 emacs_write (1, new_argv[0], strlen (new_argv[0]));
1319 emacs_write (1, "\n", 1);
1320 _exit (1);
1322 #else /* MSDOS */
1323 pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
1324 xfree (pwd_var);
1325 if (pid == -1)
1326 /* An error occurred while trying to run the subprocess. */
1327 report_file_error ("Spawning child process", Qnil);
1328 return pid;
1329 #endif /* MSDOS */
1330 #endif /* not WINDOWSNT */
1333 #ifndef WINDOWSNT
1334 /* Move the file descriptor FD so that its number is not less than MINFD.
1335 If the file descriptor is moved at all, the original is freed. */
1336 static int
1337 relocate_fd (int fd, int minfd)
1339 if (fd >= minfd)
1340 return fd;
1341 else
1343 int new;
1344 #ifdef F_DUPFD
1345 new = fcntl (fd, F_DUPFD, minfd);
1346 #else
1347 new = dup (fd);
1348 if (new != -1)
1349 /* Note that we hold the original FD open while we recurse,
1350 to guarantee we'll get a new FD if we need it. */
1351 new = relocate_fd (new, minfd);
1352 #endif
1353 if (new == -1)
1355 const char *message_1 = "Error while setting up child: ";
1356 const char *errmessage = strerror (errno);
1357 const char *message_2 = "\n";
1358 emacs_write (2, message_1, strlen (message_1));
1359 emacs_write (2, errmessage, strlen (errmessage));
1360 emacs_write (2, message_2, strlen (message_2));
1361 _exit (1);
1363 emacs_close (fd);
1364 return new;
1367 #endif /* not WINDOWSNT */
1369 static bool
1370 getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
1371 ptrdiff_t *valuelen, Lisp_Object env)
1373 for (; CONSP (env); env = XCDR (env))
1375 Lisp_Object entry = XCAR (env);
1376 if (STRINGP (entry)
1377 && SBYTES (entry) >= varlen
1378 #ifdef WINDOWSNT
1379 /* NT environment variables are case insensitive. */
1380 && ! strnicmp (SDATA (entry), var, varlen)
1381 #else /* not WINDOWSNT */
1382 && ! memcmp (SDATA (entry), var, varlen)
1383 #endif /* not WINDOWSNT */
1386 if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
1388 *value = SSDATA (entry) + (varlen + 1);
1389 *valuelen = SBYTES (entry) - (varlen + 1);
1390 return 1;
1392 else if (SBYTES (entry) == varlen)
1394 /* Lone variable names in Vprocess_environment mean that
1395 variable should be removed from the environment. */
1396 *value = NULL;
1397 return 1;
1401 return 0;
1404 static bool
1405 getenv_internal (const char *var, ptrdiff_t varlen, char **value,
1406 ptrdiff_t *valuelen, Lisp_Object frame)
1408 /* Try to find VAR in Vprocess_environment first. */
1409 if (getenv_internal_1 (var, varlen, value, valuelen,
1410 Vprocess_environment))
1411 return *value ? 1 : 0;
1413 /* For DISPLAY try to get the values from the frame or the initial env. */
1414 if (strcmp (var, "DISPLAY") == 0)
1416 Lisp_Object display
1417 = Fframe_parameter (NILP (frame) ? selected_frame : frame, Qdisplay);
1418 if (STRINGP (display))
1420 *value = SSDATA (display);
1421 *valuelen = SBYTES (display);
1422 return 1;
1424 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1425 if (getenv_internal_1 (var, varlen, value, valuelen,
1426 Vinitial_environment))
1427 return *value ? 1 : 0;
1430 return 0;
1433 DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
1434 doc: /* Get the value of environment variable VARIABLE.
1435 VARIABLE should be a string. Value is nil if VARIABLE is undefined in
1436 the environment. Otherwise, value is a string.
1438 This function searches `process-environment' for VARIABLE.
1440 If optional parameter ENV is a list, then search this list instead of
1441 `process-environment', and return t when encountering a negative entry
1442 \(an entry for a variable with no value). */)
1443 (Lisp_Object variable, Lisp_Object env)
1445 char *value;
1446 ptrdiff_t valuelen;
1448 CHECK_STRING (variable);
1449 if (CONSP (env))
1451 if (getenv_internal_1 (SSDATA (variable), SBYTES (variable),
1452 &value, &valuelen, env))
1453 return value ? make_string (value, valuelen) : Qt;
1454 else
1455 return Qnil;
1457 else if (getenv_internal (SSDATA (variable), SBYTES (variable),
1458 &value, &valuelen, env))
1459 return make_string (value, valuelen);
1460 else
1461 return Qnil;
1464 /* A version of getenv that consults the Lisp environment lists,
1465 easily callable from C. */
1466 char *
1467 egetenv (const char *var)
1469 char *value;
1470 ptrdiff_t valuelen;
1472 if (getenv_internal (var, strlen (var), &value, &valuelen, Qnil))
1473 return value;
1474 else
1475 return 0;
1479 /* This is run before init_cmdargs. */
1481 void
1482 init_callproc_1 (void)
1484 #ifdef HAVE_NS
1485 const char *etc_dir = ns_etc_directory ();
1486 const char *path_exec = ns_exec_path ();
1487 #endif
1489 Vdata_directory = decode_env_path ("EMACSDATA",
1490 #ifdef HAVE_NS
1491 etc_dir ? etc_dir :
1492 #endif
1493 PATH_DATA);
1494 Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory));
1496 Vdoc_directory = decode_env_path ("EMACSDOC",
1497 #ifdef HAVE_NS
1498 etc_dir ? etc_dir :
1499 #endif
1500 PATH_DOC);
1501 Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory));
1503 /* Check the EMACSPATH environment variable, defaulting to the
1504 PATH_EXEC path from epaths.h. */
1505 Vexec_path = decode_env_path ("EMACSPATH",
1506 #ifdef HAVE_NS
1507 path_exec ? path_exec :
1508 #endif
1509 PATH_EXEC);
1510 Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
1511 /* FIXME? For ns, path_exec should go at the front? */
1512 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
1515 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1517 void
1518 init_callproc (void)
1520 char *data_dir = egetenv ("EMACSDATA");
1522 register char * sh;
1523 Lisp_Object tempdir;
1524 #ifdef HAVE_NS
1525 if (data_dir == 0)
1527 const char *etc_dir = ns_etc_directory ();
1528 if (etc_dir)
1530 data_dir = alloca (strlen (etc_dir) + 1);
1531 strcpy (data_dir, etc_dir);
1534 #endif
1536 if (!NILP (Vinstallation_directory))
1538 /* Add to the path the lib-src subdir of the installation dir. */
1539 Lisp_Object tem;
1540 tem = Fexpand_file_name (build_string ("lib-src"),
1541 Vinstallation_directory);
1542 #ifndef MSDOS
1543 /* MSDOS uses wrapped binaries, so don't do this. */
1544 if (NILP (Fmember (tem, Vexec_path)))
1546 #ifdef HAVE_NS
1547 const char *path_exec = ns_exec_path ();
1548 #endif
1549 Vexec_path = decode_env_path ("EMACSPATH",
1550 #ifdef HAVE_NS
1551 path_exec ? path_exec :
1552 #endif
1553 PATH_EXEC);
1554 Vexec_path = Fcons (tem, Vexec_path);
1555 Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
1558 Vexec_directory = Ffile_name_as_directory (tem);
1559 #endif /* not MSDOS */
1561 /* Maybe use ../etc as well as ../lib-src. */
1562 if (data_dir == 0)
1564 tem = Fexpand_file_name (build_string ("etc"),
1565 Vinstallation_directory);
1566 Vdoc_directory = Ffile_name_as_directory (tem);
1570 /* Look for the files that should be in etc. We don't use
1571 Vinstallation_directory, because these files are never installed
1572 near the executable, and they are never in the build
1573 directory when that's different from the source directory.
1575 Instead, if these files are not in the nominal place, we try the
1576 source directory. */
1577 if (data_dir == 0)
1579 Lisp_Object tem, tem1, srcdir;
1581 srcdir = Fexpand_file_name (build_string ("../src/"),
1582 build_string (PATH_DUMPLOADSEARCH));
1583 tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory);
1584 tem1 = Ffile_exists_p (tem);
1585 if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1))
1587 Lisp_Object newdir;
1588 newdir = Fexpand_file_name (build_string ("../etc/"),
1589 build_string (PATH_DUMPLOADSEARCH));
1590 tem = Fexpand_file_name (build_string ("GNU"), newdir);
1591 tem1 = Ffile_exists_p (tem);
1592 if (!NILP (tem1))
1593 Vdata_directory = newdir;
1597 #ifndef CANNOT_DUMP
1598 if (initialized)
1599 #endif
1601 tempdir = Fdirectory_file_name (Vexec_directory);
1602 if (access (SSDATA (tempdir), 0) < 0)
1603 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1604 Vexec_directory);
1607 tempdir = Fdirectory_file_name (Vdata_directory);
1608 if (access (SSDATA (tempdir), 0) < 0)
1609 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1610 Vdata_directory);
1612 sh = (char *) getenv ("SHELL");
1613 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
1615 #ifdef DOS_NT
1616 Vshared_game_score_directory = Qnil;
1617 #else
1618 Vshared_game_score_directory = build_string (PATH_GAME);
1619 if (NILP (Ffile_directory_p (Vshared_game_score_directory)))
1620 Vshared_game_score_directory = Qnil;
1621 #endif
1624 void
1625 set_initial_environment (void)
1627 char **envp;
1628 for (envp = environ; *envp; envp++)
1629 Vprocess_environment = Fcons (build_string (*envp),
1630 Vprocess_environment);
1631 /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
1632 to use `delete' and friends on process-environment. */
1633 Vinitial_environment = Fcopy_sequence (Vprocess_environment);
1636 void
1637 syms_of_callproc (void)
1639 #ifndef DOS_NT
1640 Vtemp_file_name_pattern = build_string ("emacsXXXXXX");
1641 #elif defined (WINDOWSNT)
1642 Vtemp_file_name_pattern = build_string ("emXXXXXX");
1643 #else
1644 Vtemp_file_name_pattern = build_string ("detmp.XXX");
1645 #endif
1646 staticpro (&Vtemp_file_name_pattern);
1648 DEFVAR_LISP ("shell-file-name", Vshell_file_name,
1649 doc: /* File name to load inferior shells from.
1650 Initialized from the SHELL environment variable, or to a system-dependent
1651 default if SHELL is not set. */);
1653 DEFVAR_LISP ("exec-path", Vexec_path,
1654 doc: /* List of directories to search programs to run in subprocesses.
1655 Each element is a string (directory name) or nil (try default directory). */);
1657 DEFVAR_LISP ("exec-suffixes", Vexec_suffixes,
1658 doc: /* List of suffixes to try to find executable file names.
1659 Each element is a string. */);
1660 Vexec_suffixes = Qnil;
1662 DEFVAR_LISP ("exec-directory", Vexec_directory,
1663 doc: /* Directory for executables for Emacs to invoke.
1664 More generally, this includes any architecture-dependent files
1665 that are built and installed from the Emacs distribution. */);
1667 DEFVAR_LISP ("data-directory", Vdata_directory,
1668 doc: /* Directory of machine-independent files that come with GNU Emacs.
1669 These are files intended for Emacs to use while it runs. */);
1671 DEFVAR_LISP ("doc-directory", Vdoc_directory,
1672 doc: /* Directory containing the DOC file that comes with GNU Emacs.
1673 This is usually the same as `data-directory'. */);
1675 DEFVAR_LISP ("configure-info-directory", Vconfigure_info_directory,
1676 doc: /* For internal use by the build procedure only.
1677 This is the name of the directory in which the build procedure installed
1678 Emacs's info files; the default value for `Info-default-directory-list'
1679 includes this. */);
1680 Vconfigure_info_directory = build_string (PATH_INFO);
1682 DEFVAR_LISP ("shared-game-score-directory", Vshared_game_score_directory,
1683 doc: /* Directory of score files for games which come with GNU Emacs.
1684 If this variable is nil, then Emacs is unable to use a shared directory. */);
1685 #ifdef DOS_NT
1686 Vshared_game_score_directory = Qnil;
1687 #else
1688 Vshared_game_score_directory = build_string (PATH_GAME);
1689 #endif
1691 DEFVAR_LISP ("initial-environment", Vinitial_environment,
1692 doc: /* List of environment variables inherited from the parent process.
1693 Each element should be a string of the form ENVVARNAME=VALUE.
1694 The elements must normally be decoded (using `locale-coding-system') for use. */);
1695 Vinitial_environment = Qnil;
1697 DEFVAR_LISP ("process-environment", Vprocess_environment,
1698 doc: /* List of overridden environment variables for subprocesses to inherit.
1699 Each element should be a string of the form ENVVARNAME=VALUE.
1701 Entries in this list take precedence to those in the frame-local
1702 environments. Therefore, let-binding `process-environment' is an easy
1703 way to temporarily change the value of an environment variable,
1704 irrespective of where it comes from. To use `process-environment' to
1705 remove an environment variable, include only its name in the list,
1706 without "=VALUE".
1708 This variable is set to nil when Emacs starts.
1710 If multiple entries define the same variable, the first one always
1711 takes precedence.
1713 Non-ASCII characters are encoded according to the initial value of
1714 `locale-coding-system', i.e. the elements must normally be decoded for
1715 use.
1717 See `setenv' and `getenv'. */);
1718 Vprocess_environment = Qnil;
1720 defsubr (&Scall_process);
1721 defsubr (&Sgetenv_internal);
1722 defsubr (&Scall_process_region);