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