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