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
);
395 new_argv
[i
- 3] = (unsigned char *) alloca (size
);
396 produced
= encode_coding (&argument_coding
,
397 XSTRING (args
[i
])->data
, new_argv
[i
- 3],
398 XSTRING (args
[i
])->size
, size
, &dummy
);
399 new_argv
[i
- 3][produced
] = 0;
405 #ifdef MSDOS /* MW, July 1993 */
406 if ((outf
= egetenv ("TMP")) || (outf
= egetenv ("TEMP")))
407 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
410 tempfile
= alloca (20);
413 dostounix_filename (tempfile
);
414 if (*tempfile
== '\0' || tempfile
[strlen (tempfile
) - 1] != '/')
415 strcat (tempfile
, "/");
416 strcat (tempfile
, "detmp.XXX");
419 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
423 report_file_error ("Opening process output file",
424 Fcons (build_string (tempfile
), Qnil
));
430 if (INTEGERP (buffer
))
431 fd
[1] = open (NULL_DEVICE
, O_WRONLY
), fd
[0] = -1;
438 /* Replaced by close_process_descs */
439 set_exclusive_use (fd
[0]);
444 /* child_setup must clobber environ in systems with true vfork.
445 Protect it from permanent change. */
446 register char **save_environ
= environ
;
447 register int fd1
= fd
[1];
450 #if 0 /* Some systems don't have sigblock. */
451 mask
= sigblock (sigmask (SIGCHLD
));
454 /* Record that we're about to create a synchronous process. */
455 synch_process_alive
= 1;
457 /* These vars record information from process termination.
458 Clear them now before process can possibly terminate,
459 to avoid timing error if process terminates soon. */
460 synch_process_death
= 0;
461 synch_process_retcode
= 0;
463 if (NILP (error_file
))
464 fd_error
= open (NULL_DEVICE
, O_WRONLY
);
465 else if (STRINGP (error_file
))
468 fd_error
= open (XSTRING (error_file
)->data
,
469 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
471 #else /* not DOS_NT */
472 fd_error
= creat (XSTRING (error_file
)->data
, 0666);
473 #endif /* not DOS_NT */
486 report_file_error ("Cannot redirect stderr",
487 Fcons ((NILP (error_file
)
488 ? build_string (NULL_DEVICE
) : error_file
),
491 #ifdef MSDOS /* MW, July 1993 */
492 /* ??? Someone who knows MSDOG needs to check whether this properly
493 closes all descriptors that it opens.
495 Note that run_msdos_command() actually returns the child process
496 exit status, not its PID, so we assign it to `synch_process_retcode'
498 pid
= run_msdos_command (new_argv
, current_dir
,
499 filefd
, outfilefd
, fd_error
);
501 /* Record that the synchronous process exited and note its
502 termination status. */
503 synch_process_alive
= 0;
504 synch_process_retcode
= pid
;
505 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
506 synch_process_death
= strerror(errno
);
509 if (fd_error
!= outfilefd
)
511 fd1
= -1; /* No harm in closing that one! */
512 /* Since CRLF is converted to LF within `decode_coding', we can
513 always open a file with binary mode. */
514 fd
[0] = open (tempfile
, O_BINARY
);
519 report_file_error ("Cannot re-open temporary file", Qnil
);
521 #else /* not MSDOS */
523 pid
= child_setup (filefd
, fd1
, fd_error
, new_argv
, 0, current_dir
);
524 #else /* not WINDOWSNT */
534 #if defined (USG) && !defined (BSD_PGRPS)
539 child_setup (filefd
, fd1
, fd_error
, new_argv
, 0, current_dir
);
541 #endif /* not WINDOWSNT */
543 /* The MSDOS case did this already. */
546 #endif /* not MSDOS */
548 environ
= save_environ
;
550 /* Close most of our fd's, but not fd[0]
551 since we will use that to read input from. */
553 if (fd1
>= 0 && fd1
!= fd_error
)
561 report_file_error ("Doing vfork", Qnil
);
564 if (INTEGERP (buffer
))
569 /* If Emacs has been built with asynchronous subprocess support,
570 we don't need to do this, I think because it will then have
571 the facilities for handling SIGCHLD. */
572 wait_without_blocking ();
573 #endif /* subprocesses */
577 /* Enable sending signal if user quits below. */
578 call_process_exited
= 0;
581 /* MSDOS needs different cleanup information. */
582 record_unwind_protect (call_process_cleanup
,
583 Fcons (make_number (fd
[0]), build_string (tempfile
)));
585 record_unwind_protect (call_process_cleanup
,
586 Fcons (make_number (fd
[0]), make_number (pid
)));
587 #endif /* not MSDOS */
590 if (BUFFERP (buffer
))
591 Fset_buffer (buffer
);
603 /* Repeatedly read until we've filled as much as possible
604 of the buffer size we have. But don't read
605 less than 1024--save that for the next bufferful. */
607 nread
= process_coding
.carryover_size
; /* This value is initially 0. */
608 while (nread
< bufsize
- 1024)
611 = read (fd
[0], bufptr
+ nread
, bufsize
- nread
);
624 /* Now NREAD is the total amount of data in the buffer. */
626 /* Here, just tell decode_coding that we are processing the
627 last block. We break the loop after decoding. */
628 process_coding
.last_block
= 1;
635 if (process_coding
.type
== coding_type_no_conversion
)
636 insert (bufptr
, nread
);
638 { /* We have to decode the input. */
639 int size
= decoding_buffer_size (&process_coding
, bufsize
);
640 char *decoding_buf
= get_conversion_buffer (size
);
643 nread
= decode_coding (&process_coding
, bufptr
, decoding_buf
,
644 nread
, size
, &dummy
);
646 insert (decoding_buf
, nread
);
650 if (process_coding
.last_block
)
653 /* Make the buffer bigger as we continue to read more data,
655 if (bufsize
< 64 * 1024 && total_read
> 32 * bufsize
)
658 bufptr
= (char *) alloca (bufsize
);
661 if (!NILP (buffer
) && process_coding
.carryover_size
> 0)
662 /* We have carryover in the last decoding. It should be
663 processed again after reading more data. */
664 bcopy (process_coding
.carryover
, bufptr
,
665 process_coding
.carryover_size
);
667 if (!NILP (display
) && INTERACTIVE
)
670 prepare_menu_bars ();
672 redisplay_preserve_echo_area ();
680 /* Wait for it to terminate, unless it already has. */
681 wait_for_termination (pid
);
685 set_buffer_internal (old
);
687 /* Don't kill any children that the subprocess may have left behind
689 call_process_exited
= 1;
691 unbind_to (count
, Qnil
);
693 if (synch_process_death
)
694 return build_string (synch_process_death
);
695 return make_number (synch_process_retcode
);
700 delete_temp_file (name
)
703 /* Use Fdelete_file (indirectly) because that runs a file name handler.
704 We did that when writing the file, so we should do so when deleting. */
705 internal_delete_file (name
);
708 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
710 "Send text from START to END to a synchronous process running PROGRAM.\n\
711 Delete the text if fourth arg DELETE is non-nil.\n\
713 Insert output in BUFFER before point; t means current buffer;\n\
714 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
715 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
716 REAL-BUFFER says what to do with standard output, as above,\n\
717 while STDERR-FILE says what to do with standard error in the child.\n\
718 STDERR-FILE may be nil (discard standard error output),\n\
719 t (mix it with ordinary output), or a file name string.\n\
721 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
722 Remaining args are passed to PROGRAM at startup as command args.\n\
724 If BUFFER is nil, `call-process-region' returns immediately with value nil.\n\
725 Otherwise it waits for PROGRAM to terminate\n\
726 and returns a numeric exit status or a signal description string.\n\
727 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
730 register Lisp_Object
*args
;
733 Lisp_Object filename_string
;
734 register Lisp_Object start
, end
;
735 int count
= specpdl_ptr
- specpdl
;
736 /* Qt denotes that we have not yet called Ffind_coding_system. */
737 Lisp_Object coding_systems
= Qt
;
738 Lisp_Object val
, *args2
;
744 if ((outf
= egetenv ("TMP")) || (outf
= egetenv ("TEMP")))
745 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
748 tempfile
= alloca (20);
751 if (!IS_DIRECTORY_SEP (tempfile
[strlen (tempfile
) - 1]))
752 strcat (tempfile
, "/");
753 if ('/' == DIRECTORY_SEP
)
754 dostounix_filename (tempfile
);
756 unixtodos_filename (tempfile
);
758 strcat (tempfile
, "emXXXXXX");
760 strcat (tempfile
, "detmp.XXX");
762 #else /* not DOS_NT */
763 char *tempfile
= (char *) alloca (XSTRING (Vtemp_file_name_pattern
)->size
+ 1);
764 bcopy (XSTRING (Vtemp_file_name_pattern
)->data
, tempfile
,
765 XSTRING (Vtemp_file_name_pattern
)->size
+ 1);
766 #endif /* not DOS_NT */
770 filename_string
= build_string (tempfile
);
771 GCPRO1 (filename_string
);
774 /* Decide coding-system of the contents of the temporary file. */
776 specbind (Qbuffer_file_type
, Vbinary_process_input
);
777 if (NILP (Vbinary_process_input
))
781 if (NILP (val
= Vcoding_system_for_write
))
783 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
784 args2
[0] = Qcall_process_region
;
785 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
786 coding_systems
= Ffind_coding_system (nargs
+ 1, args2
);
787 if (CONSP (coding_systems
))
788 val
= XCONS (coding_systems
)->cdr
;
789 else if (CONSP (Vdefault_process_coding_system
))
790 val
= XCONS (Vdefault_process_coding_system
)->car
;
792 specbind (intern ("coding-system-for-write"), val
);
793 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
, Qnil
);
796 if (NILP (Vbinary_process_input
))
800 if (NILP (val
= Vcoding_system_for_read
))
802 if (EQ (coding_systems
, Qt
))
804 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
805 args2
[0] = Qcall_process_region
;
806 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
807 coding_systems
= Ffind_coding_system (nargs
+ 1, args2
);
809 val
= CONSP (coding_systems
) ? XCONS (coding_systems
)->car
: Qnil
;
811 specbind (intern ("coding-system-for-read"), val
);
813 record_unwind_protect (delete_temp_file
, filename_string
);
816 Fdelete_region (start
, end
);
818 args
[3] = filename_string
;
820 RETURN_UNGCPRO (unbind_to (count
, Fcall_process (nargs
- 2, args
+ 2)));
823 #ifndef VMS /* VMS version is in vmsproc.c. */
825 /* This is the last thing run in a newly forked inferior
826 either synchronous or asynchronous.
827 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
828 Initialize inferior's priority, pgrp, connected dir and environment.
829 then exec another program based on new_argv.
831 This function may change environ for the superior process.
832 Therefore, the superior process must save and restore the value
833 of environ around the vfork and the call to this function.
835 ENV is the environment for the subprocess.
837 SET_PGRP is nonzero if we should put the subprocess into a separate
840 CURRENT_DIR is an elisp string giving the path of the current
841 directory the subprocess should have. Since we can't really signal
842 a decent error from within the child, this should be verified as an
843 executable directory by the parent. */
845 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
847 register char **new_argv
;
849 Lisp_Object current_dir
;
852 /* The MSDOS port of gcc cannot fork, vfork, ... so we must call system
854 #else /* not MSDOS */
860 #endif /* WINDOWSNT */
864 #ifdef SET_EMACS_PRIORITY
866 extern int emacs_priority
;
868 if (emacs_priority
< 0)
869 nice (- emacs_priority
);
874 /* Close Emacs's descriptors that this process should not have. */
875 close_process_descs ();
879 /* Note that use of alloca is always safe here. It's obvious for systems
880 that do not have true vfork or that have true (stack) alloca.
881 If using vfork and C_ALLOCA it is safe because that changes
882 the superior's static variables as if the superior had done alloca
883 and will be cleaned up in the usual way. */
888 i
= XSTRING (current_dir
)->size
;
889 pwd_var
= (char *) alloca (i
+ 6);
891 bcopy ("PWD=", pwd_var
, 4);
892 bcopy (XSTRING (current_dir
)->data
, temp
, i
);
893 if (!IS_DIRECTORY_SEP (temp
[i
- 1])) temp
[i
++] = DIRECTORY_SEP
;
896 /* We can't signal an Elisp error here; we're in a vfork. Since
897 the callers check the current directory before forking, this
898 should only return an error if the directory's permissions
899 are changed between the check and this chdir, but we should
901 if (chdir (temp
) < 0)
904 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
905 while (i
> 2 && IS_DIRECTORY_SEP (temp
[i
- 1]))
909 /* Set `env' to a vector of the strings in Vprocess_environment. */
911 register Lisp_Object tem
;
912 register char **new_env
;
913 register int new_length
;
916 for (tem
= Vprocess_environment
;
917 CONSP (tem
) && STRINGP (XCONS (tem
)->car
);
918 tem
= XCONS (tem
)->cdr
)
921 /* new_length + 2 to include PWD and terminating 0. */
922 env
= new_env
= (char **) alloca ((new_length
+ 2) * sizeof (char *));
924 /* If we have a PWD envvar, pass one down,
925 but with corrected value. */
927 *new_env
++ = pwd_var
;
929 /* Copy the Vprocess_environment strings into new_env. */
930 for (tem
= Vprocess_environment
;
931 CONSP (tem
) && STRINGP (XCONS (tem
)->car
);
932 tem
= XCONS (tem
)->cdr
)
935 char *string
= (char *) XSTRING (XCONS (tem
)->car
)->data
;
936 /* See if this string duplicates any string already in the env.
937 If so, don't put it in.
938 When an env var has multiple definitions,
939 we keep the definition that comes first in process-environment. */
940 for (; ep
!= new_env
; ep
++)
942 char *p
= *ep
, *q
= string
;
946 /* The string is malformed; might as well drop it. */
961 prepare_standard_handles (in
, out
, err
, handles
);
962 #else /* not WINDOWSNT */
963 /* Make sure that in, out, and err are not actually already in
964 descriptors zero, one, or two; this could happen if Emacs is
965 started with its standard in, out, or error closed, as might
968 int oin
= in
, oout
= out
;
970 /* We have to avoid relocating the same descriptor twice! */
972 in
= relocate_fd (in
, 3);
977 out
= relocate_fd (out
, 3);
981 else if (err
== oout
)
984 err
= relocate_fd (err
, 3);
997 #endif /* not WINDOWSNT */
999 #if defined(USG) && !defined(BSD_PGRPS)
1000 #ifndef SETPGRP_RELEASES_CTTY
1001 setpgrp (); /* No arguments but equivalent in this case */
1006 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1007 EMACS_SET_TTY_PGRP (0, &pid
);
1010 something missing here
;
1014 /* Spawn the child. (See ntproc.c:Spawnve). */
1015 cpid
= spawnve (_P_NOWAIT
, new_argv
[0], new_argv
, env
);
1017 /* An error occurred while trying to spawn the process. */
1018 report_file_error ("Spawning child process", Qnil
);
1019 reset_standard_handles (in
, out
, err
, handles
);
1021 #else /* not WINDOWSNT */
1022 /* execvp does not accept an environment arg so the only way
1023 to pass this environment is to set environ. Our caller
1024 is responsible for restoring the ambient value of environ. */
1026 execvp (new_argv
[0], new_argv
);
1028 write (1, "Can't exec program: ", 20);
1029 write (1, new_argv
[0], strlen (new_argv
[0]));
1032 #endif /* not WINDOWSNT */
1033 #endif /* not MSDOS */
1036 /* Move the file descriptor FD so that its number is not less than MIN.
1037 If the file descriptor is moved at all, the original is freed. */
1039 relocate_fd (fd
, min
)
1049 char *message1
= "Error while setting up child: ";
1050 char *errmessage
= strerror (errno
);
1051 char *message2
= "\n";
1052 write (2, message1
, strlen (message1
));
1053 write (2, errmessage
, strlen (errmessage
));
1054 write (2, message2
, strlen (message2
));
1057 /* Note that we hold the original FD open while we recurse,
1058 to guarantee we'll get a new FD if we need it. */
1059 new = relocate_fd (new, min
);
1066 getenv_internal (var
, varlen
, value
, valuelen
)
1074 for (scan
= Vprocess_environment
; CONSP (scan
); scan
= XCONS (scan
)->cdr
)
1078 entry
= XCONS (scan
)->car
;
1080 && XSTRING (entry
)->size
> varlen
1081 && XSTRING (entry
)->data
[varlen
] == '='
1083 /* NT environment variables are case insensitive. */
1084 && ! strnicmp (XSTRING (entry
)->data
, var
, varlen
)
1085 #else /* not WINDOWSNT */
1086 && ! bcmp (XSTRING (entry
)->data
, var
, varlen
)
1087 #endif /* not WINDOWSNT */
1090 *value
= (char *) XSTRING (entry
)->data
+ (varlen
+ 1);
1091 *valuelen
= XSTRING (entry
)->size
- (varlen
+ 1);
1099 DEFUN ("getenv", Fgetenv
, Sgetenv
, 1, 1, 0,
1100 "Return the value of environment variable VAR, as a string.\n\
1101 VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
1102 This function consults the variable ``process-environment'' for its value.")
1109 CHECK_STRING (var
, 0);
1110 if (getenv_internal (XSTRING (var
)->data
, XSTRING (var
)->size
,
1112 return make_string (value
, valuelen
);
1117 /* A version of getenv that consults process_environment, easily
1126 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
))
1132 #endif /* not VMS */
1134 /* This is run before init_cmdargs. */
1138 char *data_dir
= egetenv ("EMACSDATA");
1139 char *doc_dir
= egetenv ("EMACSDOC");
1142 = Ffile_name_as_directory (build_string (data_dir
? data_dir
1145 = Ffile_name_as_directory (build_string (doc_dir
? doc_dir
1148 /* Check the EMACSPATH environment variable, defaulting to the
1149 PATH_EXEC path from paths.h. */
1150 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
1151 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
1152 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
1155 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1159 char *data_dir
= egetenv ("EMACSDATA");
1162 Lisp_Object tempdir
;
1164 if (initialized
&& !NILP (Vinstallation_directory
))
1166 /* Add to the path the lib-src subdir of the installation dir. */
1168 tem
= Fexpand_file_name (build_string ("lib-src"),
1169 Vinstallation_directory
);
1170 if (NILP (Fmember (tem
, Vexec_path
)))
1173 /* MSDOS uses wrapped binaries, so don't do this. */
1174 Vexec_path
= nconc2 (Vexec_path
, Fcons (tem
, Qnil
));
1175 Vexec_directory
= Ffile_name_as_directory (tem
);
1176 #endif /* not DOS_NT */
1179 /* Maybe use ../etc as well as ../lib-src. */
1182 tem
= Fexpand_file_name (build_string ("etc"),
1183 Vinstallation_directory
);
1184 Vdoc_directory
= Ffile_name_as_directory (tem
);
1188 /* Look for the files that should be in etc. We don't use
1189 Vinstallation_directory, because these files are never installed
1190 near the executable, and they are never in the build
1191 directory when that's different from the source directory.
1193 Instead, if these files are not in the nominal place, we try the
1194 source directory. */
1197 Lisp_Object tem
, tem1
, newdir
;
1199 tem
= Fexpand_file_name (build_string ("GNU"), Vdata_directory
);
1200 tem1
= Ffile_exists_p (tem
);
1203 newdir
= Fexpand_file_name (build_string ("../etc/"),
1204 build_string (PATH_DUMPLOADSEARCH
));
1205 tem
= Fexpand_file_name (build_string ("GNU"), newdir
);
1206 tem1
= Ffile_exists_p (tem
);
1208 Vdata_directory
= newdir
;
1212 tempdir
= Fdirectory_file_name (Vexec_directory
);
1213 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1214 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1217 tempdir
= Fdirectory_file_name (Vdata_directory
);
1218 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1219 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1223 Vshell_file_name
= build_string ("*dcl*");
1225 sh
= (char *) getenv ("SHELL");
1226 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
1230 Vtemp_file_name_pattern
= build_string ("tmp:emacsXXXXXX.");
1232 if (getenv ("TMPDIR"))
1234 char *dir
= getenv ("TMPDIR");
1235 Vtemp_file_name_pattern
1236 = Fexpand_file_name (build_string ("emacsXXXXXX"),
1237 build_string (dir
));
1240 Vtemp_file_name_pattern
= build_string ("/tmp/emacsXXXXXX");
1244 set_process_environment ()
1246 register char **envp
;
1248 Vprocess_environment
= Qnil
;
1252 for (envp
= environ
; *envp
; envp
++)
1253 Vprocess_environment
= Fcons (build_string (*envp
),
1254 Vprocess_environment
);
1260 Qbuffer_file_type
= intern ("buffer-file-type");
1261 staticpro (&Qbuffer_file_type
);
1263 DEFVAR_LISP ("binary-process-input", &Vbinary_process_input
,
1264 "*If non-nil then new subprocesses are assumed to take binary input.");
1265 Vbinary_process_input
= Qnil
;
1267 DEFVAR_LISP ("binary-process-output", &Vbinary_process_output
,
1268 "*If non-nil then new subprocesses are assumed to produce binary output.");
1269 Vbinary_process_output
= Qnil
;
1272 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
1273 "*File name to load inferior shells from.\n\
1274 Initialized from the SHELL environment variable.");
1276 DEFVAR_LISP ("exec-path", &Vexec_path
,
1277 "*List of directories to search programs to run in subprocesses.\n\
1278 Each element is a string (directory name) or nil (try default directory).");
1280 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
1281 "Directory of architecture-dependent files that come with GNU Emacs,\n\
1282 especially executable programs intended for Emacs to invoke.");
1284 DEFVAR_LISP ("data-directory", &Vdata_directory
,
1285 "Directory of architecture-independent files that come with GNU Emacs,\n\
1286 intended for Emacs to use.");
1288 DEFVAR_LISP ("doc-directory", &Vdoc_directory
,
1289 "Directory containing the DOC file that comes with GNU Emacs.\n\
1290 This is usually the same as data-directory.");
1292 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
1293 "For internal use by the build procedure only.\n\
1294 This is the name of the directory in which the build procedure installed\n\
1295 Emacs's info files; the default value for Info-default-directory-list\n\
1297 Vconfigure_info_directory
= build_string (PATH_INFO
);
1299 DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern
,
1300 "Pattern for making names for temporary files.\n\
1301 This is used by `call-process-region'.");
1302 /* The real initialization is when we start again. */
1303 Vtemp_file_name_pattern
= Qnil
;
1305 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
1306 "List of environment variables for subprocesses to inherit.\n\
1307 Each element should be a string of the form ENVVARNAME=VALUE.\n\
1308 The environment which Emacs inherits is placed in this variable\n\
1309 when Emacs starts.");
1312 defsubr (&Scall_process
);
1315 defsubr (&Scall_process_region
);