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