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