1 /* Synchronous subprocess invocation for GNU Emacs.
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
29 extern char *strerror ();
31 /* Define SIGCHLD as an alias for SIGCLD. */
33 #if !defined (SIGCHLD) && defined (SIGCLD)
34 #define SIGCHLD SIGCLD
37 #include <sys/types.h>
41 #define INCLUDED_FCNTL
48 #include <stdlib.h> /* for proper declaration of environ */
51 #define _P_NOWAIT 1 /* from process.h */
54 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
56 #define INCLUDED_FCNTL
59 #include <sys/param.h>
78 #include "syssignal.h"
82 extern noshare
char **environ
;
84 extern char **environ
;
87 #define max(a, b) ((a) > (b) ? (a) : (b))
90 /* When we are starting external processes we need to know whether they
91 take binary input (no conversion) or text input (\n is converted to
92 \r\n). Similar for output: if newlines are written as \r\n then it's
93 text process output, otherwise it's binary. */
94 Lisp_Object Vbinary_process_input
;
95 Lisp_Object Vbinary_process_output
;
98 Lisp_Object Vexec_path
, Vexec_directory
, Vdata_directory
, Vdoc_directory
;
99 Lisp_Object Vconfigure_info_directory
;
100 Lisp_Object Vtemp_file_name_pattern
;
102 Lisp_Object Vshell_file_name
;
104 Lisp_Object Vprocess_environment
;
107 Lisp_Object Qbuffer_file_type
;
110 /* True iff we are about to fork off a synchronous process or if we
111 are waiting for it. */
112 int synch_process_alive
;
114 /* Nonzero => this is a string explaining death of synchronous subprocess. */
115 char *synch_process_death
;
117 /* If synch_process_death is zero,
118 this is exit code of synchronous subprocess. */
119 int synch_process_retcode
;
121 extern Lisp_Object Vdoc_file_name
;
123 /* Clean up when exiting Fcall_process.
124 On MSDOS, delete the temporary file on any kind of termination.
125 On Unix, kill the process and any children on termination by signal. */
127 /* Nonzero if this is termination due to exit. */
128 static int call_process_exited
;
130 #ifndef VMS /* VMS version is in vmsproc.c. */
133 call_process_kill (fdpid
)
136 close (XFASTINT (Fcar (fdpid
)));
137 EMACS_KILLPG (XFASTINT (Fcdr (fdpid
)), SIGKILL
);
138 synch_process_alive
= 0;
143 call_process_cleanup (fdpid
)
147 /* for MSDOS fdpid is really (fd . tempfile) */
148 register Lisp_Object file
;
150 close (XFASTINT (Fcar (fdpid
)));
151 if (strcmp (XSTRING (file
)-> data
, NULL_DEVICE
) != 0)
152 unlink (XSTRING (file
)->data
);
153 #else /* not MSDOS */
154 register int pid
= XFASTINT (Fcdr (fdpid
));
157 if (call_process_exited
)
159 close (XFASTINT (Fcar (fdpid
)));
163 if (EMACS_KILLPG (pid
, SIGINT
) == 0)
165 int count
= specpdl_ptr
- specpdl
;
166 record_unwind_protect (call_process_kill
, fdpid
);
167 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
170 wait_for_termination (pid
);
172 specpdl_ptr
= specpdl
+ count
; /* Discard the unwind protect. */
173 message1 ("Waiting for process to die...done");
175 synch_process_alive
= 0;
176 close (XFASTINT (Fcar (fdpid
)));
177 #endif /* not MSDOS */
181 DEFUN ("call-process", Fcall_process
, Scall_process
, 1, MANY
, 0,
182 "Call PROGRAM synchronously in separate process.\n\
183 The program's input comes from file INFILE (nil means `/dev/null').\n\
184 Insert output in BUFFER before point; t means current buffer;\n\
185 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
186 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
187 REAL-BUFFER says what to do with standard output, as above,\n\
188 while STDERR-FILE says what to do with standard error in the child.\n\
189 STDERR-FILE may be nil (discard standard error output),\n\
190 t (mix it with ordinary output), or a file name string.\n\
192 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
193 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
195 If BUFFER is 0, `call-process' returns immediately with value nil.\n\
196 Otherwise it waits for PROGRAM to terminate\n\
197 and returns a numeric exit status or a signal description string.\n\
198 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
201 register Lisp_Object
*args
;
203 Lisp_Object infile
, buffer
, current_dir
, display
, path
;
210 int count
= specpdl_ptr
- specpdl
;
211 register unsigned char **new_argv
212 = (unsigned char **) alloca ((max (2, nargs
- 2)) * sizeof (char *));
213 struct buffer
*old
= current_buffer
;
214 /* File to use for stderr in the child.
215 t means use same as standard output. */
216 Lisp_Object error_file
;
217 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
218 char *outf
, *tempfile
;
224 struct coding_system process_coding
; /* coding-system of process output */
225 struct coding_system argument_coding
; /* coding-system of arguments */
227 CHECK_STRING (args
[0], 0);
232 /* Without asynchronous processes we cannot have BUFFER == 0. */
233 if (nargs
>= 3 && INTEGERP (args
[2]))
234 error ("Operating system cannot handle asynchronous subprocesses");
235 #endif /* subprocesses */
237 /* Decide the coding-system for giving arguments and reading process
240 Lisp_Object val
, *args2
;
241 /* Qt denotes that we have not yet called Ffind_coding_system. */
242 Lisp_Object coding_systems
= Qt
;
245 /* If arguments are supplied, we may have to encode them. */
248 if (NILP (val
= Vcoding_system_for_write
))
250 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
251 args2
[0] = Qcall_process
;
252 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
253 coding_systems
= Ffind_coding_system (nargs
+ 1, args2
);
254 if (CONSP (coding_systems
))
255 val
= XCONS (coding_systems
)->cdr
;
256 else if (CONSP (Vdefault_process_coding_system
))
257 val
= XCONS (Vdefault_process_coding_system
)->cdr
;
259 setup_coding_system (Fcheck_coding_system (val
), &argument_coding
);
262 /* If BUFFER is nil, we must read process output once and then
263 discard it, so setup coding system but with nil. If BUFFER is
264 an integer, we can discard it without reading. */
265 if (nargs
< 3 || NILP (args
[2]))
266 setup_coding_system (Qnil
, &process_coding
);
267 else if (!INTEGERP (args
[2]))
269 if (NILP (val
= Vcoding_system_for_read
))
271 if (!EQ (coding_systems
, Qt
))
273 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
274 args2
[0] = Qcall_process
;
275 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
276 coding_systems
= Ffind_coding_system (nargs
+ 1, args2
);
278 if (CONSP (coding_systems
))
279 val
= XCONS (coding_systems
)->car
;
280 else if (CONSP (Vdefault_process_coding_system
))
281 val
= XCONS (Vdefault_process_coding_system
)->car
;
283 setup_coding_system (Fcheck_coding_system (val
), &process_coding
);
287 if (nargs
>= 2 && ! NILP (args
[1]))
289 infile
= Fexpand_file_name (args
[1], current_buffer
->directory
);
290 CHECK_STRING (infile
, 1);
293 infile
= build_string (NULL_DEVICE
);
299 /* If BUFFER is a list, its meaning is
300 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
303 if (CONSP (XCONS (buffer
)->cdr
))
305 Lisp_Object stderr_file
;
306 stderr_file
= XCONS (XCONS (buffer
)->cdr
)->car
;
308 if (NILP (stderr_file
) || EQ (Qt
, stderr_file
))
309 error_file
= stderr_file
;
311 error_file
= Fexpand_file_name (stderr_file
, Qnil
);
314 buffer
= XCONS (buffer
)->car
;
317 if (!(EQ (buffer
, Qnil
)
319 || XFASTINT (buffer
) == 0))
321 Lisp_Object spec_buffer
;
322 spec_buffer
= buffer
;
323 buffer
= Fget_buffer (buffer
);
324 /* Mention the buffer name for a better error message. */
326 CHECK_BUFFER (spec_buffer
, 2);
327 CHECK_BUFFER (buffer
, 2);
333 /* Make sure that the child will be able to chdir to the current
334 buffer's current directory, or its unhandled equivalent. We
335 can't just have the child check for an error when it does the
336 chdir, since it's in a vfork.
338 We have to GCPRO around this because Fexpand_file_name,
339 Funhandled_file_name_directory, and Ffile_accessible_directory_p
340 might call a file name handling function. The argument list is
341 protected by the caller, so all we really have to worry about is
344 struct gcpro gcpro1
, gcpro2
, gcpro3
;
346 current_dir
= current_buffer
->directory
;
348 GCPRO3 (infile
, buffer
, current_dir
);
351 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
353 if (NILP (Ffile_accessible_directory_p (current_dir
)))
354 report_file_error ("Setting current directory",
355 Fcons (current_buffer
->directory
, Qnil
));
360 display
= nargs
>= 4 ? args
[3] : Qnil
;
362 filefd
= open (XSTRING (infile
)->data
, O_RDONLY
, 0);
365 report_file_error ("Opening process input file", Fcons (infile
, Qnil
));
367 /* Search for program; barf if not found. */
371 GCPRO1 (current_dir
);
372 openp (Vexec_path
, args
[0], EXEC_SUFFIXES
, &path
, 1);
378 report_file_error ("Searching for program", Fcons (args
[0], Qnil
));
380 new_argv
[0] = XSTRING (path
)->data
;
383 for (i
= 4; i
< nargs
; i
++)
385 CHECK_STRING (args
[i
], i
);
386 if (argument_coding
.type
== coding_type_no_conversion
)
387 new_argv
[i
- 3] = XSTRING (args
[i
])->data
;
390 /* We must encode the arguments. */
391 int size
= encoding_buffer_size (&argument_coding
,
392 XSTRING (args
[i
])->size
);
394 unsigned char *dummy
= (unsigned char *) alloca (size
);
396 /* The Irix 4.0 compiler barfs if we eliminate dummy. */
397 new_argv
[i
- 3] = dummy
;
398 produced
= encode_coding (&argument_coding
,
399 XSTRING (args
[i
])->data
, new_argv
[i
- 3],
400 XSTRING (args
[i
])->size
, size
, &dummy
);
401 new_argv
[i
- 3][produced
] = 0;
407 #ifdef MSDOS /* MW, July 1993 */
408 if ((outf
= egetenv ("TMP")) || (outf
= egetenv ("TEMP")))
409 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
412 tempfile
= alloca (20);
415 dostounix_filename (tempfile
);
416 if (*tempfile
== '\0' || tempfile
[strlen (tempfile
) - 1] != '/')
417 strcat (tempfile
, "/");
418 strcat (tempfile
, "detmp.XXX");
421 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
425 report_file_error ("Opening process output file",
426 Fcons (build_string (tempfile
), Qnil
));
432 if (INTEGERP (buffer
))
433 fd
[1] = open (NULL_DEVICE
, O_WRONLY
), fd
[0] = -1;
440 /* Replaced by close_process_descs */
441 set_exclusive_use (fd
[0]);
446 /* child_setup must clobber environ in systems with true vfork.
447 Protect it from permanent change. */
448 register char **save_environ
= environ
;
449 register int fd1
= fd
[1];
452 #if 0 /* Some systems don't have sigblock. */
453 mask
= sigblock (sigmask (SIGCHLD
));
456 /* Record that we're about to create a synchronous process. */
457 synch_process_alive
= 1;
459 /* These vars record information from process termination.
460 Clear them now before process can possibly terminate,
461 to avoid timing error if process terminates soon. */
462 synch_process_death
= 0;
463 synch_process_retcode
= 0;
465 if (NILP (error_file
))
466 fd_error
= open (NULL_DEVICE
, O_WRONLY
);
467 else if (STRINGP (error_file
))
470 fd_error
= open (XSTRING (error_file
)->data
,
471 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
473 #else /* not DOS_NT */
474 fd_error
= creat (XSTRING (error_file
)->data
, 0666);
475 #endif /* not DOS_NT */
488 report_file_error ("Cannot redirect stderr",
489 Fcons ((NILP (error_file
)
490 ? build_string (NULL_DEVICE
) : error_file
),
493 #ifdef MSDOS /* MW, July 1993 */
494 /* ??? Someone who knows MSDOG needs to check whether this properly
495 closes all descriptors that it opens.
497 Note that run_msdos_command() actually returns the child process
498 exit status, not its PID, so we assign it to `synch_process_retcode'
500 pid
= run_msdos_command (new_argv
, current_dir
,
501 filefd
, outfilefd
, fd_error
);
503 /* Record that the synchronous process exited and note its
504 termination status. */
505 synch_process_alive
= 0;
506 synch_process_retcode
= pid
;
507 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
508 synch_process_death
= strerror(errno
);
511 if (fd_error
!= outfilefd
)
513 fd1
= -1; /* No harm in closing that one! */
514 /* Since CRLF is converted to LF within `decode_coding', we can
515 always open a file with binary mode. */
516 fd
[0] = open (tempfile
, O_BINARY
);
521 report_file_error ("Cannot re-open temporary file", Qnil
);
523 #else /* not MSDOS */
525 pid
= child_setup (filefd
, fd1
, fd_error
, new_argv
, 0, current_dir
);
526 #else /* not WINDOWSNT */
536 #if defined (USG) && !defined (BSD_PGRPS)
541 child_setup (filefd
, fd1
, fd_error
, new_argv
, 0, current_dir
);
543 #endif /* not WINDOWSNT */
545 /* The MSDOS case did this already. */
548 #endif /* not MSDOS */
550 environ
= save_environ
;
552 /* Close most of our fd's, but not fd[0]
553 since we will use that to read input from. */
555 if (fd1
>= 0 && fd1
!= fd_error
)
563 report_file_error ("Doing vfork", Qnil
);
566 if (INTEGERP (buffer
))
571 /* If Emacs has been built with asynchronous subprocess support,
572 we don't need to do this, I think because it will then have
573 the facilities for handling SIGCHLD. */
574 wait_without_blocking ();
575 #endif /* subprocesses */
579 /* Enable sending signal if user quits below. */
580 call_process_exited
= 0;
583 /* MSDOS needs different cleanup information. */
584 record_unwind_protect (call_process_cleanup
,
585 Fcons (make_number (fd
[0]), build_string (tempfile
)));
587 record_unwind_protect (call_process_cleanup
,
588 Fcons (make_number (fd
[0]), make_number (pid
)));
589 #endif /* not MSDOS */
592 if (BUFFERP (buffer
))
593 Fset_buffer (buffer
);
605 /* Repeatedly read until we've filled as much as possible
606 of the buffer size we have. But don't read
607 less than 1024--save that for the next bufferful. */
609 nread
= process_coding
.carryover_size
; /* This value is initially 0. */
610 while (nread
< bufsize
- 1024)
613 = read (fd
[0], bufptr
+ nread
, bufsize
- nread
);
626 /* Now NREAD is the total amount of data in the buffer. */
628 /* Here, just tell decode_coding that we are processing the
629 last block. We break the loop after decoding. */
630 process_coding
.last_block
= 1;
637 if (process_coding
.type
== coding_type_no_conversion
)
638 insert (bufptr
, nread
);
640 { /* We have to decode the input. */
641 int size
= decoding_buffer_size (&process_coding
, bufsize
);
642 char *decoding_buf
= get_conversion_buffer (size
);
645 nread
= decode_coding (&process_coding
, bufptr
, decoding_buf
,
646 nread
, size
, &dummy
);
648 insert (decoding_buf
, nread
);
652 if (process_coding
.last_block
)
655 /* Make the buffer bigger as we continue to read more data,
657 if (bufsize
< 64 * 1024 && total_read
> 32 * bufsize
)
660 bufptr
= (char *) alloca (bufsize
);
663 if (!NILP (buffer
) && process_coding
.carryover_size
> 0)
664 /* We have carryover in the last decoding. It should be
665 processed again after reading more data. */
666 bcopy (process_coding
.carryover
, bufptr
,
667 process_coding
.carryover_size
);
669 if (!NILP (display
) && INTERACTIVE
)
672 prepare_menu_bars ();
674 redisplay_preserve_echo_area ();
682 /* Wait for it to terminate, unless it already has. */
683 wait_for_termination (pid
);
687 set_buffer_internal (old
);
689 /* Don't kill any children that the subprocess may have left behind
691 call_process_exited
= 1;
693 unbind_to (count
, Qnil
);
695 if (synch_process_death
)
696 return build_string (synch_process_death
);
697 return make_number (synch_process_retcode
);
702 delete_temp_file (name
)
705 /* Use Fdelete_file (indirectly) because that runs a file name handler.
706 We did that when writing the file, so we should do so when deleting. */
707 internal_delete_file (name
);
710 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
712 "Send text from START to END to a synchronous process running PROGRAM.\n\
713 Delete the text if fourth arg DELETE is non-nil.\n\
715 Insert output in BUFFER before point; t means current buffer;\n\
716 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
717 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
718 REAL-BUFFER says what to do with standard output, as above,\n\
719 while STDERR-FILE says what to do with standard error in the child.\n\
720 STDERR-FILE may be nil (discard standard error output),\n\
721 t (mix it with ordinary output), or a file name string.\n\
723 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
724 Remaining args are passed to PROGRAM at startup as command args.\n\
726 If BUFFER is nil, `call-process-region' returns immediately with value nil.\n\
727 Otherwise it waits for PROGRAM to terminate\n\
728 and returns a numeric exit status or a signal description string.\n\
729 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
732 register Lisp_Object
*args
;
735 Lisp_Object filename_string
;
736 register Lisp_Object start
, end
;
737 int count
= specpdl_ptr
- specpdl
;
738 /* Qt denotes that we have not yet called Ffind_coding_system. */
739 Lisp_Object coding_systems
= Qt
;
740 Lisp_Object val
, *args2
;
746 if ((outf
= egetenv ("TMP")) || (outf
= egetenv ("TEMP")))
747 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
750 tempfile
= alloca (20);
753 if (!IS_DIRECTORY_SEP (tempfile
[strlen (tempfile
) - 1]))
754 strcat (tempfile
, "/");
755 if ('/' == DIRECTORY_SEP
)
756 dostounix_filename (tempfile
);
758 unixtodos_filename (tempfile
);
760 strcat (tempfile
, "emXXXXXX");
762 strcat (tempfile
, "detmp.XXX");
764 #else /* not DOS_NT */
765 char *tempfile
= (char *) alloca (XSTRING (Vtemp_file_name_pattern
)->size
+ 1);
766 bcopy (XSTRING (Vtemp_file_name_pattern
)->data
, tempfile
,
767 XSTRING (Vtemp_file_name_pattern
)->size
+ 1);
768 #endif /* not DOS_NT */
772 filename_string
= build_string (tempfile
);
773 GCPRO1 (filename_string
);
776 /* Decide coding-system of the contents of the temporary file. */
778 specbind (Qbuffer_file_type
, Vbinary_process_input
);
779 if (NILP (Vbinary_process_input
))
783 if (NILP (val
= Vcoding_system_for_write
))
785 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
786 args2
[0] = Qcall_process_region
;
787 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
788 coding_systems
= Ffind_coding_system (nargs
+ 1, args2
);
789 if (CONSP (coding_systems
))
790 val
= XCONS (coding_systems
)->cdr
;
791 else if (CONSP (Vdefault_process_coding_system
))
792 val
= XCONS (Vdefault_process_coding_system
)->car
;
794 specbind (intern ("coding-system-for-write"), val
);
795 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
, Qnil
);
798 if (NILP (Vbinary_process_input
))
802 if (NILP (val
= Vcoding_system_for_read
))
804 if (EQ (coding_systems
, Qt
))
806 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
807 args2
[0] = Qcall_process_region
;
808 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
809 coding_systems
= Ffind_coding_system (nargs
+ 1, args2
);
811 val
= CONSP (coding_systems
) ? XCONS (coding_systems
)->car
: Qnil
;
813 specbind (intern ("coding-system-for-read"), val
);
815 record_unwind_protect (delete_temp_file
, filename_string
);
818 Fdelete_region (start
, end
);
820 args
[3] = filename_string
;
822 RETURN_UNGCPRO (unbind_to (count
, Fcall_process (nargs
- 2, args
+ 2)));
825 #ifndef VMS /* VMS version is in vmsproc.c. */
827 /* This is the last thing run in a newly forked inferior
828 either synchronous or asynchronous.
829 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
830 Initialize inferior's priority, pgrp, connected dir and environment.
831 then exec another program based on new_argv.
833 This function may change environ for the superior process.
834 Therefore, the superior process must save and restore the value
835 of environ around the vfork and the call to this function.
837 ENV is the environment for the subprocess.
839 SET_PGRP is nonzero if we should put the subprocess into a separate
842 CURRENT_DIR is an elisp string giving the path of the current
843 directory the subprocess should have. Since we can't really signal
844 a decent error from within the child, this should be verified as an
845 executable directory by the parent. */
847 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
849 register char **new_argv
;
851 Lisp_Object current_dir
;
854 /* The MSDOS port of gcc cannot fork, vfork, ... so we must call system
856 #else /* not MSDOS */
862 #endif /* WINDOWSNT */
866 #ifdef SET_EMACS_PRIORITY
868 extern int emacs_priority
;
870 if (emacs_priority
< 0)
871 nice (- emacs_priority
);
876 /* Close Emacs's descriptors that this process should not have. */
877 close_process_descs ();
881 /* Note that use of alloca is always safe here. It's obvious for systems
882 that do not have true vfork or that have true (stack) alloca.
883 If using vfork and C_ALLOCA it is safe because that changes
884 the superior's static variables as if the superior had done alloca
885 and will be cleaned up in the usual way. */
890 i
= XSTRING (current_dir
)->size
;
891 pwd_var
= (char *) alloca (i
+ 6);
893 bcopy ("PWD=", pwd_var
, 4);
894 bcopy (XSTRING (current_dir
)->data
, temp
, i
);
895 if (!IS_DIRECTORY_SEP (temp
[i
- 1])) temp
[i
++] = DIRECTORY_SEP
;
898 /* We can't signal an Elisp error here; we're in a vfork. Since
899 the callers check the current directory before forking, this
900 should only return an error if the directory's permissions
901 are changed between the check and this chdir, but we should
903 if (chdir (temp
) < 0)
906 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
907 while (i
> 2 && IS_DIRECTORY_SEP (temp
[i
- 1]))
911 /* Set `env' to a vector of the strings in Vprocess_environment. */
913 register Lisp_Object tem
;
914 register char **new_env
;
915 register int new_length
;
918 for (tem
= Vprocess_environment
;
919 CONSP (tem
) && STRINGP (XCONS (tem
)->car
);
920 tem
= XCONS (tem
)->cdr
)
923 /* new_length + 2 to include PWD and terminating 0. */
924 env
= new_env
= (char **) alloca ((new_length
+ 2) * sizeof (char *));
926 /* If we have a PWD envvar, pass one down,
927 but with corrected value. */
929 *new_env
++ = pwd_var
;
931 /* Copy the Vprocess_environment strings into new_env. */
932 for (tem
= Vprocess_environment
;
933 CONSP (tem
) && STRINGP (XCONS (tem
)->car
);
934 tem
= XCONS (tem
)->cdr
)
937 char *string
= (char *) XSTRING (XCONS (tem
)->car
)->data
;
938 /* See if this string duplicates any string already in the env.
939 If so, don't put it in.
940 When an env var has multiple definitions,
941 we keep the definition that comes first in process-environment. */
942 for (; ep
!= new_env
; ep
++)
944 char *p
= *ep
, *q
= string
;
948 /* The string is malformed; might as well drop it. */
963 prepare_standard_handles (in
, out
, err
, handles
);
964 #else /* not WINDOWSNT */
965 /* Make sure that in, out, and err are not actually already in
966 descriptors zero, one, or two; this could happen if Emacs is
967 started with its standard in, out, or error closed, as might
970 int oin
= in
, oout
= out
;
972 /* We have to avoid relocating the same descriptor twice! */
974 in
= relocate_fd (in
, 3);
979 out
= relocate_fd (out
, 3);
983 else if (err
== oout
)
986 err
= relocate_fd (err
, 3);
999 #endif /* not WINDOWSNT */
1001 #if defined(USG) && !defined(BSD_PGRPS)
1002 #ifndef SETPGRP_RELEASES_CTTY
1003 setpgrp (); /* No arguments but equivalent in this case */
1008 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1009 EMACS_SET_TTY_PGRP (0, &pid
);
1012 something missing here
;
1016 /* Spawn the child. (See ntproc.c:Spawnve). */
1017 cpid
= spawnve (_P_NOWAIT
, new_argv
[0], new_argv
, env
);
1019 /* An error occurred while trying to spawn the process. */
1020 report_file_error ("Spawning child process", Qnil
);
1021 reset_standard_handles (in
, out
, err
, handles
);
1023 #else /* not WINDOWSNT */
1024 /* execvp does not accept an environment arg so the only way
1025 to pass this environment is to set environ. Our caller
1026 is responsible for restoring the ambient value of environ. */
1028 execvp (new_argv
[0], new_argv
);
1030 write (1, "Can't exec program: ", 20);
1031 write (1, new_argv
[0], strlen (new_argv
[0]));
1034 #endif /* not WINDOWSNT */
1035 #endif /* not MSDOS */
1038 /* Move the file descriptor FD so that its number is not less than MIN.
1039 If the file descriptor is moved at all, the original is freed. */
1041 relocate_fd (fd
, min
)
1051 char *message1
= "Error while setting up child: ";
1052 char *errmessage
= strerror (errno
);
1053 char *message2
= "\n";
1054 write (2, message1
, strlen (message1
));
1055 write (2, errmessage
, strlen (errmessage
));
1056 write (2, message2
, strlen (message2
));
1059 /* Note that we hold the original FD open while we recurse,
1060 to guarantee we'll get a new FD if we need it. */
1061 new = relocate_fd (new, min
);
1068 getenv_internal (var
, varlen
, value
, valuelen
)
1076 for (scan
= Vprocess_environment
; CONSP (scan
); scan
= XCONS (scan
)->cdr
)
1080 entry
= XCONS (scan
)->car
;
1082 && XSTRING (entry
)->size
> varlen
1083 && XSTRING (entry
)->data
[varlen
] == '='
1085 /* NT environment variables are case insensitive. */
1086 && ! strnicmp (XSTRING (entry
)->data
, var
, varlen
)
1087 #else /* not WINDOWSNT */
1088 && ! bcmp (XSTRING (entry
)->data
, var
, varlen
)
1089 #endif /* not WINDOWSNT */
1092 *value
= (char *) XSTRING (entry
)->data
+ (varlen
+ 1);
1093 *valuelen
= XSTRING (entry
)->size
- (varlen
+ 1);
1101 DEFUN ("getenv", Fgetenv
, Sgetenv
, 1, 1, 0,
1102 "Return the value of environment variable VAR, as a string.\n\
1103 VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
1104 This function consults the variable ``process-environment'' for its value.")
1111 CHECK_STRING (var
, 0);
1112 if (getenv_internal (XSTRING (var
)->data
, XSTRING (var
)->size
,
1114 return make_string (value
, valuelen
);
1119 /* A version of getenv that consults process_environment, easily
1128 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
))
1134 #endif /* not VMS */
1136 /* This is run before init_cmdargs. */
1140 char *data_dir
= egetenv ("EMACSDATA");
1141 char *doc_dir
= egetenv ("EMACSDOC");
1144 = Ffile_name_as_directory (build_string (data_dir
? data_dir
1147 = Ffile_name_as_directory (build_string (doc_dir
? doc_dir
1150 /* Check the EMACSPATH environment variable, defaulting to the
1151 PATH_EXEC path from paths.h. */
1152 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
1153 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
1154 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
1157 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1161 char *data_dir
= egetenv ("EMACSDATA");
1164 Lisp_Object tempdir
;
1166 if (initialized
&& !NILP (Vinstallation_directory
))
1168 /* Add to the path the lib-src subdir of the installation dir. */
1170 tem
= Fexpand_file_name (build_string ("lib-src"),
1171 Vinstallation_directory
);
1172 if (NILP (Fmember (tem
, Vexec_path
)))
1175 /* MSDOS uses wrapped binaries, so don't do this. */
1176 Vexec_path
= nconc2 (Vexec_path
, Fcons (tem
, Qnil
));
1177 Vexec_directory
= Ffile_name_as_directory (tem
);
1178 #endif /* not DOS_NT */
1181 /* Maybe use ../etc as well as ../lib-src. */
1184 tem
= Fexpand_file_name (build_string ("etc"),
1185 Vinstallation_directory
);
1186 Vdoc_directory
= Ffile_name_as_directory (tem
);
1190 /* Look for the files that should be in etc. We don't use
1191 Vinstallation_directory, because these files are never installed
1192 near the executable, and they are never in the build
1193 directory when that's different from the source directory.
1195 Instead, if these files are not in the nominal place, we try the
1196 source directory. */
1199 Lisp_Object tem
, tem1
, newdir
;
1201 tem
= Fexpand_file_name (build_string ("GNU"), Vdata_directory
);
1202 tem1
= Ffile_exists_p (tem
);
1205 newdir
= Fexpand_file_name (build_string ("../etc/"),
1206 build_string (PATH_DUMPLOADSEARCH
));
1207 tem
= Fexpand_file_name (build_string ("GNU"), newdir
);
1208 tem1
= Ffile_exists_p (tem
);
1210 Vdata_directory
= newdir
;
1214 tempdir
= Fdirectory_file_name (Vexec_directory
);
1215 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1216 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1219 tempdir
= Fdirectory_file_name (Vdata_directory
);
1220 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1221 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1225 Vshell_file_name
= build_string ("*dcl*");
1227 sh
= (char *) getenv ("SHELL");
1228 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
1232 Vtemp_file_name_pattern
= build_string ("tmp:emacsXXXXXX.");
1234 if (getenv ("TMPDIR"))
1236 char *dir
= getenv ("TMPDIR");
1237 Vtemp_file_name_pattern
1238 = Fexpand_file_name (build_string ("emacsXXXXXX"),
1239 build_string (dir
));
1242 Vtemp_file_name_pattern
= build_string ("/tmp/emacsXXXXXX");
1246 set_process_environment ()
1248 register char **envp
;
1250 Vprocess_environment
= Qnil
;
1254 for (envp
= environ
; *envp
; envp
++)
1255 Vprocess_environment
= Fcons (build_string (*envp
),
1256 Vprocess_environment
);
1262 Qbuffer_file_type
= intern ("buffer-file-type");
1263 staticpro (&Qbuffer_file_type
);
1265 DEFVAR_LISP ("binary-process-input", &Vbinary_process_input
,
1266 "*If non-nil then new subprocesses are assumed to take binary input.");
1267 Vbinary_process_input
= Qnil
;
1269 DEFVAR_LISP ("binary-process-output", &Vbinary_process_output
,
1270 "*If non-nil then new subprocesses are assumed to produce binary output.");
1271 Vbinary_process_output
= Qnil
;
1274 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
1275 "*File name to load inferior shells from.\n\
1276 Initialized from the SHELL environment variable.");
1278 DEFVAR_LISP ("exec-path", &Vexec_path
,
1279 "*List of directories to search programs to run in subprocesses.\n\
1280 Each element is a string (directory name) or nil (try default directory).");
1282 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
1283 "Directory of architecture-dependent files that come with GNU Emacs,\n\
1284 especially executable programs intended for Emacs to invoke.");
1286 DEFVAR_LISP ("data-directory", &Vdata_directory
,
1287 "Directory of architecture-independent files that come with GNU Emacs,\n\
1288 intended for Emacs to use.");
1290 DEFVAR_LISP ("doc-directory", &Vdoc_directory
,
1291 "Directory containing the DOC file that comes with GNU Emacs.\n\
1292 This is usually the same as data-directory.");
1294 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
1295 "For internal use by the build procedure only.\n\
1296 This is the name of the directory in which the build procedure installed\n\
1297 Emacs's info files; the default value for Info-default-directory-list\n\
1299 Vconfigure_info_directory
= build_string (PATH_INFO
);
1301 DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern
,
1302 "Pattern for making names for temporary files.\n\
1303 This is used by `call-process-region'.");
1304 /* The real initialization is when we start again. */
1305 Vtemp_file_name_pattern
= Qnil
;
1307 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
1308 "List of environment variables for subprocesses to inherit.\n\
1309 Each element should be a string of the form ENVVARNAME=VALUE.\n\
1310 The environment which Emacs inherits is placed in this variable\n\
1311 when Emacs starts.");
1314 defsubr (&Scall_process
);
1317 defsubr (&Scall_process_region
);