1 /* Synchronous subprocess invocation for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,99, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
32 /* Define SIGCHLD as an alias for SIGCLD. */
34 #if !defined (SIGCHLD) && defined (SIGCLD)
35 #define SIGCHLD SIGCLD
38 #include <sys/types.h>
46 #define INCLUDED_FCNTL
53 #include <stdlib.h> /* for proper declaration of environ */
56 #define _P_NOWAIT 1 /* from process.h */
59 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
60 #define INCLUDED_FCNTL
63 #include <sys/param.h>
81 #include "composite.h"
84 #include "syssignal.h"
92 extern noshare
char **environ
;
95 extern char **environ
;
100 #if !defined (USG) || defined (BSD_PGRPS)
102 #define setpgrp setpgid
106 Lisp_Object Vexec_path
, Vexec_directory
, Vexec_suffixes
;
107 Lisp_Object Vdata_directory
, Vdoc_directory
;
108 Lisp_Object Vconfigure_info_directory
;
109 Lisp_Object Vtemp_file_name_pattern
;
111 Lisp_Object Vshell_file_name
;
113 Lisp_Object Vprocess_environment
;
116 Lisp_Object Qbuffer_file_type
;
119 /* True iff we are about to fork off a synchronous process or if we
120 are waiting for it. */
121 int synch_process_alive
;
123 /* Nonzero => this is a string explaining death of synchronous subprocess. */
124 char *synch_process_death
;
126 /* If synch_process_death is zero,
127 this is exit code of synchronous subprocess. */
128 int synch_process_retcode
;
130 extern Lisp_Object Vdoc_file_name
;
132 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
134 /* Clean up when exiting Fcall_process.
135 On MSDOS, delete the temporary file on any kind of termination.
136 On Unix, kill the process and any children on termination by signal. */
138 /* Nonzero if this is termination due to exit. */
139 static int call_process_exited
;
141 #ifndef VMS /* VMS version is in vmsproc.c. */
144 call_process_kill (fdpid
)
147 emacs_close (XFASTINT (Fcar (fdpid
)));
148 EMACS_KILLPG (XFASTINT (Fcdr (fdpid
)), SIGKILL
);
149 synch_process_alive
= 0;
154 call_process_cleanup (fdpid
)
157 #if defined (MSDOS) || defined (macintosh)
158 /* for MSDOS fdpid is really (fd . tempfile) */
159 register Lisp_Object file
;
161 emacs_close (XFASTINT (Fcar (fdpid
)));
162 if (strcmp (XSTRING (file
)-> data
, NULL_DEVICE
) != 0)
163 unlink (XSTRING (file
)->data
);
164 #else /* not MSDOS and not macintosh */
165 register int pid
= XFASTINT (Fcdr (fdpid
));
167 if (call_process_exited
)
169 emacs_close (XFASTINT (Fcar (fdpid
)));
173 if (EMACS_KILLPG (pid
, SIGINT
) == 0)
175 int count
= specpdl_ptr
- specpdl
;
176 record_unwind_protect (call_process_kill
, fdpid
);
177 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
180 wait_for_termination (pid
);
182 specpdl_ptr
= specpdl
+ count
; /* Discard the unwind protect. */
183 message1 ("Waiting for process to die...done");
185 synch_process_alive
= 0;
186 emacs_close (XFASTINT (Fcar (fdpid
)));
187 #endif /* not MSDOS */
191 DEFUN ("call-process", Fcall_process
, Scall_process
, 1, MANY
, 0,
192 doc
: /* Call PROGRAM synchronously in separate process.
193 The remaining arguments are optional.
194 The program's input comes from file INFILE (nil means `/dev/null').
195 Insert output in BUFFER before point; t means current buffer;
196 nil for BUFFER means discard it; 0 means discard and don't wait.
197 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
198 REAL-BUFFER says what to do with standard output, as above,
199 while STDERR-FILE says what to do with standard error in the child.
200 STDERR-FILE may be nil (discard standard error output),
201 t (mix it with ordinary output), or a file name string.
203 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
204 Remaining arguments are strings passed as command arguments to PROGRAM.
206 If BUFFER is 0, `call-process' returns immediately with value nil.
207 Otherwise it waits for PROGRAM to terminate
208 and returns a numeric exit status or a signal description string.
209 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again. */)
212 register Lisp_Object
*args
;
214 Lisp_Object infile
, buffer
, current_dir
, display
, path
;
221 int count
= specpdl_ptr
- specpdl
;
223 register unsigned char **new_argv
224 = (unsigned char **) alloca ((max (2, nargs
- 2)) * sizeof (char *));
225 struct buffer
*old
= current_buffer
;
226 /* File to use for stderr in the child.
227 t means use same as standard output. */
228 Lisp_Object error_file
;
229 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
230 char *outf
, *tempfile
;
240 struct coding_system process_coding
; /* coding-system of process output */
241 struct coding_system argument_coding
; /* coding-system of arguments */
242 /* Set to the return value of Ffind_operation_coding_system. */
243 Lisp_Object coding_systems
;
245 /* Qt denotes that Ffind_operation_coding_system is not yet called. */
248 CHECK_STRING (args
[0], 0);
253 /* Without asynchronous processes we cannot have BUFFER == 0. */
255 && (INTEGERP (CONSP (args
[2]) ? XCAR (args
[2]) : args
[2])))
256 error ("Operating system cannot handle asynchronous subprocesses");
257 #endif /* subprocesses */
259 /* Decide the coding-system for giving arguments. */
261 Lisp_Object val
, *args2
;
264 /* If arguments are supplied, we may have to encode them. */
269 for (i
= 4; i
< nargs
; i
++)
270 CHECK_STRING (args
[i
], i
);
272 for (i
= 4; i
< nargs
; i
++)
273 if (STRING_MULTIBYTE (args
[i
]))
276 if (!NILP (Vcoding_system_for_write
))
277 val
= Vcoding_system_for_write
;
278 else if (! must_encode
)
282 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
283 args2
[0] = Qcall_process
;
284 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
285 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
286 if (CONSP (coding_systems
))
287 val
= XCDR (coding_systems
);
288 else if (CONSP (Vdefault_process_coding_system
))
289 val
= XCDR (Vdefault_process_coding_system
);
293 setup_coding_system (Fcheck_coding_system (val
), &argument_coding
);
297 if (nargs
>= 2 && ! NILP (args
[1]))
299 infile
= Fexpand_file_name (args
[1], current_buffer
->directory
);
300 CHECK_STRING (infile
, 1);
303 infile
= build_string (NULL_DEVICE
);
309 /* If BUFFER is a list, its meaning is
310 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
313 if (CONSP (XCDR (buffer
)))
315 Lisp_Object stderr_file
;
316 stderr_file
= XCAR (XCDR (buffer
));
318 if (NILP (stderr_file
) || EQ (Qt
, stderr_file
))
319 error_file
= stderr_file
;
321 error_file
= Fexpand_file_name (stderr_file
, Qnil
);
324 buffer
= XCAR (buffer
);
327 if (!(EQ (buffer
, Qnil
)
329 || INTEGERP (buffer
)))
331 Lisp_Object spec_buffer
;
332 spec_buffer
= buffer
;
333 buffer
= Fget_buffer_create (buffer
);
334 /* Mention the buffer name for a better error message. */
336 CHECK_BUFFER (spec_buffer
, 2);
337 CHECK_BUFFER (buffer
, 2);
343 /* Make sure that the child will be able to chdir to the current
344 buffer's current directory, or its unhandled equivalent. We
345 can't just have the child check for an error when it does the
346 chdir, since it's in a vfork.
348 We have to GCPRO around this because Fexpand_file_name,
349 Funhandled_file_name_directory, and Ffile_accessible_directory_p
350 might call a file name handling function. The argument list is
351 protected by the caller, so all we really have to worry about is
354 struct gcpro gcpro1
, gcpro2
, gcpro3
;
356 current_dir
= current_buffer
->directory
;
358 GCPRO3 (infile
, buffer
, current_dir
);
361 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
363 if (NILP (Ffile_accessible_directory_p (current_dir
)))
364 report_file_error ("Setting current directory",
365 Fcons (current_buffer
->directory
, Qnil
));
370 display
= nargs
>= 4 ? args
[3] : Qnil
;
372 filefd
= emacs_open (XSTRING (infile
)->data
, O_RDONLY
, 0);
375 report_file_error ("Opening process input file", Fcons (infile
, Qnil
));
377 /* Search for program; barf if not found. */
381 GCPRO1 (current_dir
);
382 openp (Vexec_path
, args
[0], Vexec_suffixes
, &path
, 1);
387 emacs_close (filefd
);
388 report_file_error ("Searching for program", Fcons (args
[0], Qnil
));
390 new_argv
[0] = XSTRING (path
)->data
;
394 struct gcpro gcpro1
, gcpro2
, gcpro3
;
396 GCPRO3 (infile
, buffer
, current_dir
);
397 argument_coding
.dst_multibyte
= 0;
398 for (i
= 4; i
< nargs
; i
++)
400 argument_coding
.src_multibyte
= STRING_MULTIBYTE (args
[i
]);
401 if (CODING_REQUIRE_ENCODING (&argument_coding
))
403 /* We must encode this argument. */
404 args
[i
] = encode_coding_string (args
[i
], &argument_coding
, 1);
405 if (argument_coding
.type
== coding_type_ccl
)
406 setup_ccl_program (&(argument_coding
.spec
.ccl
.encoder
), Qnil
);
408 new_argv
[i
- 3] = XSTRING (args
[i
])->data
;
411 new_argv
[nargs
- 3] = 0;
416 #ifdef MSDOS /* MW, July 1993 */
417 if ((outf
= egetenv ("TMPDIR")))
418 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
421 tempfile
= alloca (20);
424 dostounix_filename (tempfile
);
425 if (*tempfile
== '\0' || tempfile
[strlen (tempfile
) - 1] != '/')
426 strcat (tempfile
, "/");
427 strcat (tempfile
, "detmp.XXX");
430 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
433 emacs_close (filefd
);
434 report_file_error ("Opening process output file",
435 Fcons (build_string (tempfile
), Qnil
));
442 /* Since we don't have pipes on the Mac, create a temporary file to
443 hold the output of the subprocess. */
444 tempfile
= (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
445 bcopy (XSTRING (Vtemp_file_name_pattern
)->data
, tempfile
,
446 STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
450 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
454 report_file_error ("Opening process output file",
455 Fcons (build_string (tempfile
), Qnil
));
459 #endif /* macintosh */
461 if (INTEGERP (buffer
))
462 fd
[1] = emacs_open (NULL_DEVICE
, O_WRONLY
, 0), fd
[0] = -1;
470 emacs_close (filefd
);
471 report_file_error ("Creating process pipe", Qnil
);
476 /* Replaced by close_process_descs */
477 set_exclusive_use (fd
[0]);
482 /* child_setup must clobber environ in systems with true vfork.
483 Protect it from permanent change. */
484 register char **save_environ
= environ
;
485 register int fd1
= fd
[1];
488 #if 0 /* Some systems don't have sigblock. */
489 mask
= sigblock (sigmask (SIGCHLD
));
492 /* Record that we're about to create a synchronous process. */
493 synch_process_alive
= 1;
495 /* These vars record information from process termination.
496 Clear them now before process can possibly terminate,
497 to avoid timing error if process terminates soon. */
498 synch_process_death
= 0;
499 synch_process_retcode
= 0;
501 if (NILP (error_file
))
502 fd_error
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
503 else if (STRINGP (error_file
))
506 fd_error
= emacs_open (XSTRING (error_file
)->data
,
507 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
509 #else /* not DOS_NT */
510 fd_error
= creat (XSTRING (error_file
)->data
, 0666);
511 #endif /* not DOS_NT */
516 emacs_close (filefd
);
524 report_file_error ("Cannot redirect stderr",
525 Fcons ((NILP (error_file
)
526 ? build_string (NULL_DEVICE
) : error_file
),
530 current_dir
= ENCODE_FILE (current_dir
);
534 /* Call run_mac_command in sysdep.c here directly instead of doing
535 a child_setup as for MSDOS and other platforms. Note that this
536 code does not handle passing the environment to the synchronous
538 char *infn
, *outfn
, *errfn
, *currdn
;
540 /* close these files so subprocess can write to them */
542 if (fd_error
!= outfilefd
)
544 fd1
= -1; /* No harm in closing that one! */
546 infn
= XSTRING (infile
)->data
;
548 if (NILP (error_file
))
550 else if (EQ (Qt
, error_file
))
553 errfn
= XSTRING (error_file
)->data
;
554 currdn
= XSTRING (current_dir
)->data
;
555 pid
= run_mac_command (new_argv
, currdn
, infn
, outfn
, errfn
);
557 /* Record that the synchronous process exited and note its
558 termination status. */
559 synch_process_alive
= 0;
560 synch_process_retcode
= pid
;
561 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
563 synchronize_system_messages_locale ();
564 synch_process_death
= strerror (errno
);
567 /* Since CRLF is converted to LF within `decode_coding', we can
568 always open a file with binary mode. */
569 fd
[0] = open (tempfile
, O_BINARY
);
574 report_file_error ("Cannot re-open temporary file", Qnil
);
577 #else /* not macintosh */
578 #ifdef MSDOS /* MW, July 1993 */
579 /* Note that on MSDOS `child_setup' actually returns the child process
580 exit status, not its PID, so we assign it to `synch_process_retcode'
582 pid
= child_setup (filefd
, outfilefd
, fd_error
, (char **) new_argv
,
585 /* Record that the synchronous process exited and note its
586 termination status. */
587 synch_process_alive
= 0;
588 synch_process_retcode
= pid
;
589 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
591 synchronize_system_messages_locale ();
592 synch_process_death
= strerror (errno
);
595 emacs_close (outfilefd
);
596 if (fd_error
!= outfilefd
)
597 emacs_close (fd_error
);
598 fd1
= -1; /* No harm in closing that one! */
599 /* Since CRLF is converted to LF within `decode_coding', we can
600 always open a file with binary mode. */
601 fd
[0] = emacs_open (tempfile
, O_RDONLY
| O_BINARY
, 0);
605 emacs_close (filefd
);
606 report_file_error ("Cannot re-open temporary file", Qnil
);
608 #else /* not MSDOS */
610 pid
= child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
612 #else /* not WINDOWSNT */
622 #if defined (USG) && !defined (BSD_PGRPS)
627 child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
630 #endif /* not WINDOWSNT */
632 /* The MSDOS case did this already. */
634 emacs_close (fd_error
);
635 #endif /* not MSDOS */
636 #endif /* not macintosh */
638 environ
= save_environ
;
640 /* Close most of our fd's, but not fd[0]
641 since we will use that to read input from. */
642 emacs_close (filefd
);
643 if (fd1
>= 0 && fd1
!= fd_error
)
651 report_file_error ("Doing vfork", Qnil
);
654 if (INTEGERP (buffer
))
659 /* If Emacs has been built with asynchronous subprocess support,
660 we don't need to do this, I think because it will then have
661 the facilities for handling SIGCHLD. */
662 wait_without_blocking ();
663 #endif /* subprocesses */
667 /* Enable sending signal if user quits below. */
668 call_process_exited
= 0;
670 #if defined(MSDOS) || defined(macintosh)
671 /* MSDOS needs different cleanup information. */
672 record_unwind_protect (call_process_cleanup
,
673 Fcons (make_number (fd
[0]), build_string (tempfile
)));
675 record_unwind_protect (call_process_cleanup
,
676 Fcons (make_number (fd
[0]), make_number (pid
)));
677 #endif /* not MSDOS and not macintosh */
680 if (BUFFERP (buffer
))
681 Fset_buffer (buffer
);
685 /* If BUFFER is nil, we must read process output once and then
686 discard it, so setup coding system but with nil. */
687 setup_coding_system (Qnil
, &process_coding
);
691 Lisp_Object val
, *args2
;
694 if (!NILP (Vcoding_system_for_read
))
695 val
= Vcoding_system_for_read
;
698 if (EQ (coding_systems
, Qt
))
702 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
703 args2
[0] = Qcall_process
;
704 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
706 = Ffind_operation_coding_system (nargs
+ 1, args2
);
708 if (CONSP (coding_systems
))
709 val
= XCAR (coding_systems
);
710 else if (CONSP (Vdefault_process_coding_system
))
711 val
= XCAR (Vdefault_process_coding_system
);
715 setup_coding_system (Fcheck_coding_system (val
), &process_coding
);
716 /* In unibyte mode, character code conversion should not take
717 place but EOL conversion should. So, setup raw-text or one
718 of the subsidiary according to the information just setup. */
719 if (NILP (current_buffer
->enable_multibyte_characters
)
721 setup_raw_text_coding_system (&process_coding
);
723 process_coding
.src_multibyte
= 0;
724 process_coding
.dst_multibyte
726 ? ! NILP (XBUFFER (buffer
)->enable_multibyte_characters
)
727 : ! NILP (current_buffer
->enable_multibyte_characters
));
737 int display_on_the_fly
= !NILP (display
) && INTERACTIVE
;
738 struct coding_system saved_coding
;
739 int pt_orig
= PT
, pt_byte_orig
= PT_BYTE
;
742 saved_coding
= process_coding
;
743 if (process_coding
.composing
!= COMPOSITION_DISABLED
)
744 coding_allocate_composition_data (&process_coding
, PT
);
747 /* Repeatedly read until we've filled as much as possible
748 of the buffer size we have. But don't read
749 less than 1024--save that for the next bufferful. */
751 while (nread
< bufsize
- 1024)
753 int this_read
= emacs_read (fd
[0], bufptr
+ nread
,
761 process_coding
.mode
|= CODING_MODE_LAST_BLOCK
;
766 total_read
+= this_read
;
768 if (display_on_the_fly
)
772 /* Now NREAD is the total amount of data in the buffer. */
777 if (! CODING_MAY_REQUIRE_DECODING (&process_coding
))
778 insert_1_both (bufptr
, nread
, nread
, 0, 1, 0);
780 { /* We have to decode the input. */
785 size
= decoding_buffer_size (&process_coding
, nread
);
786 decoding_buf
= (char *) xmalloc (size
);
788 if (process_coding
.cmp_data
)
789 process_coding
.cmp_data
->char_offset
= PT
;
791 decode_coding (&process_coding
, bufptr
, decoding_buf
,
794 if (display_on_the_fly
795 && saved_coding
.type
== coding_type_undecided
796 && process_coding
.type
!= coding_type_undecided
)
798 /* We have detected some coding system. But,
799 there's a possibility that the detection was
800 done by insufficient data. So, we give up
801 displaying on the fly. */
802 xfree (decoding_buf
);
803 display_on_the_fly
= 0;
804 process_coding
= saved_coding
;
809 if (process_coding
.produced
> 0)
810 insert_1_both (decoding_buf
, process_coding
.produced_char
,
811 process_coding
.produced
, 0, 1, 0);
812 xfree (decoding_buf
);
814 if (process_coding
.result
== CODING_FINISH_INCONSISTENT_EOL
)
816 Lisp_Object eol_type
, coding
;
818 if (process_coding
.eol_type
== CODING_EOL_CR
)
820 /* CRs have been replaced with LFs. Undo
821 that in the text inserted above. */
824 move_gap_both (PT
, PT_BYTE
);
826 p
= BYTE_POS_ADDR (pt_byte_orig
);
827 for (; p
< GPT_ADDR
; ++p
)
831 else if (process_coding
.eol_type
== CODING_EOL_CRLF
)
833 /* CR LFs have been replaced with LFs. Undo
834 that by inserting CRs in front of LFs in
835 the text inserted above. */
836 EMACS_INT bytepos
, old_pt
, old_pt_byte
, nCR
;
839 old_pt_byte
= PT_BYTE
;
842 for (bytepos
= PT_BYTE
- 1;
843 bytepos
>= pt_byte_orig
;
845 if (FETCH_BYTE (bytepos
) == '\n')
847 EMACS_INT charpos
= BYTE_TO_CHAR (bytepos
);
848 TEMP_SET_PT_BOTH (charpos
, bytepos
);
849 insert_1_both ("\r", 1, 1, 0, 1, 0);
853 TEMP_SET_PT_BOTH (old_pt
+ nCR
, old_pt_byte
+ nCR
);
856 /* Set the coding system symbol to that for
858 eol_type
= Fget (saved_coding
.symbol
, Qeol_type
);
859 if (VECTORP (eol_type
)
860 && ASIZE (eol_type
) == 3
861 && SYMBOLP (AREF (eol_type
, CODING_EOL_LF
)))
862 coding
= AREF (eol_type
, CODING_EOL_LF
);
864 coding
= saved_coding
.symbol
;
866 process_coding
.symbol
= coding
;
867 process_coding
.eol_type
= CODING_EOL_LF
;
869 &= ~CODING_MODE_INHIBIT_INCONSISTENT_EOL
;
872 nread
-= process_coding
.consumed
;
875 /* As CARRYOVER should not be that large, we had
876 better avoid overhead of bcopy. */
877 BCOPY_SHORT (bufptr
+ process_coding
.consumed
, bufptr
,
879 if (process_coding
.result
== CODING_FINISH_INSUFFICIENT_CMP
)
881 /* The decoding ended because of insufficient data
882 area to record information about composition.
883 We must try decoding with additional data area
884 before reading more output for the process. */
885 coding_allocate_composition_data (&process_coding
, PT
);
886 goto repeat_decoding
;
891 if (process_coding
.mode
& CODING_MODE_LAST_BLOCK
)
894 /* Make the buffer bigger as we continue to read more data,
896 if (bufsize
< 64 * 1024 && total_read
> 32 * bufsize
)
899 bufptr
= (char *) alloca (bufsize
);
902 if (!NILP (display
) && INTERACTIVE
)
905 prepare_menu_bars ();
907 redisplay_preserve_echo_area (1);
915 && process_coding
.cmp_data
)
917 coding_restore_composition (&process_coding
, Fcurrent_buffer ());
918 coding_free_composition_data (&process_coding
);
922 int post_read_count
= specpdl_ptr
- specpdl
;
924 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
925 inserted
= PT
- pt_orig
;
926 TEMP_SET_PT_BOTH (pt_orig
, pt_byte_orig
);
927 if (SYMBOLP (process_coding
.post_read_conversion
)
928 && !NILP (Ffboundp (process_coding
.post_read_conversion
)))
929 call1 (process_coding
.post_read_conversion
, make_number (inserted
));
931 Vlast_coding_system_used
= process_coding
.symbol
;
933 /* If the caller required, let the buffer inherit the
934 coding-system used to decode the process output. */
935 if (inherit_process_coding_system
)
936 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
937 make_number (total_read
));
939 unbind_to (post_read_count
, Qnil
);
943 /* Wait for it to terminate, unless it already has. */
944 wait_for_termination (pid
);
948 set_buffer_internal (old
);
950 /* Don't kill any children that the subprocess may have left behind
952 call_process_exited
= 1;
954 unbind_to (count
, Qnil
);
956 if (synch_process_death
)
957 return code_convert_string_norecord (build_string (synch_process_death
),
958 Vlocale_coding_system
, 0);
959 return make_number (synch_process_retcode
);
964 delete_temp_file (name
)
967 /* Use Fdelete_file (indirectly) because that runs a file name handler.
968 We did that when writing the file, so we should do so when deleting. */
969 internal_delete_file (name
);
973 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
975 doc
: /* Send text from START to END to a synchronous process running PROGRAM.
976 The remaining arguments are optional.
977 Delete the text if fourth arg DELETE is non-nil.
979 Insert output in BUFFER before point; t means current buffer;
980 nil for BUFFER means discard it; 0 means discard and don't wait.
981 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
982 REAL-BUFFER says what to do with standard output, as above,
983 while STDERR-FILE says what to do with standard error in the child.
984 STDERR-FILE may be nil (discard standard error output),
985 t (mix it with ordinary output), or a file name string.
987 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
988 Remaining args are passed to PROGRAM at startup as command args.
990 If BUFFER is nil, `call-process-region' returns immediately with value nil.
991 Otherwise it waits for PROGRAM to terminate
992 and returns a numeric exit status or a signal description string.
993 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again. */)
996 register Lisp_Object
*args
;
999 Lisp_Object filename_string
;
1000 register Lisp_Object start
, end
;
1001 int count
= specpdl_ptr
- specpdl
;
1002 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1003 Lisp_Object coding_systems
;
1004 Lisp_Object val
, *args2
;
1010 if ((outf
= egetenv ("TMPDIR"))
1011 || (outf
= egetenv ("TMP"))
1012 || (outf
= egetenv ("TEMP")))
1013 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
1016 tempfile
= alloca (20);
1019 if (!IS_DIRECTORY_SEP (tempfile
[strlen (tempfile
) - 1]))
1020 strcat (tempfile
, "/");
1021 if ('/' == DIRECTORY_SEP
)
1022 dostounix_filename (tempfile
);
1024 unixtodos_filename (tempfile
);
1026 strcat (tempfile
, "emXXXXXX");
1028 strcat (tempfile
, "detmp.XXX");
1030 #else /* not DOS_NT */
1031 char *tempfile
= (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
1032 bcopy (XSTRING (Vtemp_file_name_pattern
)->data
, tempfile
,
1033 STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
1034 #endif /* not DOS_NT */
1036 coding_systems
= Qt
;
1040 int fd
= mkstemp (tempfile
);
1042 report_file_error ("Failed to open temporary file",
1043 Fcons (Vtemp_file_name_pattern
, Qnil
));
1051 filename_string
= build_string (tempfile
);
1052 GCPRO1 (filename_string
);
1055 /* Decide coding-system of the contents of the temporary file. */
1056 if (!NILP (Vcoding_system_for_write
))
1057 val
= Vcoding_system_for_write
;
1058 else if (NILP (current_buffer
->enable_multibyte_characters
))
1062 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
1063 args2
[0] = Qcall_process_region
;
1064 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
1065 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
1066 if (CONSP (coding_systems
))
1067 val
= XCDR (coding_systems
);
1068 else if (CONSP (Vdefault_process_coding_system
))
1069 val
= XCDR (Vdefault_process_coding_system
);
1075 int count1
= specpdl_ptr
- specpdl
;
1077 specbind (intern ("coding-system-for-write"), val
);
1078 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
, Qnil
, Qnil
);
1080 unbind_to (count1
, Qnil
);
1083 /* Note that Fcall_process takes care of binding
1084 coding-system-for-read. */
1086 record_unwind_protect (delete_temp_file
, filename_string
);
1088 if (nargs
> 3 && !NILP (args
[3]))
1089 Fdelete_region (start
, end
);
1101 args
[1] = filename_string
;
1103 RETURN_UNGCPRO (unbind_to (count
, Fcall_process (nargs
, args
)));
1106 #ifndef VMS /* VMS version is in vmsproc.c. */
1108 static int relocate_fd ();
1110 /* This is the last thing run in a newly forked inferior
1111 either synchronous or asynchronous.
1112 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
1113 Initialize inferior's priority, pgrp, connected dir and environment.
1114 then exec another program based on new_argv.
1116 This function may change environ for the superior process.
1117 Therefore, the superior process must save and restore the value
1118 of environ around the vfork and the call to this function.
1120 SET_PGRP is nonzero if we should put the subprocess into a separate
1123 CURRENT_DIR is an elisp string giving the path of the current
1124 directory the subprocess should have. Since we can't really signal
1125 a decent error from within the child, this should be verified as an
1126 executable directory by the parent. */
1129 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
1131 register char **new_argv
;
1133 Lisp_Object current_dir
;
1140 #endif /* WINDOWSNT */
1142 int pid
= getpid ();
1144 #ifdef SET_EMACS_PRIORITY
1146 extern int emacs_priority
;
1148 if (emacs_priority
< 0)
1149 nice (- emacs_priority
);
1154 /* Close Emacs's descriptors that this process should not have. */
1155 close_process_descs ();
1157 /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
1158 we will lose if we call close_load_descs here. */
1160 close_load_descs ();
1163 /* Note that use of alloca is always safe here. It's obvious for systems
1164 that do not have true vfork or that have true (stack) alloca.
1165 If using vfork and C_ALLOCA it is safe because that changes
1166 the superior's static variables as if the superior had done alloca
1167 and will be cleaned up in the usual way. */
1169 register char *temp
;
1172 i
= STRING_BYTES (XSTRING (current_dir
));
1174 /* MSDOS must have all environment variables malloc'ed, because
1175 low-level libc functions that launch subsidiary processes rely
1177 pwd_var
= (char *) xmalloc (i
+ 6);
1179 pwd_var
= (char *) alloca (i
+ 6);
1182 bcopy ("PWD=", pwd_var
, 4);
1183 bcopy (XSTRING (current_dir
)->data
, temp
, i
);
1184 if (!IS_DIRECTORY_SEP (temp
[i
- 1])) temp
[i
++] = DIRECTORY_SEP
;
1188 /* We can't signal an Elisp error here; we're in a vfork. Since
1189 the callers check the current directory before forking, this
1190 should only return an error if the directory's permissions
1191 are changed between the check and this chdir, but we should
1193 if (chdir (temp
) < 0)
1198 /* Get past the drive letter, so that d:/ is left alone. */
1199 if (i
> 2 && IS_DEVICE_SEP (temp
[1]) && IS_DIRECTORY_SEP (temp
[2]))
1206 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1207 while (i
> 2 && IS_DIRECTORY_SEP (temp
[i
- 1]))
1211 /* Set `env' to a vector of the strings in Vprocess_environment. */
1213 register Lisp_Object tem
;
1214 register char **new_env
;
1215 register int new_length
;
1218 for (tem
= Vprocess_environment
;
1219 CONSP (tem
) && STRINGP (XCAR (tem
));
1223 /* new_length + 2 to include PWD and terminating 0. */
1224 env
= new_env
= (char **) alloca ((new_length
+ 2) * sizeof (char *));
1226 /* If we have a PWD envvar, pass one down,
1227 but with corrected value. */
1229 *new_env
++ = pwd_var
;
1231 /* Copy the Vprocess_environment strings into new_env. */
1232 for (tem
= Vprocess_environment
;
1233 CONSP (tem
) && STRINGP (XCAR (tem
));
1237 char *string
= (char *) XSTRING (XCAR (tem
))->data
;
1238 /* See if this string duplicates any string already in the env.
1239 If so, don't put it in.
1240 When an env var has multiple definitions,
1241 we keep the definition that comes first in process-environment. */
1242 for (; ep
!= new_env
; ep
++)
1244 char *p
= *ep
, *q
= string
;
1248 /* The string is malformed; might as well drop it. */
1257 *new_env
++ = string
;
1263 prepare_standard_handles (in
, out
, err
, handles
);
1264 set_process_dir (XSTRING (current_dir
)->data
);
1265 #else /* not WINDOWSNT */
1266 /* Make sure that in, out, and err are not actually already in
1267 descriptors zero, one, or two; this could happen if Emacs is
1268 started with its standard in, out, or error closed, as might
1271 int oin
= in
, oout
= out
;
1273 /* We have to avoid relocating the same descriptor twice! */
1275 in
= relocate_fd (in
, 3);
1280 out
= relocate_fd (out
, 3);
1284 else if (err
== oout
)
1287 err
= relocate_fd (err
, 3);
1301 #endif /* not MSDOS */
1302 #endif /* not WINDOWSNT */
1304 #if defined(USG) && !defined(BSD_PGRPS)
1305 #ifndef SETPGRP_RELEASES_CTTY
1306 setpgrp (); /* No arguments but equivalent in this case */
1311 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1312 EMACS_SET_TTY_PGRP (0, &pid
);
1315 pid
= run_msdos_command (new_argv
, pwd_var
+ 4, in
, out
, err
, env
);
1318 /* An error occurred while trying to run the subprocess. */
1319 report_file_error ("Spawning child process", Qnil
);
1321 #else /* not MSDOS */
1323 /* Spawn the child. (See ntproc.c:Spawnve). */
1324 cpid
= spawnve (_P_NOWAIT
, new_argv
[0], new_argv
, env
);
1325 reset_standard_handles (in
, out
, err
, handles
);
1327 /* An error occurred while trying to spawn the process. */
1328 report_file_error ("Spawning child process", Qnil
);
1330 #else /* not WINDOWSNT */
1331 /* execvp does not accept an environment arg so the only way
1332 to pass this environment is to set environ. Our caller
1333 is responsible for restoring the ambient value of environ. */
1335 execvp (new_argv
[0], new_argv
);
1337 emacs_write (1, "Can't exec program: ", 20);
1338 emacs_write (1, new_argv
[0], strlen (new_argv
[0]));
1339 emacs_write (1, "\n", 1);
1341 #endif /* not WINDOWSNT */
1342 #endif /* not MSDOS */
1345 /* Move the file descriptor FD so that its number is not less than MINFD.
1346 If the file descriptor is moved at all, the original is freed. */
1348 relocate_fd (fd
, minfd
)
1358 char *message1
= "Error while setting up child: ";
1359 char *errmessage
= strerror (errno
);
1360 char *message2
= "\n";
1361 emacs_write (2, message1
, strlen (message1
));
1362 emacs_write (2, errmessage
, strlen (errmessage
));
1363 emacs_write (2, message2
, strlen (message2
));
1366 /* Note that we hold the original FD open while we recurse,
1367 to guarantee we'll get a new FD if we need it. */
1368 new = relocate_fd (new, minfd
);
1375 getenv_internal (var
, varlen
, value
, valuelen
)
1383 for (scan
= Vprocess_environment
; CONSP (scan
); scan
= XCDR (scan
))
1387 entry
= XCAR (scan
);
1389 && STRING_BYTES (XSTRING (entry
)) > varlen
1390 && XSTRING (entry
)->data
[varlen
] == '='
1392 /* NT environment variables are case insensitive. */
1393 && ! strnicmp (XSTRING (entry
)->data
, var
, varlen
)
1394 #else /* not WINDOWSNT */
1395 && ! bcmp (XSTRING (entry
)->data
, var
, varlen
)
1396 #endif /* not WINDOWSNT */
1399 *value
= (char *) XSTRING (entry
)->data
+ (varlen
+ 1);
1400 *valuelen
= STRING_BYTES (XSTRING (entry
)) - (varlen
+ 1);
1408 DEFUN ("getenv-internal", Fgetenv_internal
, Sgetenv_internal
, 1, 1, 0,
1409 doc
: /* Return the value of environment variable VAR, as a string.
1410 VAR should be a string. Value is nil if VAR is undefined in the environment.
1411 This function consults the variable ``process-environment'' for its value. */)
1418 CHECK_STRING (var
, 0);
1419 if (getenv_internal (XSTRING (var
)->data
, STRING_BYTES (XSTRING (var
)),
1421 return make_string (value
, valuelen
);
1426 /* A version of getenv that consults process_environment, easily
1435 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
))
1441 #endif /* not VMS */
1443 /* This is run before init_cmdargs. */
1448 char *data_dir
= egetenv ("EMACSDATA");
1449 char *doc_dir
= egetenv ("EMACSDOC");
1452 = Ffile_name_as_directory (build_string (data_dir
? data_dir
1455 = Ffile_name_as_directory (build_string (doc_dir
? doc_dir
1458 /* Check the EMACSPATH environment variable, defaulting to the
1459 PATH_EXEC path from epaths.h. */
1460 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
1461 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
1462 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
1465 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1470 char *data_dir
= egetenv ("EMACSDATA");
1473 Lisp_Object tempdir
;
1475 if (!NILP (Vinstallation_directory
))
1477 /* Add to the path the lib-src subdir of the installation dir. */
1479 tem
= Fexpand_file_name (build_string ("lib-src"),
1480 Vinstallation_directory
);
1482 /* MSDOS uses wrapped binaries, so don't do this. */
1483 if (NILP (Fmember (tem
, Vexec_path
)))
1484 Vexec_path
= nconc2 (Vexec_path
, Fcons (tem
, Qnil
));
1486 Vexec_directory
= Ffile_name_as_directory (tem
);
1487 #endif /* not DOS_NT */
1489 /* Maybe use ../etc as well as ../lib-src. */
1492 tem
= Fexpand_file_name (build_string ("etc"),
1493 Vinstallation_directory
);
1494 Vdoc_directory
= Ffile_name_as_directory (tem
);
1498 /* Look for the files that should be in etc. We don't use
1499 Vinstallation_directory, because these files are never installed
1500 near the executable, and they are never in the build
1501 directory when that's different from the source directory.
1503 Instead, if these files are not in the nominal place, we try the
1504 source directory. */
1507 Lisp_Object tem
, tem1
, newdir
;
1509 tem
= Fexpand_file_name (build_string ("GNU"), Vdata_directory
);
1510 tem1
= Ffile_exists_p (tem
);
1513 newdir
= Fexpand_file_name (build_string ("../etc/"),
1514 build_string (PATH_DUMPLOADSEARCH
));
1515 tem
= Fexpand_file_name (build_string ("GNU"), newdir
);
1516 tem1
= Ffile_exists_p (tem
);
1518 Vdata_directory
= newdir
;
1526 tempdir
= Fdirectory_file_name (Vexec_directory
);
1527 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1528 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1532 tempdir
= Fdirectory_file_name (Vdata_directory
);
1533 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1534 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1538 Vshell_file_name
= build_string ("*dcl*");
1540 sh
= (char *) getenv ("SHELL");
1541 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
1545 Vtemp_file_name_pattern
= build_string ("tmp:emacsXXXXXX.");
1547 if (getenv ("TMPDIR"))
1549 char *dir
= getenv ("TMPDIR");
1550 Vtemp_file_name_pattern
1551 = Fexpand_file_name (build_string ("emacsXXXXXX"),
1552 build_string (dir
));
1555 Vtemp_file_name_pattern
= build_string ("/tmp/emacsXXXXXX");
1560 set_process_environment ()
1562 register char **envp
;
1564 Vprocess_environment
= Qnil
;
1568 for (envp
= environ
; *envp
; envp
++)
1569 Vprocess_environment
= Fcons (build_string (*envp
),
1570 Vprocess_environment
);
1577 Qbuffer_file_type
= intern ("buffer-file-type");
1578 staticpro (&Qbuffer_file_type
);
1581 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
1582 doc
: /* *File name to load inferior shells from.
1583 Initialized from the SHELL environment variable. */);
1585 DEFVAR_LISP ("exec-path", &Vexec_path
,
1586 doc
: /* *List of directories to search programs to run in subprocesses.
1587 Each element is a string (directory name) or nil (try default directory). */);
1589 DEFVAR_LISP ("exec-suffixes", &Vexec_suffixes
,
1590 doc
: /* *List of suffixes to try to find executable file names.
1591 Each element is a string. */);
1592 Vexec_suffixes
= Qnil
;
1594 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
1595 doc
: /* Directory for executables for Emacs to invoke.
1596 More generally, this includes any architecture-dependent files
1597 that are built and installed from the Emacs distribution. */);
1599 DEFVAR_LISP ("data-directory", &Vdata_directory
,
1600 doc
: /* Directory of machine-independent files that come with GNU Emacs.
1601 These are files intended for Emacs to use while it runs. */);
1603 DEFVAR_LISP ("doc-directory", &Vdoc_directory
,
1604 doc
: /* Directory containing the DOC file that comes with GNU Emacs.
1605 This is usually the same as data-directory. */);
1607 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
1608 doc
: /* For internal use by the build procedure only.
1609 This is the name of the directory in which the build procedure installed
1610 Emacs's info files; the default value for Info-default-directory-list
1612 Vconfigure_info_directory
= build_string (PATH_INFO
);
1614 DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern
,
1615 doc
: /* Pattern for making names for temporary files.
1616 This is used by `call-process-region'. */);
1617 /* This variable is initialized in init_callproc. */
1619 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
1620 doc
: /* List of environment variables for subprocesses to inherit.
1621 Each element should be a string of the form ENVVARNAME=VALUE.
1622 If multiple entries define the same variable, the first one always
1624 The environment which Emacs inherits is placed in this variable
1625 when Emacs starts. */);
1628 defsubr (&Scall_process
);
1629 defsubr (&Sgetenv_internal
);
1631 defsubr (&Scall_process_region
);