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>
78 #include "composite.h"
81 #include "syssignal.h"
89 extern noshare
char **environ
;
91 extern char **environ
;
95 #if !defined (USG) || defined (BSD_PGRPS)
97 #define setpgrp setpgid
101 #define max(a, b) ((a) > (b) ? (a) : (b))
103 Lisp_Object Vexec_path
, Vexec_directory
, Vdata_directory
, Vdoc_directory
;
104 Lisp_Object Vconfigure_info_directory
;
105 Lisp_Object Vtemp_file_name_pattern
;
107 Lisp_Object Vshell_file_name
;
109 Lisp_Object Vprocess_environment
;
112 Lisp_Object Qbuffer_file_type
;
115 /* True iff we are about to fork off a synchronous process or if we
116 are waiting for it. */
117 int synch_process_alive
;
119 /* Nonzero => this is a string explaining death of synchronous subprocess. */
120 char *synch_process_death
;
122 /* If synch_process_death is zero,
123 this is exit code of synchronous subprocess. */
124 int synch_process_retcode
;
126 extern Lisp_Object Vdoc_file_name
;
128 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
130 /* Clean up when exiting Fcall_process.
131 On MSDOS, delete the temporary file on any kind of termination.
132 On Unix, kill the process and any children on termination by signal. */
134 /* Nonzero if this is termination due to exit. */
135 static int call_process_exited
;
137 #ifndef VMS /* VMS version is in vmsproc.c. */
140 call_process_kill (fdpid
)
143 emacs_close (XFASTINT (Fcar (fdpid
)));
144 EMACS_KILLPG (XFASTINT (Fcdr (fdpid
)), SIGKILL
);
145 synch_process_alive
= 0;
150 call_process_cleanup (fdpid
)
153 #if defined (MSDOS) || defined (macintosh)
154 /* for MSDOS fdpid is really (fd . tempfile) */
155 register Lisp_Object file
;
157 emacs_close (XFASTINT (Fcar (fdpid
)));
158 if (strcmp (XSTRING (file
)-> data
, NULL_DEVICE
) != 0)
159 unlink (XSTRING (file
)->data
);
160 #else /* not MSDOS and not macintosh */
161 register int pid
= XFASTINT (Fcdr (fdpid
));
163 if (call_process_exited
)
165 emacs_close (XFASTINT (Fcar (fdpid
)));
169 if (EMACS_KILLPG (pid
, SIGINT
) == 0)
171 int count
= specpdl_ptr
- specpdl
;
172 record_unwind_protect (call_process_kill
, fdpid
);
173 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
176 wait_for_termination (pid
);
178 specpdl_ptr
= specpdl
+ count
; /* Discard the unwind protect. */
179 message1 ("Waiting for process to die...done");
181 synch_process_alive
= 0;
182 emacs_close (XFASTINT (Fcar (fdpid
)));
183 #endif /* not MSDOS */
187 DEFUN ("call-process", Fcall_process
, Scall_process
, 1, MANY
, 0,
188 "Call PROGRAM synchronously in separate process.\n\
189 The remaining arguments are optional.\n\
190 The program's input comes from file INFILE (nil means `/dev/null').\n\
191 Insert output in BUFFER before point; t means current buffer;\n\
192 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
193 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
194 REAL-BUFFER says what to do with standard output, as above,\n\
195 while STDERR-FILE says what to do with standard error in the child.\n\
196 STDERR-FILE may be nil (discard standard error output),\n\
197 t (mix it with ordinary output), or a file name string.\n\
199 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
200 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
202 If BUFFER is 0, `call-process' returns immediately with value nil.\n\
203 Otherwise it waits for PROGRAM to terminate\n\
204 and returns a numeric exit status or a signal description string.\n\
205 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
208 register Lisp_Object
*args
;
210 Lisp_Object infile
, buffer
, current_dir
, display
, path
;
217 int count
= specpdl_ptr
- specpdl
;
219 register unsigned char **new_argv
220 = (unsigned char **) alloca ((max (2, nargs
- 2)) * sizeof (char *));
221 struct buffer
*old
= current_buffer
;
222 /* File to use for stderr in the child.
223 t means use same as standard output. */
224 Lisp_Object error_file
;
225 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
226 char *outf
, *tempfile
;
236 struct coding_system process_coding
; /* coding-system of process output */
237 struct coding_system argument_coding
; /* coding-system of arguments */
238 /* Set to the return value of Ffind_operation_coding_system. */
239 Lisp_Object coding_systems
;
241 /* Qt denotes that Ffind_operation_coding_system is not yet called. */
244 CHECK_STRING (args
[0], 0);
249 /* Without asynchronous processes we cannot have BUFFER == 0. */
251 && (INTEGERP (CONSP (args
[2]) ? XCAR (args
[2]) : args
[2])))
252 error ("Operating system cannot handle asynchronous subprocesses");
253 #endif /* subprocesses */
255 /* Decide the coding-system for giving arguments. */
257 Lisp_Object val
, *args2
;
260 /* If arguments are supplied, we may have to encode them. */
265 for (i
= 4; i
< nargs
; i
++)
266 CHECK_STRING (args
[i
], i
);
268 for (i
= 4; i
< nargs
; i
++)
269 if (STRING_MULTIBYTE (args
[i
]))
272 if (!NILP (Vcoding_system_for_write
))
273 val
= Vcoding_system_for_write
;
274 else if (! must_encode
)
278 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
279 args2
[0] = Qcall_process
;
280 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
281 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
282 if (CONSP (coding_systems
))
283 val
= XCDR (coding_systems
);
284 else if (CONSP (Vdefault_process_coding_system
))
285 val
= XCDR (Vdefault_process_coding_system
);
289 setup_coding_system (Fcheck_coding_system (val
), &argument_coding
);
293 if (nargs
>= 2 && ! NILP (args
[1]))
295 infile
= Fexpand_file_name (args
[1], current_buffer
->directory
);
296 CHECK_STRING (infile
, 1);
299 infile
= build_string (NULL_DEVICE
);
305 /* If BUFFER is a list, its meaning is
306 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
309 if (CONSP (XCDR (buffer
)))
311 Lisp_Object stderr_file
;
312 stderr_file
= XCAR (XCDR (buffer
));
314 if (NILP (stderr_file
) || EQ (Qt
, stderr_file
))
315 error_file
= stderr_file
;
317 error_file
= Fexpand_file_name (stderr_file
, Qnil
);
320 buffer
= XCAR (buffer
);
323 if (!(EQ (buffer
, Qnil
)
325 || INTEGERP (buffer
)))
327 Lisp_Object spec_buffer
;
328 spec_buffer
= buffer
;
329 buffer
= Fget_buffer_create (buffer
);
330 /* Mention the buffer name for a better error message. */
332 CHECK_BUFFER (spec_buffer
, 2);
333 CHECK_BUFFER (buffer
, 2);
339 /* Make sure that the child will be able to chdir to the current
340 buffer's current directory, or its unhandled equivalent. We
341 can't just have the child check for an error when it does the
342 chdir, since it's in a vfork.
344 We have to GCPRO around this because Fexpand_file_name,
345 Funhandled_file_name_directory, and Ffile_accessible_directory_p
346 might call a file name handling function. The argument list is
347 protected by the caller, so all we really have to worry about is
350 struct gcpro gcpro1
, gcpro2
, gcpro3
;
352 current_dir
= current_buffer
->directory
;
354 GCPRO3 (infile
, buffer
, current_dir
);
357 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
359 if (NILP (Ffile_accessible_directory_p (current_dir
)))
360 report_file_error ("Setting current directory",
361 Fcons (current_buffer
->directory
, Qnil
));
366 display
= nargs
>= 4 ? args
[3] : Qnil
;
368 filefd
= emacs_open (XSTRING (infile
)->data
, O_RDONLY
, 0);
371 report_file_error ("Opening process input file", Fcons (infile
, Qnil
));
373 /* Search for program; barf if not found. */
377 GCPRO1 (current_dir
);
378 openp (Vexec_path
, args
[0], EXEC_SUFFIXES
, &path
, 1);
383 emacs_close (filefd
);
384 report_file_error ("Searching for program", Fcons (args
[0], Qnil
));
386 new_argv
[0] = XSTRING (path
)->data
;
390 struct gcpro gcpro1
, gcpro2
, gcpro3
;
392 GCPRO3 (infile
, buffer
, current_dir
);
393 argument_coding
.dst_multibyte
= 0;
394 for (i
= 4; i
< nargs
; i
++)
396 argument_coding
.src_multibyte
= STRING_MULTIBYTE (args
[i
]);
397 if (CODING_REQUIRE_ENCODING (&argument_coding
))
399 /* We must encode this argument. */
400 args
[i
] = encode_coding_string (args
[i
], &argument_coding
, 1);
401 if (argument_coding
.type
== coding_type_ccl
)
402 setup_ccl_program (&(argument_coding
.spec
.ccl
.encoder
), Qnil
);
404 new_argv
[i
- 3] = XSTRING (args
[i
])->data
;
407 new_argv
[nargs
- 3] = 0;
412 #ifdef MSDOS /* MW, July 1993 */
413 if ((outf
= egetenv ("TMPDIR")))
414 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
417 tempfile
= alloca (20);
420 dostounix_filename (tempfile
);
421 if (*tempfile
== '\0' || tempfile
[strlen (tempfile
) - 1] != '/')
422 strcat (tempfile
, "/");
423 strcat (tempfile
, "detmp.XXX");
426 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
429 emacs_close (filefd
);
430 report_file_error ("Opening process output file",
431 Fcons (build_string (tempfile
), Qnil
));
438 /* Since we don't have pipes on the Mac, create a temporary file to
439 hold the output of the subprocess. */
440 tempfile
= (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
441 bcopy (XSTRING (Vtemp_file_name_pattern
)->data
, tempfile
,
442 STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
446 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
450 report_file_error ("Opening process output file",
451 Fcons (build_string (tempfile
), Qnil
));
455 #endif /* macintosh */
457 if (INTEGERP (buffer
))
458 fd
[1] = emacs_open (NULL_DEVICE
, O_WRONLY
, 0), fd
[0] = -1;
467 /* Replaced by close_process_descs */
468 set_exclusive_use (fd
[0]);
473 /* child_setup must clobber environ in systems with true vfork.
474 Protect it from permanent change. */
475 register char **save_environ
= environ
;
476 register int fd1
= fd
[1];
479 #if 0 /* Some systems don't have sigblock. */
480 mask
= sigblock (sigmask (SIGCHLD
));
483 /* Record that we're about to create a synchronous process. */
484 synch_process_alive
= 1;
486 /* These vars record information from process termination.
487 Clear them now before process can possibly terminate,
488 to avoid timing error if process terminates soon. */
489 synch_process_death
= 0;
490 synch_process_retcode
= 0;
492 if (NILP (error_file
))
493 fd_error
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
494 else if (STRINGP (error_file
))
497 fd_error
= emacs_open (XSTRING (error_file
)->data
,
498 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
500 #else /* not DOS_NT */
501 fd_error
= creat (XSTRING (error_file
)->data
, 0666);
502 #endif /* not DOS_NT */
507 emacs_close (filefd
);
515 report_file_error ("Cannot redirect stderr",
516 Fcons ((NILP (error_file
)
517 ? build_string (NULL_DEVICE
) : error_file
),
521 current_dir
= ENCODE_FILE (current_dir
);
525 /* Call run_mac_command in sysdep.c here directly instead of doing
526 a child_setup as for MSDOS and other platforms. Note that this
527 code does not handle passing the environment to the synchronous
529 char *infn
, *outfn
, *errfn
, *currdn
;
531 /* close these files so subprocess can write to them */
533 if (fd_error
!= outfilefd
)
535 fd1
= -1; /* No harm in closing that one! */
537 infn
= XSTRING (infile
)->data
;
539 if (NILP (error_file
))
541 else if (EQ (Qt
, error_file
))
544 errfn
= XSTRING (error_file
)->data
;
545 currdn
= XSTRING (current_dir
)->data
;
546 pid
= run_mac_command (new_argv
, currdn
, infn
, outfn
, errfn
);
548 /* Record that the synchronous process exited and note its
549 termination status. */
550 synch_process_alive
= 0;
551 synch_process_retcode
= pid
;
552 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
554 synchronize_system_messages_locale ();
555 synch_process_death
= strerror (errno
);
558 /* Since CRLF is converted to LF within `decode_coding', we can
559 always open a file with binary mode. */
560 fd
[0] = open (tempfile
, O_BINARY
);
565 report_file_error ("Cannot re-open temporary file", Qnil
);
568 #else /* not macintosh */
569 #ifdef MSDOS /* MW, July 1993 */
570 /* Note that on MSDOS `child_setup' actually returns the child process
571 exit status, not its PID, so we assign it to `synch_process_retcode'
573 pid
= child_setup (filefd
, outfilefd
, fd_error
, (char **) new_argv
,
576 /* Record that the synchronous process exited and note its
577 termination status. */
578 synch_process_alive
= 0;
579 synch_process_retcode
= pid
;
580 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
582 synchronize_system_messages_locale ();
583 synch_process_death
= strerror (errno
);
586 emacs_close (outfilefd
);
587 if (fd_error
!= outfilefd
)
588 emacs_close (fd_error
);
589 fd1
= -1; /* No harm in closing that one! */
590 /* Since CRLF is converted to LF within `decode_coding', we can
591 always open a file with binary mode. */
592 fd
[0] = emacs_open (tempfile
, O_RDONLY
| O_BINARY
, 0);
596 emacs_close (filefd
);
597 report_file_error ("Cannot re-open temporary file", Qnil
);
599 #else /* not MSDOS */
601 pid
= child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
603 #else /* not WINDOWSNT */
613 #if defined (USG) && !defined (BSD_PGRPS)
618 child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
621 #endif /* not WINDOWSNT */
623 /* The MSDOS case did this already. */
625 emacs_close (fd_error
);
626 #endif /* not MSDOS */
627 #endif /* not macintosh */
629 environ
= save_environ
;
631 /* Close most of our fd's, but not fd[0]
632 since we will use that to read input from. */
633 emacs_close (filefd
);
634 if (fd1
>= 0 && fd1
!= fd_error
)
642 report_file_error ("Doing vfork", Qnil
);
645 if (INTEGERP (buffer
))
650 /* If Emacs has been built with asynchronous subprocess support,
651 we don't need to do this, I think because it will then have
652 the facilities for handling SIGCHLD. */
653 wait_without_blocking ();
654 #endif /* subprocesses */
658 /* Enable sending signal if user quits below. */
659 call_process_exited
= 0;
661 #if defined(MSDOS) || defined(macintosh)
662 /* MSDOS needs different cleanup information. */
663 record_unwind_protect (call_process_cleanup
,
664 Fcons (make_number (fd
[0]), build_string (tempfile
)));
666 record_unwind_protect (call_process_cleanup
,
667 Fcons (make_number (fd
[0]), make_number (pid
)));
668 #endif /* not MSDOS and not macintosh */
671 if (BUFFERP (buffer
))
672 Fset_buffer (buffer
);
676 /* If BUFFER is nil, we must read process output once and then
677 discard it, so setup coding system but with nil. */
678 setup_coding_system (Qnil
, &process_coding
);
682 Lisp_Object val
, *args2
;
685 if (!NILP (Vcoding_system_for_read
))
686 val
= Vcoding_system_for_read
;
689 if (EQ (coding_systems
, Qt
))
693 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
694 args2
[0] = Qcall_process
;
695 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
697 = Ffind_operation_coding_system (nargs
+ 1, args2
);
699 if (CONSP (coding_systems
))
700 val
= XCAR (coding_systems
);
701 else if (CONSP (Vdefault_process_coding_system
))
702 val
= XCAR (Vdefault_process_coding_system
);
706 setup_coding_system (Fcheck_coding_system (val
), &process_coding
);
707 /* In unibyte mode, character code conversion should not take
708 place but EOL conversion should. So, setup raw-text or one
709 of the subsidiary according to the information just setup. */
710 if (NILP (current_buffer
->enable_multibyte_characters
)
712 setup_raw_text_coding_system (&process_coding
);
714 process_coding
.src_multibyte
= 0;
715 process_coding
.dst_multibyte
717 ? ! NILP (XBUFFER (buffer
)->enable_multibyte_characters
)
718 : ! NILP (current_buffer
->enable_multibyte_characters
));
728 int display_on_the_fly
= !NILP (display
) && INTERACTIVE
;
729 struct coding_system saved_coding
;
730 int pt_orig
= PT
, pt_byte_orig
= PT_BYTE
;
733 saved_coding
= process_coding
;
734 if (process_coding
.composing
!= COMPOSITION_DISABLED
)
735 coding_allocate_composition_data (&process_coding
, PT
);
738 /* Repeatedly read until we've filled as much as possible
739 of the buffer size we have. But don't read
740 less than 1024--save that for the next bufferful. */
742 while (nread
< bufsize
- 1024)
744 int this_read
= emacs_read (fd
[0], bufptr
+ nread
,
752 process_coding
.mode
|= CODING_MODE_LAST_BLOCK
;
757 total_read
+= this_read
;
759 if (display_on_the_fly
)
763 /* Now NREAD is the total amount of data in the buffer. */
768 if (! CODING_MAY_REQUIRE_DECODING (&process_coding
))
769 insert_1_both (bufptr
, nread
, nread
, 0, 1, 0);
771 { /* We have to decode the input. */
776 size
= decoding_buffer_size (&process_coding
, nread
);
777 decoding_buf
= (char *) xmalloc (size
);
778 if (process_coding
.cmp_data
)
779 process_coding
.cmp_data
->char_offset
= PT
;
780 decode_coding (&process_coding
, bufptr
, decoding_buf
,
782 if (display_on_the_fly
783 && saved_coding
.type
== coding_type_undecided
784 && process_coding
.type
!= coding_type_undecided
)
786 /* We have detected some coding system. But,
787 there's a possibility that the detection was
788 done by insufficient data. So, we give up
789 displaying on the fly. */
790 xfree (decoding_buf
);
791 display_on_the_fly
= 0;
792 process_coding
= saved_coding
;
796 if (process_coding
.produced
> 0)
797 insert_1_both (decoding_buf
, process_coding
.produced_char
,
798 process_coding
.produced
, 0, 1, 0);
799 xfree (decoding_buf
);
800 nread
-= process_coding
.consumed
;
803 /* As CARRYOVER should not be that large, we had
804 better avoid overhead of bcopy. */
805 BCOPY_SHORT (bufptr
+ process_coding
.consumed
, bufptr
,
807 if (process_coding
.result
== CODING_FINISH_INSUFFICIENT_CMP
)
809 /* The decoding ended because of insufficient data
810 area to record information about composition.
811 We must try decoding with additional data area
812 before reading more output for the process. */
813 coding_allocate_composition_data (&process_coding
, PT
);
814 goto repeat_decoding
;
819 if (process_coding
.mode
& CODING_MODE_LAST_BLOCK
)
822 /* Make the buffer bigger as we continue to read more data,
824 if (bufsize
< 64 * 1024 && total_read
> 32 * bufsize
)
827 bufptr
= (char *) alloca (bufsize
);
830 if (!NILP (display
) && INTERACTIVE
)
833 prepare_menu_bars ();
835 redisplay_preserve_echo_area ();
843 && process_coding
.cmp_data
)
845 coding_restore_composition (&process_coding
, Fcurrent_buffer ());
846 coding_free_composition_data (&process_coding
);
849 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
850 inserted
= PT
- pt_orig
;
851 TEMP_SET_PT_BOTH (pt_orig
, pt_byte_orig
);
852 if (SYMBOLP (process_coding
.post_read_conversion
)
853 && !NILP (Ffboundp (process_coding
.post_read_conversion
)))
854 call1 (process_coding
.post_read_conversion
, make_number (inserted
));
856 Vlast_coding_system_used
= process_coding
.symbol
;
858 /* If the caller required, let the buffer inherit the
859 coding-system used to decode the process output. */
860 if (inherit_process_coding_system
)
861 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
862 make_number (total_read
));
865 /* Wait for it to terminate, unless it already has. */
866 wait_for_termination (pid
);
870 set_buffer_internal (old
);
872 /* Don't kill any children that the subprocess may have left behind
874 call_process_exited
= 1;
876 unbind_to (count
, Qnil
);
878 if (synch_process_death
)
879 return code_convert_string_norecord (build_string (synch_process_death
),
880 Vlocale_coding_system
, 0);
881 return make_number (synch_process_retcode
);
886 delete_temp_file (name
)
889 /* Use Fdelete_file (indirectly) because that runs a file name handler.
890 We did that when writing the file, so we should do so when deleting. */
891 internal_delete_file (name
);
895 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
897 "Send text from START to END to a synchronous process running PROGRAM.\n\
898 The remaining arguments are optional.\n\
899 Delete the text if fourth arg DELETE is non-nil.\n\
901 Insert output in BUFFER before point; t means current buffer;\n\
902 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
903 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
904 REAL-BUFFER says what to do with standard output, as above,\n\
905 while STDERR-FILE says what to do with standard error in the child.\n\
906 STDERR-FILE may be nil (discard standard error output),\n\
907 t (mix it with ordinary output), or a file name string.\n\
909 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
910 Remaining args are passed to PROGRAM at startup as command args.\n\
912 If BUFFER is nil, `call-process-region' returns immediately with value nil.\n\
913 Otherwise it waits for PROGRAM to terminate\n\
914 and returns a numeric exit status or a signal description string.\n\
915 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
918 register Lisp_Object
*args
;
921 Lisp_Object filename_string
;
922 register Lisp_Object start
, end
;
923 int count
= specpdl_ptr
- specpdl
;
924 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
925 Lisp_Object coding_systems
;
926 Lisp_Object val
, *args2
;
932 if ((outf
= egetenv ("TMPDIR"))
933 || (outf
= egetenv ("TMP"))
934 || (outf
= egetenv ("TEMP")))
935 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
938 tempfile
= alloca (20);
941 if (!IS_DIRECTORY_SEP (tempfile
[strlen (tempfile
) - 1]))
942 strcat (tempfile
, "/");
943 if ('/' == DIRECTORY_SEP
)
944 dostounix_filename (tempfile
);
946 unixtodos_filename (tempfile
);
948 strcat (tempfile
, "emXXXXXX");
950 strcat (tempfile
, "detmp.XXX");
952 #else /* not DOS_NT */
953 char *tempfile
= (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
954 bcopy (XSTRING (Vtemp_file_name_pattern
)->data
, tempfile
,
955 STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
956 #endif /* not DOS_NT */
962 filename_string
= build_string (tempfile
);
963 GCPRO1 (filename_string
);
966 /* Decide coding-system of the contents of the temporary file. */
967 if (!NILP (Vcoding_system_for_write
))
968 val
= Vcoding_system_for_write
;
969 else if (NILP (current_buffer
->enable_multibyte_characters
))
973 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
974 args2
[0] = Qcall_process_region
;
975 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
976 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
977 if (CONSP (coding_systems
))
978 val
= XCDR (coding_systems
);
979 else if (CONSP (Vdefault_process_coding_system
))
980 val
= XCDR (Vdefault_process_coding_system
);
986 int count1
= specpdl_ptr
- specpdl
;
988 specbind (intern ("coding-system-for-write"), val
);
989 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
, Qnil
, Qnil
);
991 unbind_to (count1
, Qnil
);
994 /* Note that Fcall_process takes care of binding
995 coding-system-for-read. */
997 record_unwind_protect (delete_temp_file
, filename_string
);
999 if (nargs
> 3 && !NILP (args
[3]))
1000 Fdelete_region (start
, end
);
1012 args
[1] = filename_string
;
1014 RETURN_UNGCPRO (unbind_to (count
, Fcall_process (nargs
, args
)));
1017 #ifndef VMS /* VMS version is in vmsproc.c. */
1019 static int relocate_fd ();
1021 /* This is the last thing run in a newly forked inferior
1022 either synchronous or asynchronous.
1023 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
1024 Initialize inferior's priority, pgrp, connected dir and environment.
1025 then exec another program based on new_argv.
1027 This function may change environ for the superior process.
1028 Therefore, the superior process must save and restore the value
1029 of environ around the vfork and the call to this function.
1031 SET_PGRP is nonzero if we should put the subprocess into a separate
1034 CURRENT_DIR is an elisp string giving the path of the current
1035 directory the subprocess should have. Since we can't really signal
1036 a decent error from within the child, this should be verified as an
1037 executable directory by the parent. */
1040 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
1042 register char **new_argv
;
1044 Lisp_Object current_dir
;
1051 #endif /* WINDOWSNT */
1053 int pid
= getpid ();
1055 #ifdef SET_EMACS_PRIORITY
1057 extern int emacs_priority
;
1059 if (emacs_priority
< 0)
1060 nice (- emacs_priority
);
1065 /* Close Emacs's descriptors that this process should not have. */
1066 close_process_descs ();
1068 /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
1069 we will lose if we call close_load_descs here. */
1071 close_load_descs ();
1074 /* Note that use of alloca is always safe here. It's obvious for systems
1075 that do not have true vfork or that have true (stack) alloca.
1076 If using vfork and C_ALLOCA it is safe because that changes
1077 the superior's static variables as if the superior had done alloca
1078 and will be cleaned up in the usual way. */
1080 register char *temp
;
1083 i
= STRING_BYTES (XSTRING (current_dir
));
1085 /* MSDOS must have all environment variables malloc'ed, because
1086 low-level libc functions that launch subsidiary processes rely
1088 pwd_var
= (char *) xmalloc (i
+ 6);
1090 pwd_var
= (char *) alloca (i
+ 6);
1093 bcopy ("PWD=", pwd_var
, 4);
1094 bcopy (XSTRING (current_dir
)->data
, temp
, i
);
1095 if (!IS_DIRECTORY_SEP (temp
[i
- 1])) temp
[i
++] = DIRECTORY_SEP
;
1099 /* We can't signal an Elisp error here; we're in a vfork. Since
1100 the callers check the current directory before forking, this
1101 should only return an error if the directory's permissions
1102 are changed between the check and this chdir, but we should
1104 if (chdir (temp
) < 0)
1109 /* Get past the drive letter, so that d:/ is left alone. */
1110 if (i
> 2 && IS_DEVICE_SEP (temp
[1]) && IS_DIRECTORY_SEP (temp
[2]))
1117 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1118 while (i
> 2 && IS_DIRECTORY_SEP (temp
[i
- 1]))
1122 /* Set `env' to a vector of the strings in Vprocess_environment. */
1124 register Lisp_Object tem
;
1125 register char **new_env
;
1126 register int new_length
;
1129 for (tem
= Vprocess_environment
;
1130 CONSP (tem
) && STRINGP (XCAR (tem
));
1134 /* new_length + 2 to include PWD and terminating 0. */
1135 env
= new_env
= (char **) alloca ((new_length
+ 2) * sizeof (char *));
1137 /* If we have a PWD envvar, pass one down,
1138 but with corrected value. */
1140 *new_env
++ = pwd_var
;
1142 /* Copy the Vprocess_environment strings into new_env. */
1143 for (tem
= Vprocess_environment
;
1144 CONSP (tem
) && STRINGP (XCAR (tem
));
1148 char *string
= (char *) XSTRING (XCAR (tem
))->data
;
1149 /* See if this string duplicates any string already in the env.
1150 If so, don't put it in.
1151 When an env var has multiple definitions,
1152 we keep the definition that comes first in process-environment. */
1153 for (; ep
!= new_env
; ep
++)
1155 char *p
= *ep
, *q
= string
;
1159 /* The string is malformed; might as well drop it. */
1168 *new_env
++ = string
;
1174 prepare_standard_handles (in
, out
, err
, handles
);
1175 set_process_dir (XSTRING (current_dir
)->data
);
1176 #else /* not WINDOWSNT */
1177 /* Make sure that in, out, and err are not actually already in
1178 descriptors zero, one, or two; this could happen if Emacs is
1179 started with its standard in, out, or error closed, as might
1182 int oin
= in
, oout
= out
;
1184 /* We have to avoid relocating the same descriptor twice! */
1186 in
= relocate_fd (in
, 3);
1191 out
= relocate_fd (out
, 3);
1195 else if (err
== oout
)
1198 err
= relocate_fd (err
, 3);
1212 #endif /* not MSDOS */
1213 #endif /* not WINDOWSNT */
1215 #if defined(USG) && !defined(BSD_PGRPS)
1216 #ifndef SETPGRP_RELEASES_CTTY
1217 setpgrp (); /* No arguments but equivalent in this case */
1222 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1223 EMACS_SET_TTY_PGRP (0, &pid
);
1226 something missing here
;
1230 pid
= run_msdos_command (new_argv
, pwd_var
+ 4, in
, out
, err
, env
);
1233 /* An error occurred while trying to run the subprocess. */
1234 report_file_error ("Spawning child process", Qnil
);
1236 #else /* not MSDOS */
1238 /* Spawn the child. (See ntproc.c:Spawnve). */
1239 cpid
= spawnve (_P_NOWAIT
, new_argv
[0], new_argv
, env
);
1240 reset_standard_handles (in
, out
, err
, handles
);
1242 /* An error occurred while trying to spawn the process. */
1243 report_file_error ("Spawning child process", Qnil
);
1245 #else /* not WINDOWSNT */
1246 /* execvp does not accept an environment arg so the only way
1247 to pass this environment is to set environ. Our caller
1248 is responsible for restoring the ambient value of environ. */
1250 execvp (new_argv
[0], new_argv
);
1252 emacs_write (1, "Can't exec program: ", 20);
1253 emacs_write (1, new_argv
[0], strlen (new_argv
[0]));
1254 emacs_write (1, "\n", 1);
1256 #endif /* not WINDOWSNT */
1257 #endif /* not MSDOS */
1260 /* Move the file descriptor FD so that its number is not less than MINFD.
1261 If the file descriptor is moved at all, the original is freed. */
1263 relocate_fd (fd
, minfd
)
1273 char *message1
= "Error while setting up child: ";
1274 char *errmessage
= strerror (errno
);
1275 char *message2
= "\n";
1276 emacs_write (2, message1
, strlen (message1
));
1277 emacs_write (2, errmessage
, strlen (errmessage
));
1278 emacs_write (2, message2
, strlen (message2
));
1281 /* Note that we hold the original FD open while we recurse,
1282 to guarantee we'll get a new FD if we need it. */
1283 new = relocate_fd (new, minfd
);
1290 getenv_internal (var
, varlen
, value
, valuelen
)
1298 for (scan
= Vprocess_environment
; CONSP (scan
); scan
= XCDR (scan
))
1302 entry
= XCAR (scan
);
1304 && STRING_BYTES (XSTRING (entry
)) > varlen
1305 && XSTRING (entry
)->data
[varlen
] == '='
1307 /* NT environment variables are case insensitive. */
1308 && ! strnicmp (XSTRING (entry
)->data
, var
, varlen
)
1309 #else /* not WINDOWSNT */
1310 && ! bcmp (XSTRING (entry
)->data
, var
, varlen
)
1311 #endif /* not WINDOWSNT */
1314 *value
= (char *) XSTRING (entry
)->data
+ (varlen
+ 1);
1315 *valuelen
= STRING_BYTES (XSTRING (entry
)) - (varlen
+ 1);
1323 DEFUN ("getenv-internal", Fgetenv_internal
, Sgetenv_internal
, 1, 1, 0,
1324 "Return the value of environment variable VAR, as a string.\n\
1325 VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
1326 This function consults the variable ``process-environment'' for its value.")
1333 CHECK_STRING (var
, 0);
1334 if (getenv_internal (XSTRING (var
)->data
, STRING_BYTES (XSTRING (var
)),
1336 return make_string (value
, valuelen
);
1341 /* A version of getenv that consults process_environment, easily
1350 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
))
1356 #endif /* not VMS */
1358 /* This is run before init_cmdargs. */
1363 char *data_dir
= egetenv ("EMACSDATA");
1364 char *doc_dir
= egetenv ("EMACSDOC");
1367 = Ffile_name_as_directory (build_string (data_dir
? data_dir
1370 = Ffile_name_as_directory (build_string (doc_dir
? doc_dir
1373 /* Check the EMACSPATH environment variable, defaulting to the
1374 PATH_EXEC path from epaths.h. */
1375 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
1376 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
1377 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
1380 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1385 char *data_dir
= egetenv ("EMACSDATA");
1388 Lisp_Object tempdir
;
1390 if (!NILP (Vinstallation_directory
))
1392 /* Add to the path the lib-src subdir of the installation dir. */
1394 tem
= Fexpand_file_name (build_string ("lib-src"),
1395 Vinstallation_directory
);
1397 /* MSDOS uses wrapped binaries, so don't do this. */
1398 if (NILP (Fmember (tem
, Vexec_path
)))
1399 Vexec_path
= nconc2 (Vexec_path
, Fcons (tem
, Qnil
));
1401 Vexec_directory
= Ffile_name_as_directory (tem
);
1402 #endif /* not DOS_NT */
1404 /* Maybe use ../etc as well as ../lib-src. */
1407 tem
= Fexpand_file_name (build_string ("etc"),
1408 Vinstallation_directory
);
1409 Vdoc_directory
= Ffile_name_as_directory (tem
);
1413 /* Look for the files that should be in etc. We don't use
1414 Vinstallation_directory, because these files are never installed
1415 near the executable, and they are never in the build
1416 directory when that's different from the source directory.
1418 Instead, if these files are not in the nominal place, we try the
1419 source directory. */
1422 Lisp_Object tem
, tem1
, newdir
;
1424 tem
= Fexpand_file_name (build_string ("GNU"), Vdata_directory
);
1425 tem1
= Ffile_exists_p (tem
);
1428 newdir
= Fexpand_file_name (build_string ("../etc/"),
1429 build_string (PATH_DUMPLOADSEARCH
));
1430 tem
= Fexpand_file_name (build_string ("GNU"), newdir
);
1431 tem1
= Ffile_exists_p (tem
);
1433 Vdata_directory
= newdir
;
1441 tempdir
= Fdirectory_file_name (Vexec_directory
);
1442 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1443 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1447 tempdir
= Fdirectory_file_name (Vdata_directory
);
1448 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1449 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1453 Vshell_file_name
= build_string ("*dcl*");
1455 sh
= (char *) getenv ("SHELL");
1456 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
1460 Vtemp_file_name_pattern
= build_string ("tmp:emacsXXXXXX.");
1462 if (getenv ("TMPDIR"))
1464 char *dir
= getenv ("TMPDIR");
1465 Vtemp_file_name_pattern
1466 = Fexpand_file_name (build_string ("emacsXXXXXX"),
1467 build_string (dir
));
1470 Vtemp_file_name_pattern
= build_string ("/tmp/emacsXXXXXX");
1475 set_process_environment ()
1477 register char **envp
;
1479 Vprocess_environment
= Qnil
;
1483 for (envp
= environ
; *envp
; envp
++)
1484 Vprocess_environment
= Fcons (build_string (*envp
),
1485 Vprocess_environment
);
1492 Qbuffer_file_type
= intern ("buffer-file-type");
1493 staticpro (&Qbuffer_file_type
);
1496 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
1497 "*File name to load inferior shells from.\n\
1498 Initialized from the SHELL environment variable.");
1500 DEFVAR_LISP ("exec-path", &Vexec_path
,
1501 "*List of directories to search programs to run in subprocesses.\n\
1502 Each element is a string (directory name) or nil (try default directory).");
1504 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
1505 "Directory for executables for Emacs to invoke.\n\
1506 More generally, this includes any architecture-dependent files\n\
1507 that are built and installed from the Emacs distribution.");
1509 DEFVAR_LISP ("data-directory", &Vdata_directory
,
1510 "Directory of machine-independent files that come with GNU Emacs.\n\
1511 These are files intended for Emacs to use while it runs.");
1513 DEFVAR_LISP ("doc-directory", &Vdoc_directory
,
1514 "Directory containing the DOC file that comes with GNU Emacs.\n\
1515 This is usually the same as data-directory.");
1517 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
1518 "For internal use by the build procedure only.\n\
1519 This is the name of the directory in which the build procedure installed\n\
1520 Emacs's info files; the default value for Info-default-directory-list\n\
1522 Vconfigure_info_directory
= build_string (PATH_INFO
);
1524 DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern
,
1525 "Pattern for making names for temporary files.\n\
1526 This is used by `call-process-region'.");
1527 /* This variable is initialized in init_callproc. */
1529 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
1530 "List of environment variables for subprocesses to inherit.\n\
1531 Each element should be a string of the form ENVVARNAME=VALUE.\n\
1532 The environment which Emacs inherits is placed in this variable\n\
1533 when Emacs starts.");
1536 defsubr (&Scall_process
);
1537 defsubr (&Sgetenv_internal
);
1539 defsubr (&Scall_process_region
);