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