1 /* Synchronous subprocess invocation for GNU Emacs.
2 Copyright (C) 1985, 86,87,88,93,94,95, 1999 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 /* Define SIGCHLD as an alias for SIGCLD. */
31 #if !defined (SIGCHLD) && defined (SIGCLD)
32 #define SIGCHLD SIGCLD
35 #include <sys/types.h>
43 #define INCLUDED_FCNTL
50 #include <stdlib.h> /* for proper declaration of environ */
53 #define _P_NOWAIT 1 /* from process.h */
56 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
57 #define INCLUDED_FCNTL
60 #include <sys/param.h>
80 #include "syssignal.h"
88 extern noshare
char **environ
;
90 extern char **environ
;
93 #define max(a, b) ((a) > (b) ? (a) : (b))
95 Lisp_Object Vexec_path
, Vexec_directory
, Vdata_directory
, Vdoc_directory
;
96 Lisp_Object Vconfigure_info_directory
;
97 Lisp_Object Vtemp_file_name_pattern
;
99 Lisp_Object Vshell_file_name
;
101 Lisp_Object Vprocess_environment
;
104 Lisp_Object Qbuffer_file_type
;
107 /* True iff we are about to fork off a synchronous process or if we
108 are waiting for it. */
109 int synch_process_alive
;
111 /* Nonzero => this is a string explaining death of synchronous subprocess. */
112 char *synch_process_death
;
114 /* If synch_process_death is zero,
115 this is exit code of synchronous subprocess. */
116 int synch_process_retcode
;
118 extern Lisp_Object Vdoc_file_name
;
120 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
122 /* Clean up when exiting Fcall_process.
123 On MSDOS, delete the temporary file on any kind of termination.
124 On Unix, kill the process and any children on termination by signal. */
126 /* Nonzero if this is termination due to exit. */
127 static int call_process_exited
;
129 #ifndef VMS /* VMS version is in vmsproc.c. */
132 call_process_kill (fdpid
)
135 emacs_close (XFASTINT (Fcar (fdpid
)));
136 EMACS_KILLPG (XFASTINT (Fcdr (fdpid
)), SIGKILL
);
137 synch_process_alive
= 0;
142 call_process_cleanup (fdpid
)
145 #if defined (MSDOS) || defined (macintosh)
146 /* for MSDOS fdpid is really (fd . tempfile) */
147 register Lisp_Object file
;
149 emacs_close (XFASTINT (Fcar (fdpid
)));
150 if (strcmp (XSTRING (file
)-> data
, NULL_DEVICE
) != 0)
151 unlink (XSTRING (file
)->data
);
152 #else /* not MSDOS and not macintosh */
153 register int pid
= XFASTINT (Fcdr (fdpid
));
155 if (call_process_exited
)
157 emacs_close (XFASTINT (Fcar (fdpid
)));
161 if (EMACS_KILLPG (pid
, SIGINT
) == 0)
163 int count
= specpdl_ptr
- specpdl
;
164 record_unwind_protect (call_process_kill
, fdpid
);
165 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
168 wait_for_termination (pid
);
170 specpdl_ptr
= specpdl
+ count
; /* Discard the unwind protect. */
171 message1 ("Waiting for process to die...done");
173 synch_process_alive
= 0;
174 emacs_close (XFASTINT (Fcar (fdpid
)));
175 #endif /* not MSDOS */
179 DEFUN ("call-process", Fcall_process
, Scall_process
, 1, MANY
, 0,
180 "Call PROGRAM synchronously in separate process.\n\
181 The remaining arguments are optional.\n\
182 The program's input comes from file INFILE (nil means `/dev/null').\n\
183 Insert output in BUFFER before point; t means current buffer;\n\
184 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
185 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
186 REAL-BUFFER says what to do with standard output, as above,\n\
187 while STDERR-FILE says what to do with standard error in the child.\n\
188 STDERR-FILE may be nil (discard standard error output),\n\
189 t (mix it with ordinary output), or a file name string.\n\
191 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
192 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
194 If BUFFER is 0, `call-process' returns immediately with value nil.\n\
195 Otherwise it waits for PROGRAM to terminate\n\
196 and returns a numeric exit status or a signal description string.\n\
197 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
200 register Lisp_Object
*args
;
202 Lisp_Object infile
, buffer
, current_dir
, display
, path
;
209 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
;
228 struct coding_system process_coding
; /* coding-system of process output */
229 struct coding_system argument_coding
; /* coding-system of arguments */
230 /* Set to the return value of Ffind_operation_coding_system. */
231 Lisp_Object coding_systems
;
233 /* Qt denotes that Ffind_operation_coding_system is not yet called. */
236 CHECK_STRING (args
[0], 0);
241 /* Without asynchronous processes we cannot have BUFFER == 0. */
243 && (INTEGERP (CONSP (args
[2]) ? XCAR (args
[2]) : args
[2])))
244 error ("Operating system cannot handle asynchronous subprocesses");
245 #endif /* subprocesses */
247 /* Decide the coding-system for giving arguments. */
249 Lisp_Object val
, *args2
;
252 /* If arguments are supplied, we may have to encode them. */
257 for (i
= 4; i
< nargs
; i
++)
258 CHECK_STRING (args
[i
], i
);
260 for (i
= 4; i
< nargs
; i
++)
261 if (STRING_MULTIBYTE (args
[i
]))
264 if (!NILP (Vcoding_system_for_write
))
265 val
= Vcoding_system_for_write
;
266 else if (! must_encode
)
270 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
271 args2
[0] = Qcall_process
;
272 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
273 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
274 if (CONSP (coding_systems
))
275 val
= XCDR (coding_systems
);
276 else if (CONSP (Vdefault_process_coding_system
))
277 val
= XCDR (Vdefault_process_coding_system
);
281 setup_coding_system (Fcheck_coding_system (val
), &argument_coding
);
285 if (nargs
>= 2 && ! NILP (args
[1]))
287 infile
= Fexpand_file_name (args
[1], current_buffer
->directory
);
288 CHECK_STRING (infile
, 1);
291 infile
= build_string (NULL_DEVICE
);
297 /* If BUFFER is a list, its meaning is
298 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
301 if (CONSP (XCDR (buffer
)))
303 Lisp_Object stderr_file
;
304 stderr_file
= XCAR (XCDR (buffer
));
306 if (NILP (stderr_file
) || EQ (Qt
, stderr_file
))
307 error_file
= stderr_file
;
309 error_file
= Fexpand_file_name (stderr_file
, Qnil
);
312 buffer
= XCAR (buffer
);
315 if (!(EQ (buffer
, Qnil
)
317 || INTEGERP (buffer
)))
319 Lisp_Object spec_buffer
;
320 spec_buffer
= buffer
;
321 buffer
= Fget_buffer_create (buffer
);
322 /* Mention the buffer name for a better error message. */
324 CHECK_BUFFER (spec_buffer
, 2);
325 CHECK_BUFFER (buffer
, 2);
331 /* Make sure that the child will be able to chdir to the current
332 buffer's current directory, or its unhandled equivalent. We
333 can't just have the child check for an error when it does the
334 chdir, since it's in a vfork.
336 We have to GCPRO around this because Fexpand_file_name,
337 Funhandled_file_name_directory, and Ffile_accessible_directory_p
338 might call a file name handling function. The argument list is
339 protected by the caller, so all we really have to worry about is
342 struct gcpro gcpro1
, gcpro2
, gcpro3
;
344 current_dir
= current_buffer
->directory
;
346 GCPRO3 (infile
, buffer
, current_dir
);
349 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
351 if (NILP (Ffile_accessible_directory_p (current_dir
)))
352 report_file_error ("Setting current directory",
353 Fcons (current_buffer
->directory
, Qnil
));
358 display
= nargs
>= 4 ? args
[3] : Qnil
;
360 filefd
= emacs_open (XSTRING (infile
)->data
, O_RDONLY
, 0);
363 report_file_error ("Opening process input file", Fcons (infile
, Qnil
));
365 /* Search for program; barf if not found. */
369 GCPRO1 (current_dir
);
370 openp (Vexec_path
, args
[0], EXEC_SUFFIXES
, &path
, 1);
375 emacs_close (filefd
);
376 report_file_error ("Searching for program", Fcons (args
[0], Qnil
));
378 new_argv
[0] = XSTRING (path
)->data
;
383 if (CODING_REQUIRE_ENCODING (&argument_coding
))
385 /* We must encode the arguments. */
386 struct gcpro gcpro1
, gcpro2
, gcpro3
;
388 GCPRO3 (infile
, buffer
, current_dir
);
389 for (i
= 4; i
< nargs
; i
++)
391 args
[i
] = code_convert_string (args
[i
], &argument_coding
, 1, 0);
392 setup_ccl_program (&(argument_coding
.spec
.ccl
.encoder
), Qnil
);
396 for (i
= 4; i
< nargs
; i
++)
397 new_argv
[i
- 3] = XSTRING (args
[i
])->data
;
398 new_argv
[nargs
- 3] = 0;
403 #ifdef MSDOS /* MW, July 1993 */
404 if ((outf
= egetenv ("TMPDIR")))
405 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
408 tempfile
= alloca (20);
411 dostounix_filename (tempfile
);
412 if (*tempfile
== '\0' || tempfile
[strlen (tempfile
) - 1] != '/')
413 strcat (tempfile
, "/");
414 strcat (tempfile
, "detmp.XXX");
417 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
420 emacs_close (filefd
);
421 report_file_error ("Opening process output file",
422 Fcons (build_string (tempfile
), Qnil
));
429 /* Since we don't have pipes on the Mac, create a temporary file to
430 hold the output of the subprocess. */
431 tempfile
= (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
432 bcopy (XSTRING (Vtemp_file_name_pattern
)->data
, tempfile
,
433 STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
437 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
441 report_file_error ("Opening process output file",
442 Fcons (build_string (tempfile
), Qnil
));
446 #endif /* macintosh */
448 if (INTEGERP (buffer
))
449 fd
[1] = emacs_open (NULL_DEVICE
, O_WRONLY
, 0), fd
[0] = -1;
458 /* Replaced by close_process_descs */
459 set_exclusive_use (fd
[0]);
464 /* child_setup must clobber environ in systems with true vfork.
465 Protect it from permanent change. */
466 register char **save_environ
= environ
;
467 register int fd1
= fd
[1];
470 #if 0 /* Some systems don't have sigblock. */
471 mask
= sigblock (sigmask (SIGCHLD
));
474 /* Record that we're about to create a synchronous process. */
475 synch_process_alive
= 1;
477 /* These vars record information from process termination.
478 Clear them now before process can possibly terminate,
479 to avoid timing error if process terminates soon. */
480 synch_process_death
= 0;
481 synch_process_retcode
= 0;
483 if (NILP (error_file
))
484 fd_error
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
485 else if (STRINGP (error_file
))
488 fd_error
= emacs_open (XSTRING (error_file
)->data
,
489 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
491 #else /* not DOS_NT */
492 fd_error
= creat (XSTRING (error_file
)->data
, 0666);
493 #endif /* not DOS_NT */
498 emacs_close (filefd
);
506 report_file_error ("Cannot redirect stderr",
507 Fcons ((NILP (error_file
)
508 ? build_string (NULL_DEVICE
) : error_file
),
512 current_dir
= ENCODE_FILE (current_dir
);
516 /* Call run_mac_command in sysdep.c here directly instead of doing
517 a child_setup as for MSDOS and other platforms. Note that this
518 code does not handle passing the environment to the synchronous
520 char *infn
, *outfn
, *errfn
, *currdn
;
522 /* close these files so subprocess can write to them */
524 if (fd_error
!= outfilefd
)
526 fd1
= -1; /* No harm in closing that one! */
528 infn
= XSTRING (infile
)->data
;
530 if (NILP (error_file
))
532 else if (EQ (Qt
, error_file
))
535 errfn
= XSTRING (error_file
)->data
;
536 currdn
= XSTRING (current_dir
)->data
;
537 pid
= run_mac_command (new_argv
, currdn
, infn
, outfn
, errfn
);
539 /* Record that the synchronous process exited and note its
540 termination status. */
541 synch_process_alive
= 0;
542 synch_process_retcode
= pid
;
543 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
545 synchronize_system_messages_locale ();
546 synch_process_death
= strerror (errno
);
549 /* Since CRLF is converted to LF within `decode_coding', we can
550 always open a file with binary mode. */
551 fd
[0] = open (tempfile
, O_BINARY
);
556 report_file_error ("Cannot re-open temporary file", Qnil
);
559 #else /* not macintosh */
560 #ifdef MSDOS /* MW, July 1993 */
561 /* Note that on MSDOS `child_setup' actually returns the child process
562 exit status, not its PID, so we assign it to `synch_process_retcode'
564 pid
= child_setup (filefd
, outfilefd
, fd_error
, (char **) new_argv
,
567 /* Record that the synchronous process exited and note its
568 termination status. */
569 synch_process_alive
= 0;
570 synch_process_retcode
= pid
;
571 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
573 synchronize_system_messages_locale ();
574 synch_process_death
= strerror (errno
);
577 emacs_close (outfilefd
);
578 if (fd_error
!= outfilefd
)
579 emacs_close (fd_error
);
580 fd1
= -1; /* No harm in closing that one! */
581 /* Since CRLF is converted to LF within `decode_coding', we can
582 always open a file with binary mode. */
583 fd
[0] = emacs_open (tempfile
, O_RDONLY
| O_BINARY
, 0);
587 emacs_close (filefd
);
588 report_file_error ("Cannot re-open temporary file", Qnil
);
590 #else /* not MSDOS */
592 pid
= child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
594 #else /* not WINDOWSNT */
604 #if defined (USG) && !defined (BSD_PGRPS)
609 child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
612 #endif /* not WINDOWSNT */
614 /* The MSDOS case did this already. */
616 emacs_close (fd_error
);
617 #endif /* not MSDOS */
618 #endif /* not macintosh */
620 environ
= save_environ
;
622 /* Close most of our fd's, but not fd[0]
623 since we will use that to read input from. */
624 emacs_close (filefd
);
625 if (fd1
>= 0 && fd1
!= fd_error
)
633 report_file_error ("Doing vfork", Qnil
);
636 if (INTEGERP (buffer
))
641 /* If Emacs has been built with asynchronous subprocess support,
642 we don't need to do this, I think because it will then have
643 the facilities for handling SIGCHLD. */
644 wait_without_blocking ();
645 #endif /* subprocesses */
649 /* Enable sending signal if user quits below. */
650 call_process_exited
= 0;
652 #if defined(MSDOS) || defined(macintosh)
653 /* MSDOS needs different cleanup information. */
654 record_unwind_protect (call_process_cleanup
,
655 Fcons (make_number (fd
[0]), build_string (tempfile
)));
657 record_unwind_protect (call_process_cleanup
,
658 Fcons (make_number (fd
[0]), make_number (pid
)));
659 #endif /* not MSDOS and not macintosh */
662 if (BUFFERP (buffer
))
663 Fset_buffer (buffer
);
667 /* If BUFFER is nil, we must read process output once and then
668 discard it, so setup coding system but with nil. */
669 setup_coding_system (Qnil
, &process_coding
);
673 Lisp_Object val
, *args2
;
676 if (!NILP (Vcoding_system_for_read
))
677 val
= Vcoding_system_for_read
;
680 if (EQ (coding_systems
, Qt
))
684 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
685 args2
[0] = Qcall_process
;
686 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
688 = Ffind_operation_coding_system (nargs
+ 1, args2
);
690 if (CONSP (coding_systems
))
691 val
= XCAR (coding_systems
);
692 else if (CONSP (Vdefault_process_coding_system
))
693 val
= XCAR (Vdefault_process_coding_system
);
697 setup_coding_system (Fcheck_coding_system (val
), &process_coding
);
698 /* In unibyte mode, character code conversion should not take
699 place but EOL conversion should. So, setup raw-text or one
700 of the subsidiary according to the information just setup. */
701 if (NILP (current_buffer
->enable_multibyte_characters
)
703 setup_raw_text_coding_system (&process_coding
);
714 int display_on_the_fly
= !NILP (display
) && INTERACTIVE
;
715 struct coding_system saved_coding
;
717 saved_coding
= process_coding
;
721 /* Repeatedly read until we've filled as much as possible
722 of the buffer size we have. But don't read
723 less than 1024--save that for the next bufferful. */
725 while (nread
< bufsize
- 1024)
727 int this_read
= emacs_read (fd
[0], bufptr
+ nread
,
735 process_coding
.mode
|= CODING_MODE_LAST_BLOCK
;
740 total_read
+= this_read
;
742 if (display_on_the_fly
)
746 /* Now NREAD is the total amount of data in the buffer. */
751 if (! CODING_REQUIRE_DECODING (&process_coding
))
752 insert (bufptr
, nread
);
754 { /* We have to decode the input. */
755 int size
= decoding_buffer_size (&process_coding
, nread
);
756 char *decoding_buf
= (char *) xmalloc (size
);
758 decode_coding (&process_coding
, bufptr
, decoding_buf
,
760 if (display_on_the_fly
761 && saved_coding
.type
== coding_type_undecided
762 && process_coding
.type
!= coding_type_undecided
)
764 /* We have detected some coding system. But,
765 there's a possibility that the detection was
766 done by insufficient data. So, we give up
767 displaying on the fly. */
768 xfree (decoding_buf
);
769 display_on_the_fly
= 0;
770 process_coding
= saved_coding
;
774 if (process_coding
.produced
> 0)
775 insert (decoding_buf
, process_coding
.produced
);
776 xfree (decoding_buf
);
777 carryover
= nread
- process_coding
.consumed
;
780 /* As CARRYOVER should not be that large, we had
781 better avoid overhead of bcopy. */
782 char *p
= bufptr
+ process_coding
.consumed
;
783 char *pend
= p
+ carryover
;
786 while (p
< pend
) *dst
++ = *p
++;
790 if (process_coding
.mode
& CODING_MODE_LAST_BLOCK
)
793 insert (bufptr
, carryover
);
797 /* Make the buffer bigger as we continue to read more data,
799 if (bufsize
< 64 * 1024 && total_read
> 32 * bufsize
)
802 bufptr
= (char *) alloca (bufsize
);
805 if (!NILP (display
) && INTERACTIVE
)
808 prepare_menu_bars ();
810 redisplay_preserve_echo_area ();
817 Vlast_coding_system_used
= process_coding
.symbol
;
819 /* If the caller required, let the buffer inherit the
820 coding-system used to decode the process output. */
821 if (inherit_process_coding_system
)
822 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
823 make_number (total_read
));
826 /* Wait for it to terminate, unless it already has. */
827 wait_for_termination (pid
);
831 set_buffer_internal (old
);
833 /* Don't kill any children that the subprocess may have left behind
835 call_process_exited
= 1;
837 unbind_to (count
, Qnil
);
839 if (synch_process_death
)
840 return code_convert_string_norecord (build_string (synch_process_death
),
841 Vlocale_coding_system
, 0);
842 return make_number (synch_process_retcode
);
847 delete_temp_file (name
)
850 /* Use Fdelete_file (indirectly) because that runs a file name handler.
851 We did that when writing the file, so we should do so when deleting. */
852 internal_delete_file (name
);
855 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
857 "Send text from START to END to a synchronous process running PROGRAM.\n\
858 The remaining arguments are optional.\n\
859 Delete the text if fourth arg DELETE is non-nil.\n\
861 Insert output in BUFFER before point; t means current buffer;\n\
862 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
863 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
864 REAL-BUFFER says what to do with standard output, as above,\n\
865 while STDERR-FILE says what to do with standard error in the child.\n\
866 STDERR-FILE may be nil (discard standard error output),\n\
867 t (mix it with ordinary output), or a file name string.\n\
869 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
870 Remaining args are passed to PROGRAM at startup as command args.\n\
872 If BUFFER is nil, `call-process-region' returns immediately with value nil.\n\
873 Otherwise it waits for PROGRAM to terminate\n\
874 and returns a numeric exit status or a signal description string.\n\
875 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
878 register Lisp_Object
*args
;
881 Lisp_Object filename_string
;
882 register Lisp_Object start
, end
;
883 int count
= specpdl_ptr
- specpdl
;
884 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
885 Lisp_Object coding_systems
;
886 Lisp_Object val
, *args2
;
892 if ((outf
= egetenv ("TMPDIR"))
893 || (outf
= egetenv ("TMP"))
894 || (outf
= egetenv ("TEMP")))
895 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
898 tempfile
= alloca (20);
901 if (!IS_DIRECTORY_SEP (tempfile
[strlen (tempfile
) - 1]))
902 strcat (tempfile
, "/");
903 if ('/' == DIRECTORY_SEP
)
904 dostounix_filename (tempfile
);
906 unixtodos_filename (tempfile
);
908 strcat (tempfile
, "emXXXXXX");
910 strcat (tempfile
, "detmp.XXX");
912 #else /* not DOS_NT */
913 char *tempfile
= (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
914 bcopy (XSTRING (Vtemp_file_name_pattern
)->data
, tempfile
,
915 STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
916 #endif /* not DOS_NT */
922 filename_string
= build_string (tempfile
);
923 GCPRO1 (filename_string
);
926 /* Decide coding-system of the contents of the temporary file. */
927 if (!NILP (Vcoding_system_for_write
))
928 val
= Vcoding_system_for_write
;
929 else if (NILP (current_buffer
->enable_multibyte_characters
))
933 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
934 args2
[0] = Qcall_process_region
;
935 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
936 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
937 if (CONSP (coding_systems
))
938 val
= XCDR (coding_systems
);
939 else if (CONSP (Vdefault_process_coding_system
))
940 val
= XCDR (Vdefault_process_coding_system
);
946 int count1
= specpdl_ptr
- specpdl
;
948 specbind (intern ("coding-system-for-write"), val
);
949 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
, Qnil
, Qnil
);
951 unbind_to (count1
, Qnil
);
954 /* Note that Fcall_process takes care of binding
955 coding-system-for-read. */
957 record_unwind_protect (delete_temp_file
, filename_string
);
959 if (nargs
> 3 && !NILP (args
[3]))
960 Fdelete_region (start
, end
);
972 args
[1] = filename_string
;
974 RETURN_UNGCPRO (unbind_to (count
, Fcall_process (nargs
, args
)));
977 #ifndef VMS /* VMS version is in vmsproc.c. */
979 static int relocate_fd ();
981 /* This is the last thing run in a newly forked inferior
982 either synchronous or asynchronous.
983 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
984 Initialize inferior's priority, pgrp, connected dir and environment.
985 then exec another program based on new_argv.
987 This function may change environ for the superior process.
988 Therefore, the superior process must save and restore the value
989 of environ around the vfork and the call to this function.
991 SET_PGRP is nonzero if we should put the subprocess into a separate
994 CURRENT_DIR is an elisp string giving the path of the current
995 directory the subprocess should have. Since we can't really signal
996 a decent error from within the child, this should be verified as an
997 executable directory by the parent. */
1000 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
1002 register char **new_argv
;
1004 Lisp_Object current_dir
;
1011 #endif /* WINDOWSNT */
1013 int pid
= getpid ();
1015 #ifdef SET_EMACS_PRIORITY
1017 extern int emacs_priority
;
1019 if (emacs_priority
< 0)
1020 nice (- emacs_priority
);
1025 /* Close Emacs's descriptors that this process should not have. */
1026 close_process_descs ();
1028 /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
1029 we will lose if we call close_load_descs here. */
1031 close_load_descs ();
1034 /* Note that use of alloca is always safe here. It's obvious for systems
1035 that do not have true vfork or that have true (stack) alloca.
1036 If using vfork and C_ALLOCA it is safe because that changes
1037 the superior's static variables as if the superior had done alloca
1038 and will be cleaned up in the usual way. */
1040 register char *temp
;
1043 i
= STRING_BYTES (XSTRING (current_dir
));
1044 pwd_var
= (char *) alloca (i
+ 6);
1046 bcopy ("PWD=", pwd_var
, 4);
1047 bcopy (XSTRING (current_dir
)->data
, temp
, i
);
1048 if (!IS_DIRECTORY_SEP (temp
[i
- 1])) temp
[i
++] = DIRECTORY_SEP
;
1052 /* We can't signal an Elisp error here; we're in a vfork. Since
1053 the callers check the current directory before forking, this
1054 should only return an error if the directory's permissions
1055 are changed between the check and this chdir, but we should
1057 if (chdir (temp
) < 0)
1062 /* Get past the drive letter, so that d:/ is left alone. */
1063 if (i
> 2 && IS_DEVICE_SEP (temp
[1]) && IS_DIRECTORY_SEP (temp
[2]))
1070 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1071 while (i
> 2 && IS_DIRECTORY_SEP (temp
[i
- 1]))
1075 /* Set `env' to a vector of the strings in Vprocess_environment. */
1077 register Lisp_Object tem
;
1078 register char **new_env
;
1079 register int new_length
;
1082 for (tem
= Vprocess_environment
;
1083 CONSP (tem
) && STRINGP (XCAR (tem
));
1087 /* new_length + 2 to include PWD and terminating 0. */
1088 env
= new_env
= (char **) alloca ((new_length
+ 2) * sizeof (char *));
1090 /* If we have a PWD envvar, pass one down,
1091 but with corrected value. */
1093 *new_env
++ = pwd_var
;
1095 /* Copy the Vprocess_environment strings into new_env. */
1096 for (tem
= Vprocess_environment
;
1097 CONSP (tem
) && STRINGP (XCAR (tem
));
1101 char *string
= (char *) XSTRING (XCAR (tem
))->data
;
1102 /* See if this string duplicates any string already in the env.
1103 If so, don't put it in.
1104 When an env var has multiple definitions,
1105 we keep the definition that comes first in process-environment. */
1106 for (; ep
!= new_env
; ep
++)
1108 char *p
= *ep
, *q
= string
;
1112 /* The string is malformed; might as well drop it. */
1121 *new_env
++ = string
;
1127 prepare_standard_handles (in
, out
, err
, handles
);
1128 set_process_dir (XSTRING (current_dir
)->data
);
1129 #else /* not WINDOWSNT */
1130 /* Make sure that in, out, and err are not actually already in
1131 descriptors zero, one, or two; this could happen if Emacs is
1132 started with its standard in, out, or error closed, as might
1135 int oin
= in
, oout
= out
;
1137 /* We have to avoid relocating the same descriptor twice! */
1139 in
= relocate_fd (in
, 3);
1144 out
= relocate_fd (out
, 3);
1148 else if (err
== oout
)
1151 err
= relocate_fd (err
, 3);
1165 #endif /* not MSDOS */
1166 #endif /* not WINDOWSNT */
1168 #if defined(USG) && !defined(BSD_PGRPS)
1169 #ifndef SETPGRP_RELEASES_CTTY
1170 setpgrp (); /* No arguments but equivalent in this case */
1175 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1176 EMACS_SET_TTY_PGRP (0, &pid
);
1179 something missing here
;
1183 pid
= run_msdos_command (new_argv
, pwd_var
+ 4, in
, out
, err
, env
);
1185 /* An error occurred while trying to run the subprocess. */
1186 report_file_error ("Spawning child process", Qnil
);
1188 #else /* not MSDOS */
1190 /* Spawn the child. (See ntproc.c:Spawnve). */
1191 cpid
= spawnve (_P_NOWAIT
, new_argv
[0], new_argv
, env
);
1192 reset_standard_handles (in
, out
, err
, handles
);
1194 /* An error occurred while trying to spawn the process. */
1195 report_file_error ("Spawning child process", Qnil
);
1197 #else /* not WINDOWSNT */
1198 /* execvp does not accept an environment arg so the only way
1199 to pass this environment is to set environ. Our caller
1200 is responsible for restoring the ambient value of environ. */
1202 execvp (new_argv
[0], new_argv
);
1204 emacs_write (1, "Can't exec program: ", 20);
1205 emacs_write (1, new_argv
[0], strlen (new_argv
[0]));
1206 emacs_write (1, "\n", 1);
1208 #endif /* not WINDOWSNT */
1209 #endif /* not MSDOS */
1212 /* Move the file descriptor FD so that its number is not less than MINFD.
1213 If the file descriptor is moved at all, the original is freed. */
1215 relocate_fd (fd
, minfd
)
1225 char *message1
= "Error while setting up child: ";
1226 char *errmessage
= strerror (errno
);
1227 char *message2
= "\n";
1228 emacs_write (2, message1
, strlen (message1
));
1229 emacs_write (2, errmessage
, strlen (errmessage
));
1230 emacs_write (2, message2
, strlen (message2
));
1233 /* Note that we hold the original FD open while we recurse,
1234 to guarantee we'll get a new FD if we need it. */
1235 new = relocate_fd (new, minfd
);
1242 getenv_internal (var
, varlen
, value
, valuelen
)
1250 for (scan
= Vprocess_environment
; CONSP (scan
); scan
= XCDR (scan
))
1254 entry
= XCAR (scan
);
1256 && STRING_BYTES (XSTRING (entry
)) > varlen
1257 && XSTRING (entry
)->data
[varlen
] == '='
1259 /* NT environment variables are case insensitive. */
1260 && ! strnicmp (XSTRING (entry
)->data
, var
, varlen
)
1261 #else /* not WINDOWSNT */
1262 && ! bcmp (XSTRING (entry
)->data
, var
, varlen
)
1263 #endif /* not WINDOWSNT */
1266 *value
= (char *) XSTRING (entry
)->data
+ (varlen
+ 1);
1267 *valuelen
= STRING_BYTES (XSTRING (entry
)) - (varlen
+ 1);
1275 DEFUN ("getenv-internal", Fgetenv_internal
, Sgetenv_internal
, 1, 1, 0,
1276 "Return the value of environment variable VAR, as a string.\n\
1277 VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
1278 This function consults the variable ``process-environment'' for its value.")
1285 CHECK_STRING (var
, 0);
1286 if (getenv_internal (XSTRING (var
)->data
, STRING_BYTES (XSTRING (var
)),
1288 return make_string (value
, valuelen
);
1293 /* A version of getenv that consults process_environment, easily
1302 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
))
1308 #endif /* not VMS */
1310 /* This is run before init_cmdargs. */
1315 char *data_dir
= egetenv ("EMACSDATA");
1316 char *doc_dir
= egetenv ("EMACSDOC");
1319 = Ffile_name_as_directory (build_string (data_dir
? data_dir
1322 = Ffile_name_as_directory (build_string (doc_dir
? doc_dir
1325 /* Check the EMACSPATH environment variable, defaulting to the
1326 PATH_EXEC path from epaths.h. */
1327 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
1328 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
1329 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
1332 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1337 char *data_dir
= egetenv ("EMACSDATA");
1340 Lisp_Object tempdir
;
1342 if (!NILP (Vinstallation_directory
))
1344 /* Add to the path the lib-src subdir of the installation dir. */
1346 tem
= Fexpand_file_name (build_string ("lib-src"),
1347 Vinstallation_directory
);
1349 /* MSDOS uses wrapped binaries, so don't do this. */
1350 if (NILP (Fmember (tem
, Vexec_path
)))
1351 Vexec_path
= nconc2 (Vexec_path
, Fcons (tem
, Qnil
));
1353 Vexec_directory
= Ffile_name_as_directory (tem
);
1354 #endif /* not DOS_NT */
1356 /* Maybe use ../etc as well as ../lib-src. */
1359 tem
= Fexpand_file_name (build_string ("etc"),
1360 Vinstallation_directory
);
1361 Vdoc_directory
= Ffile_name_as_directory (tem
);
1365 /* Look for the files that should be in etc. We don't use
1366 Vinstallation_directory, because these files are never installed
1367 near the executable, and they are never in the build
1368 directory when that's different from the source directory.
1370 Instead, if these files are not in the nominal place, we try the
1371 source directory. */
1374 Lisp_Object tem
, tem1
, newdir
;
1376 tem
= Fexpand_file_name (build_string ("GNU"), Vdata_directory
);
1377 tem1
= Ffile_exists_p (tem
);
1380 newdir
= Fexpand_file_name (build_string ("../etc/"),
1381 build_string (PATH_DUMPLOADSEARCH
));
1382 tem
= Fexpand_file_name (build_string ("GNU"), newdir
);
1383 tem1
= Ffile_exists_p (tem
);
1385 Vdata_directory
= newdir
;
1393 tempdir
= Fdirectory_file_name (Vexec_directory
);
1394 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1395 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1399 tempdir
= Fdirectory_file_name (Vdata_directory
);
1400 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1401 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1405 Vshell_file_name
= build_string ("*dcl*");
1407 sh
= (char *) getenv ("SHELL");
1408 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
1412 Vtemp_file_name_pattern
= build_string ("tmp:emacsXXXXXX.");
1414 if (getenv ("TMPDIR"))
1416 char *dir
= getenv ("TMPDIR");
1417 Vtemp_file_name_pattern
1418 = Fexpand_file_name (build_string ("emacsXXXXXX"),
1419 build_string (dir
));
1422 Vtemp_file_name_pattern
= build_string ("/tmp/emacsXXXXXX");
1427 set_process_environment ()
1429 register char **envp
;
1431 Vprocess_environment
= Qnil
;
1435 for (envp
= environ
; *envp
; envp
++)
1436 Vprocess_environment
= Fcons (build_string (*envp
),
1437 Vprocess_environment
);
1444 Qbuffer_file_type
= intern ("buffer-file-type");
1445 staticpro (&Qbuffer_file_type
);
1448 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
1449 "*File name to load inferior shells from.\n\
1450 Initialized from the SHELL environment variable.");
1452 DEFVAR_LISP ("exec-path", &Vexec_path
,
1453 "*List of directories to search programs to run in subprocesses.\n\
1454 Each element is a string (directory name) or nil (try default directory).");
1456 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
1457 "Directory for executables for Emacs to invoke.\n\
1458 More generally, this includes any architecture-dependent files\n\
1459 that are built and installed from the Emacs distribution.");
1461 DEFVAR_LISP ("data-directory", &Vdata_directory
,
1462 "Directory of machine-independent files that come with GNU Emacs.\n\
1463 These are files intended for Emacs to use while it runs.");
1465 DEFVAR_LISP ("doc-directory", &Vdoc_directory
,
1466 "Directory containing the DOC file that comes with GNU Emacs.\n\
1467 This is usually the same as data-directory.");
1469 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
1470 "For internal use by the build procedure only.\n\
1471 This is the name of the directory in which the build procedure installed\n\
1472 Emacs's info files; the default value for Info-default-directory-list\n\
1474 Vconfigure_info_directory
= build_string (PATH_INFO
);
1476 DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern
,
1477 "Pattern for making names for temporary files.\n\
1478 This is used by `call-process-region'.");
1479 /* This variable is initialized in init_callproc. */
1481 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
1482 "List of environment variables for subprocesses to inherit.\n\
1483 Each element should be a string of the form ENVVARNAME=VALUE.\n\
1484 The environment which Emacs inherits is placed in this variable\n\
1485 when Emacs starts.");
1488 defsubr (&Scall_process
);
1489 defsubr (&Sgetenv_internal
);
1491 defsubr (&Scall_process_region
);