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