1 /* Synchronous subprocess invocation for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1999, 2000, 2001,
3 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
31 /* Define SIGCHLD as an alias for SIGCLD. */
33 #if !defined (SIGCHLD) && defined (SIGCLD)
34 #define SIGCHLD SIGCLD
37 #include <sys/types.h>
45 #define INCLUDED_FCNTL
52 #include <stdlib.h> /* for proper declaration of environ */
55 #define _P_NOWAIT 1 /* from process.h */
58 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
59 #define INCLUDED_FCNTL
62 #include <sys/param.h>
77 #include "character.h"
80 #include "composite.h"
83 #include "syssignal.h"
85 #include "blockinput.h"
87 #include "termhooks.h"
94 extern char **environ
;
98 #if !defined (USG) || defined (BSD_PGRPS)
100 #define setpgrp setpgid
104 Lisp_Object Vexec_path
, Vexec_directory
, Vexec_suffixes
;
105 Lisp_Object Vdata_directory
, Vdoc_directory
;
106 Lisp_Object Vconfigure_info_directory
, Vshared_game_score_directory
;
108 /* Pattern used by call-process-region to make temp files. */
109 static Lisp_Object Vtemp_file_name_pattern
;
111 extern Lisp_Object Vtemporary_file_directory
;
113 Lisp_Object Vshell_file_name
;
115 Lisp_Object Vprocess_environment
, Vinitial_environment
;
118 Lisp_Object Qbuffer_file_type
;
121 /* True if we are about to fork off a synchronous process or if we
122 are waiting for it. */
123 int synch_process_alive
;
125 /* Nonzero => this is a string explaining death of synchronous subprocess. */
126 char *synch_process_death
;
128 /* Nonzero => this is the signal number that terminated the subprocess. */
129 int synch_process_termsig
;
131 /* If synch_process_death is zero,
132 this is exit code of synchronous subprocess. */
133 int synch_process_retcode
;
136 /* Clean up when exiting Fcall_process.
137 On MSDOS, delete the temporary file on any kind of termination.
138 On Unix, kill the process and any children on termination by signal. */
140 /* Nonzero if this is termination due to exit. */
141 static int call_process_exited
;
143 EXFUN (Fgetenv_internal
, 2);
146 call_process_kill (fdpid
)
149 emacs_close (XFASTINT (Fcar (fdpid
)));
150 EMACS_KILLPG (XFASTINT (Fcdr (fdpid
)), SIGKILL
);
151 synch_process_alive
= 0;
156 call_process_cleanup (arg
)
159 Lisp_Object fdpid
= Fcdr (arg
);
166 Fset_buffer (Fcar (arg
));
169 /* for MSDOS fdpid is really (fd . tempfile) */
171 emacs_close (XFASTINT (Fcar (fdpid
)));
172 if (strcmp (SDATA (file
), NULL_DEVICE
) != 0)
173 unlink (SDATA (file
));
174 #else /* not MSDOS */
175 pid
= XFASTINT (Fcdr (fdpid
));
177 if (call_process_exited
)
179 emacs_close (XFASTINT (Fcar (fdpid
)));
183 if (EMACS_KILLPG (pid
, SIGINT
) == 0)
185 int count
= SPECPDL_INDEX ();
186 record_unwind_protect (call_process_kill
, fdpid
);
187 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
190 wait_for_termination (pid
);
192 specpdl_ptr
= specpdl
+ count
; /* Discard the unwind protect. */
193 message1 ("Waiting for process to die...done");
195 synch_process_alive
= 0;
196 emacs_close (XFASTINT (Fcar (fdpid
)));
197 #endif /* not MSDOS */
201 DEFUN ("call-process", Fcall_process
, Scall_process
, 1, MANY
, 0,
202 doc
: /* Call PROGRAM synchronously in separate process.
203 The remaining arguments are optional.
204 The program's input comes from file INFILE (nil means `/dev/null').
205 Insert output in BUFFER before point; t means current buffer;
206 nil for BUFFER means discard it; 0 means discard and don't wait.
207 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
208 REAL-BUFFER says what to do with standard output, as above,
209 while STDERR-FILE says what to do with standard error in the child.
210 STDERR-FILE may be nil (discard standard error output),
211 t (mix it with ordinary output), or a file name string.
213 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
214 Remaining arguments are strings passed as command arguments to PROGRAM.
216 If executable PROGRAM can't be found as an executable, `call-process'
217 signals a Lisp error. `call-process' reports errors in execution of
218 the program only through its return and output.
220 If BUFFER is 0, `call-process' returns immediately with value nil.
221 Otherwise it waits for PROGRAM to terminate
222 and returns a numeric exit status or a signal description string.
223 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
225 usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
228 register Lisp_Object
*args
;
230 Lisp_Object infile
, buffer
, current_dir
, path
;
235 #define CALLPROC_BUFFER_SIZE_MIN (16 * 1024)
236 #define CALLPROC_BUFFER_SIZE_MAX (4 * CALLPROC_BUFFER_SIZE_MIN)
237 char buf
[CALLPROC_BUFFER_SIZE_MAX
];
238 int bufsize
= CALLPROC_BUFFER_SIZE_MIN
;
239 int count
= SPECPDL_INDEX ();
241 register const unsigned char **new_argv
;
242 /* File to use for stderr in the child.
243 t means use same as standard output. */
244 Lisp_Object error_file
;
245 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
246 char *outf
, *tempfile
;
249 struct coding_system process_coding
; /* coding-system of process output */
250 struct coding_system argument_coding
; /* coding-system of arguments */
251 /* Set to the return value of Ffind_operation_coding_system. */
252 Lisp_Object coding_systems
;
254 /* Qt denotes that Ffind_operation_coding_system is not yet called. */
257 CHECK_STRING (args
[0]);
262 /* Without asynchronous processes we cannot have BUFFER == 0. */
264 && (INTEGERP (CONSP (args
[2]) ? XCAR (args
[2]) : args
[2])))
265 error ("Operating system cannot handle asynchronous subprocesses");
266 #endif /* subprocesses */
268 /* Decide the coding-system for giving arguments. */
270 Lisp_Object val
, *args2
;
273 /* If arguments are supplied, we may have to encode them. */
277 Lisp_Object coding_attrs
;
279 for (i
= 4; i
< nargs
; i
++)
280 CHECK_STRING (args
[i
]);
282 for (i
= 4; i
< nargs
; i
++)
283 if (STRING_MULTIBYTE (args
[i
]))
286 if (!NILP (Vcoding_system_for_write
))
287 val
= Vcoding_system_for_write
;
288 else if (! must_encode
)
292 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
293 args2
[0] = Qcall_process
;
294 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
295 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
296 if (CONSP (coding_systems
))
297 val
= XCDR (coding_systems
);
298 else if (CONSP (Vdefault_process_coding_system
))
299 val
= XCDR (Vdefault_process_coding_system
);
303 val
= coding_inherit_eol_type (val
, Qnil
);
304 setup_coding_system (Fcheck_coding_system (val
), &argument_coding
);
305 coding_attrs
= CODING_ID_ATTRS (argument_coding
.id
);
306 if (NILP (CODING_ATTR_ASCII_COMPAT (coding_attrs
)))
308 /* We should not use an ASCII incompatible coding system. */
309 val
= raw_text_coding_system (val
);
310 setup_coding_system (val
, &argument_coding
);
315 if (nargs
>= 2 && ! NILP (args
[1]))
317 infile
= Fexpand_file_name (args
[1], current_buffer
->directory
);
318 CHECK_STRING (infile
);
321 infile
= build_string (NULL_DEVICE
);
327 /* If BUFFER is a list, its meaning is
328 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
331 if (CONSP (XCDR (buffer
)))
333 Lisp_Object stderr_file
;
334 stderr_file
= XCAR (XCDR (buffer
));
336 if (NILP (stderr_file
) || EQ (Qt
, stderr_file
))
337 error_file
= stderr_file
;
339 error_file
= Fexpand_file_name (stderr_file
, Qnil
);
342 buffer
= XCAR (buffer
);
345 if (!(EQ (buffer
, Qnil
)
347 || INTEGERP (buffer
)))
349 Lisp_Object spec_buffer
;
350 spec_buffer
= buffer
;
351 buffer
= Fget_buffer_create (buffer
);
352 /* Mention the buffer name for a better error message. */
354 CHECK_BUFFER (spec_buffer
);
355 CHECK_BUFFER (buffer
);
361 /* Make sure that the child will be able to chdir to the current
362 buffer's current directory, or its unhandled equivalent. We
363 can't just have the child check for an error when it does the
364 chdir, since it's in a vfork.
366 We have to GCPRO around this because Fexpand_file_name,
367 Funhandled_file_name_directory, and Ffile_accessible_directory_p
368 might call a file name handling function. The argument list is
369 protected by the caller, so all we really have to worry about is
372 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
374 current_dir
= current_buffer
->directory
;
376 GCPRO4 (infile
, buffer
, current_dir
, error_file
);
378 current_dir
= Funhandled_file_name_directory (current_dir
);
379 if (NILP (current_dir
))
380 /* If the file name handler says that current_dir is unreachable, use
381 a sensible default. */
382 current_dir
= build_string ("~/");
383 current_dir
= expand_and_dir_to_file (current_dir
, Qnil
);
384 current_dir
= Ffile_name_as_directory (current_dir
);
386 if (NILP (Ffile_accessible_directory_p (current_dir
)))
387 report_file_error ("Setting current directory",
388 Fcons (current_buffer
->directory
, Qnil
));
390 if (STRING_MULTIBYTE (infile
))
391 infile
= ENCODE_FILE (infile
);
392 if (STRING_MULTIBYTE (current_dir
))
393 current_dir
= ENCODE_FILE (current_dir
);
394 if (STRINGP (error_file
) && STRING_MULTIBYTE (error_file
))
395 error_file
= ENCODE_FILE (error_file
);
399 display_p
= INTERACTIVE
&& nargs
>= 4 && !NILP (args
[3]);
401 filefd
= emacs_open (SDATA (infile
), O_RDONLY
, 0);
404 infile
= DECODE_FILE (infile
);
405 report_file_error ("Opening process input file", Fcons (infile
, Qnil
));
407 /* Search for program; barf if not found. */
409 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
411 GCPRO4 (infile
, buffer
, current_dir
, error_file
);
412 openp (Vexec_path
, args
[0], Vexec_suffixes
, &path
, make_number (X_OK
));
417 emacs_close (filefd
);
418 report_file_error ("Searching for program", Fcons (args
[0], Qnil
));
421 /* If program file name starts with /: for quoting a magic name,
423 if (SBYTES (path
) > 2 && SREF (path
, 0) == '/'
424 && SREF (path
, 1) == ':')
425 path
= Fsubstring (path
, make_number (2), Qnil
);
427 new_argv
= (const unsigned char **)
428 alloca (max (2, nargs
- 2) * sizeof (char *));
432 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
434 GCPRO5 (infile
, buffer
, current_dir
, path
, error_file
);
435 argument_coding
.dst_multibyte
= 0;
436 for (i
= 4; i
< nargs
; i
++)
438 argument_coding
.src_multibyte
= STRING_MULTIBYTE (args
[i
]);
439 if (CODING_REQUIRE_ENCODING (&argument_coding
))
440 /* We must encode this argument. */
441 args
[i
] = encode_coding_string (&argument_coding
, args
[i
], 1);
444 for (i
= 4; i
< nargs
; i
++)
445 new_argv
[i
- 3] = SDATA (args
[i
]);
450 new_argv
[0] = SDATA (path
);
452 #ifdef MSDOS /* MW, July 1993 */
453 if ((outf
= egetenv ("TMPDIR")))
454 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
457 tempfile
= alloca (20);
460 dostounix_filename (tempfile
);
461 if (*tempfile
== '\0' || tempfile
[strlen (tempfile
) - 1] != '/')
462 strcat (tempfile
, "/");
463 strcat (tempfile
, "detmp.XXX");
466 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
469 emacs_close (filefd
);
470 report_file_error ("Opening process output file",
471 Fcons (build_string (tempfile
), Qnil
));
477 if (INTEGERP (buffer
))
478 fd
[1] = emacs_open (NULL_DEVICE
, O_WRONLY
, 0), fd
[0] = -1;
485 emacs_close (filefd
);
486 report_file_error ("Creating process pipe", Qnil
);
492 /* child_setup must clobber environ in systems with true vfork.
493 Protect it from permanent change. */
494 register char **save_environ
= environ
;
495 register int fd1
= fd
[1];
498 #if 0 /* Some systems don't have sigblock. */
499 mask
= sigblock (sigmask (SIGCHLD
));
502 /* Record that we're about to create a synchronous process. */
503 synch_process_alive
= 1;
505 /* These vars record information from process termination.
506 Clear them now before process can possibly terminate,
507 to avoid timing error if process terminates soon. */
508 synch_process_death
= 0;
509 synch_process_retcode
= 0;
510 synch_process_termsig
= 0;
512 if (NILP (error_file
))
513 fd_error
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
514 else if (STRINGP (error_file
))
517 fd_error
= emacs_open (SDATA (error_file
),
518 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
520 #else /* not DOS_NT */
521 fd_error
= creat (SDATA (error_file
), 0666);
522 #endif /* not DOS_NT */
527 emacs_close (filefd
);
535 if (NILP (error_file
))
536 error_file
= build_string (NULL_DEVICE
);
537 else if (STRINGP (error_file
))
538 error_file
= DECODE_FILE (error_file
);
539 report_file_error ("Cannot redirect stderr", Fcons (error_file
, Qnil
));
542 #ifdef MSDOS /* MW, July 1993 */
543 /* Note that on MSDOS `child_setup' actually returns the child process
544 exit status, not its PID, so we assign it to `synch_process_retcode'
546 pid
= child_setup (filefd
, outfilefd
, fd_error
, (char **) new_argv
,
549 /* Record that the synchronous process exited and note its
550 termination status. */
551 synch_process_alive
= 0;
552 synch_process_retcode
= pid
;
553 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
555 synchronize_system_messages_locale ();
556 synch_process_death
= strerror (errno
);
559 emacs_close (outfilefd
);
560 if (fd_error
!= outfilefd
)
561 emacs_close (fd_error
);
562 fd1
= -1; /* No harm in closing that one! */
563 /* Since CRLF is converted to LF within `decode_coding', we can
564 always open a file with binary mode. */
565 fd
[0] = emacs_open (tempfile
, O_RDONLY
| O_BINARY
, 0);
569 emacs_close (filefd
);
570 report_file_error ("Cannot re-open temporary file", Qnil
);
572 #else /* not MSDOS */
574 pid
= child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
576 #else /* not WINDOWSNT */
588 #if defined (USG) && !defined (BSD_PGRPS)
593 child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
598 #endif /* not WINDOWSNT */
600 /* The MSDOS case did this already. */
602 emacs_close (fd_error
);
603 #endif /* not MSDOS */
605 environ
= save_environ
;
607 /* Close most of our fd's, but not fd[0]
608 since we will use that to read input from. */
609 emacs_close (filefd
);
610 if (fd1
>= 0 && fd1
!= fd_error
)
618 report_file_error ("Doing vfork", Qnil
);
621 if (INTEGERP (buffer
))
626 /* If Emacs has been built with asynchronous subprocess support,
627 we don't need to do this, I think because it will then have
628 the facilities for handling SIGCHLD. */
629 wait_without_blocking ();
630 #endif /* subprocesses */
634 /* Enable sending signal if user quits below. */
635 call_process_exited
= 0;
638 /* MSDOS needs different cleanup information. */
639 record_unwind_protect (call_process_cleanup
,
640 Fcons (Fcurrent_buffer (),
641 Fcons (make_number (fd
[0]),
642 build_string (tempfile
))));
644 record_unwind_protect (call_process_cleanup
,
645 Fcons (Fcurrent_buffer (),
646 Fcons (make_number (fd
[0]), make_number (pid
))));
647 #endif /* not MSDOS */
650 if (BUFFERP (buffer
))
651 Fset_buffer (buffer
);
655 /* If BUFFER is nil, we must read process output once and then
656 discard it, so setup coding system but with nil. */
657 setup_coding_system (Qnil
, &process_coding
);
661 Lisp_Object val
, *args2
;
664 if (!NILP (Vcoding_system_for_read
))
665 val
= Vcoding_system_for_read
;
668 if (EQ (coding_systems
, Qt
))
672 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
673 args2
[0] = Qcall_process
;
674 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
676 = Ffind_operation_coding_system (nargs
+ 1, args2
);
678 if (CONSP (coding_systems
))
679 val
= XCAR (coding_systems
);
680 else if (CONSP (Vdefault_process_coding_system
))
681 val
= XCAR (Vdefault_process_coding_system
);
685 Fcheck_coding_system (val
);
686 /* In unibyte mode, character code conversion should not take
687 place but EOL conversion should. So, setup raw-text or one
688 of the subsidiary according to the information just setup. */
689 if (NILP (current_buffer
->enable_multibyte_characters
)
691 val
= raw_text_coding_system (val
);
692 setup_coding_system (val
, &process_coding
);
703 int display_on_the_fly
= display_p
;
704 struct coding_system saved_coding
;
706 saved_coding
= process_coding
;
709 /* Repeatedly read until we've filled as much as possible
710 of the buffer size we have. But don't read
711 less than 1024--save that for the next bufferful. */
713 while (nread
< bufsize
- 1024)
715 int this_read
= emacs_read (fd
[0], buf
+ nread
,
723 process_coding
.mode
|= CODING_MODE_LAST_BLOCK
;
728 total_read
+= this_read
;
730 if (display_on_the_fly
)
734 /* Now NREAD is the total amount of data in the buffer. */
739 if (NILP (current_buffer
->enable_multibyte_characters
)
740 && ! CODING_MAY_REQUIRE_DECODING (&process_coding
))
741 insert_1_both (buf
, nread
, nread
, 0, 1, 0);
743 { /* We have to decode the input. */
745 int count1
= SPECPDL_INDEX ();
747 XSETBUFFER (curbuf
, current_buffer
);
748 /* We cannot allow after-change-functions be run
749 during decoding, because that might modify the
750 buffer, while we rely on process_coding.produced to
751 faithfully reflect inserted text until we
752 TEMP_SET_PT_BOTH below. */
753 specbind (Qinhibit_modification_hooks
, Qt
);
754 decode_coding_c_string (&process_coding
, buf
, nread
,
756 unbind_to (count1
, Qnil
);
757 if (display_on_the_fly
758 && CODING_REQUIRE_DETECTION (&saved_coding
)
759 && ! CODING_REQUIRE_DETECTION (&process_coding
))
761 /* We have detected some coding system. But,
762 there's a possibility that the detection was
763 done by insufficient data. So, we give up
764 displaying on the fly. */
765 if (process_coding
.produced
> 0)
766 del_range_2 (process_coding
.dst_pos
,
767 process_coding
.dst_pos_byte
,
768 process_coding
.dst_pos
769 + process_coding
.produced_char
,
770 process_coding
.dst_pos_byte
771 + process_coding
.produced
, 0);
772 display_on_the_fly
= 0;
773 process_coding
= saved_coding
;
775 /* This is to make the above condition always
776 fails in the future. */
777 saved_coding
.common_flags
778 &= ~CODING_REQUIRE_DETECTION_MASK
;
782 TEMP_SET_PT_BOTH (PT
+ process_coding
.produced_char
,
783 PT_BYTE
+ process_coding
.produced
);
784 carryover
= process_coding
.carryover_bytes
;
786 /* As CARRYOVER should not be that large, we had
787 better avoid overhead of bcopy. */
788 BCOPY_SHORT (process_coding
.carryover
, buf
,
789 process_coding
.carryover_bytes
);
793 if (process_coding
.mode
& CODING_MODE_LAST_BLOCK
)
796 #if (CALLPROC_BUFFER_SIZE_MIN != CALLPROC_BUFFER_SIZE_MAX)
797 /* Make the buffer bigger as we continue to read more data,
798 but not past CALLPROC_BUFFER_SIZE_MAX. */
799 if (bufsize
< CALLPROC_BUFFER_SIZE_MAX
&& total_read
> 32 * bufsize
)
800 if ((bufsize
*= 2) > CALLPROC_BUFFER_SIZE_MAX
)
801 bufsize
= CALLPROC_BUFFER_SIZE_MAX
;
807 prepare_menu_bars ();
809 redisplay_preserve_echo_area (1);
810 /* This variable might have been set to 0 for code
811 detection. In that case, we set it back to 1 because
812 we should have already detected a coding system. */
813 display_on_the_fly
= 1;
820 Vlast_coding_system_used
= CODING_ID_NAME (process_coding
.id
);
821 /* If the caller required, let the buffer inherit the
822 coding-system used to decode the process output. */
823 if (inherit_process_coding_system
)
824 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
825 make_number (total_read
));
828 /* Wait for it to terminate, unless it already has. */
829 wait_for_termination (pid
);
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_termsig
)
843 synchronize_system_messages_locale ();
844 signame
= strsignal (synch_process_termsig
);
849 synch_process_death
= signame
;
852 if (synch_process_death
)
853 return code_convert_string_norecord (build_string (synch_process_death
),
854 Vlocale_coding_system
, 0);
855 return make_number (synch_process_retcode
);
859 delete_temp_file (name
)
862 /* Suppress jka-compr handling, etc. */
863 int count
= SPECPDL_INDEX ();
864 specbind (intern ("file-name-handler-alist"), Qnil
);
865 internal_delete_file (name
);
866 unbind_to (count
, Qnil
);
870 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
872 doc
: /* Send text from START to END to a synchronous process running PROGRAM.
873 The remaining arguments are optional.
874 Delete the text if fourth arg DELETE is non-nil.
876 Insert output in BUFFER before point; t means current buffer;
877 nil for BUFFER means discard it; 0 means discard and don't wait.
878 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
879 REAL-BUFFER says what to do with standard output, as above,
880 while STDERR-FILE says what to do with standard error in the child.
881 STDERR-FILE may be nil (discard standard error output),
882 t (mix it with ordinary output), or a file name string.
884 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
885 Remaining args are passed to PROGRAM at startup as command args.
887 If BUFFER is 0, `call-process-region' returns immediately with value nil.
888 Otherwise it waits for PROGRAM to terminate
889 and returns a numeric exit status or a signal description string.
890 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
892 usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
895 register Lisp_Object
*args
;
898 Lisp_Object filename_string
;
899 register Lisp_Object start
, end
;
900 int count
= SPECPDL_INDEX ();
901 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
902 Lisp_Object coding_systems
;
903 Lisp_Object val
, *args2
;
906 Lisp_Object tmpdir
, pattern
;
908 if (STRINGP (Vtemporary_file_directory
))
909 tmpdir
= Vtemporary_file_directory
;
913 if (getenv ("TMPDIR"))
914 tmpdir
= build_string (getenv ("TMPDIR"));
916 tmpdir
= build_string ("/tmp/");
919 if ((outf
= egetenv ("TMPDIR"))
920 || (outf
= egetenv ("TMP"))
921 || (outf
= egetenv ("TEMP")))
922 tmpdir
= build_string (outf
);
924 tmpdir
= Ffile_name_as_directory (build_string ("c:/temp"));
928 pattern
= Fexpand_file_name (Vtemp_file_name_pattern
, tmpdir
);
929 tempfile
= (char *) alloca (SBYTES (pattern
) + 1);
930 bcopy (SDATA (pattern
), tempfile
, SBYTES (pattern
) + 1);
938 fd
= mkstemp (tempfile
);
941 report_file_error ("Failed to open temporary file",
942 Fcons (Vtemp_file_name_pattern
, Qnil
));
950 filename_string
= build_string (tempfile
);
951 GCPRO1 (filename_string
);
954 /* Decide coding-system of the contents of the temporary file. */
955 if (!NILP (Vcoding_system_for_write
))
956 val
= Vcoding_system_for_write
;
957 else if (NILP (current_buffer
->enable_multibyte_characters
))
961 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
962 args2
[0] = Qcall_process_region
;
963 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
964 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
965 if (CONSP (coding_systems
))
966 val
= XCDR (coding_systems
);
967 else if (CONSP (Vdefault_process_coding_system
))
968 val
= XCDR (Vdefault_process_coding_system
);
974 int count1
= SPECPDL_INDEX ();
976 specbind (intern ("coding-system-for-write"), val
);
977 /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
978 happen to get a ".Z" suffix. */
979 specbind (intern ("file-name-handler-alist"), Qnil
);
980 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
, Qnil
, Qnil
);
982 unbind_to (count1
, Qnil
);
985 /* Note that Fcall_process takes care of binding
986 coding-system-for-read. */
988 record_unwind_protect (delete_temp_file
, filename_string
);
990 if (nargs
> 3 && !NILP (args
[3]))
991 Fdelete_region (start
, end
);
1003 args
[1] = filename_string
;
1005 RETURN_UNGCPRO (unbind_to (count
, Fcall_process (nargs
, args
)));
1008 static int relocate_fd ();
1011 add_env (char **env
, char **new_env
, char *string
)
1018 /* See if this string duplicates any string already in the env.
1019 If so, don't put it in.
1020 When an env var has multiple definitions,
1021 we keep the definition that comes first in process-environment. */
1022 for (ep
= env
; ok
&& ep
!= new_env
; ep
++)
1024 char *p
= *ep
, *q
= string
;
1030 /* The string is a lone variable name; keep it for now, we
1031 will remove it later. It is a placeholder for a
1032 variable that is not to be included in the environment. */
1040 *new_env
++ = string
;
1044 /* This is the last thing run in a newly forked inferior
1045 either synchronous or asynchronous.
1046 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
1047 Initialize inferior's priority, pgrp, connected dir and environment.
1048 then exec another program based on new_argv.
1050 This function may change environ for the superior process.
1051 Therefore, the superior process must save and restore the value
1052 of environ around the vfork and the call to this function.
1054 SET_PGRP is nonzero if we should put the subprocess into a separate
1057 CURRENT_DIR is an elisp string giving the path of the current
1058 directory the subprocess should have. Since we can't really signal
1059 a decent error from within the child, this should be verified as an
1060 executable directory by the parent. */
1063 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
1065 register char **new_argv
;
1067 Lisp_Object current_dir
;
1074 #endif /* WINDOWSNT */
1076 int pid
= getpid ();
1078 #ifdef SET_EMACS_PRIORITY
1080 extern EMACS_INT emacs_priority
;
1082 if (emacs_priority
< 0)
1083 nice (- emacs_priority
);
1088 /* Close Emacs's descriptors that this process should not have. */
1089 close_process_descs ();
1091 /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
1092 we will lose if we call close_load_descs here. */
1094 close_load_descs ();
1097 /* Note that use of alloca is always safe here. It's obvious for systems
1098 that do not have true vfork or that have true (stack) alloca.
1099 If using vfork and C_ALLOCA (when Emacs used to include
1100 src/alloca.c) it is safe because that changes the superior's
1101 static variables as if the superior had done alloca and will be
1102 cleaned up in the usual way. */
1104 register char *temp
;
1107 i
= SBYTES (current_dir
);
1109 /* MSDOS must have all environment variables malloc'ed, because
1110 low-level libc functions that launch subsidiary processes rely
1112 pwd_var
= (char *) xmalloc (i
+ 6);
1114 pwd_var
= (char *) alloca (i
+ 6);
1117 bcopy ("PWD=", pwd_var
, 4);
1118 bcopy (SDATA (current_dir
), temp
, i
);
1119 if (!IS_DIRECTORY_SEP (temp
[i
- 1])) temp
[i
++] = DIRECTORY_SEP
;
1123 /* We can't signal an Elisp error here; we're in a vfork. Since
1124 the callers check the current directory before forking, this
1125 should only return an error if the directory's permissions
1126 are changed between the check and this chdir, but we should
1128 if (chdir (temp
) < 0)
1133 /* Get past the drive letter, so that d:/ is left alone. */
1134 if (i
> 2 && IS_DEVICE_SEP (temp
[1]) && IS_DIRECTORY_SEP (temp
[2]))
1141 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1142 while (i
> 2 && IS_DIRECTORY_SEP (temp
[i
- 1]))
1146 /* Set `env' to a vector of the strings in the environment. */
1148 register Lisp_Object tem
;
1149 register char **new_env
;
1151 register int new_length
;
1152 Lisp_Object display
= Qnil
;
1156 for (tem
= Vprocess_environment
;
1157 CONSP (tem
) && STRINGP (XCAR (tem
));
1160 if (strncmp (SDATA (XCAR (tem
)), "DISPLAY", 7) == 0
1161 && (SDATA (XCAR (tem
)) [7] == '\0'
1162 || SDATA (XCAR (tem
)) [7] == '='))
1163 /* DISPLAY is specified in process-environment. */
1168 /* If not provided yet, use the frame's DISPLAY. */
1171 Lisp_Object tmp
= Fframe_parameter (selected_frame
, Qdisplay
);
1172 if (!STRINGP (tmp
) && CONSP (Vinitial_environment
))
1173 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1174 tmp
= Fgetenv_internal (build_string ("DISPLAY"),
1175 Vinitial_environment
);
1183 /* new_length + 2 to include PWD and terminating 0. */
1184 env
= new_env
= (char **) alloca ((new_length
+ 2) * sizeof (char *));
1185 /* If we have a PWD envvar, pass one down,
1186 but with corrected value. */
1187 if (egetenv ("PWD"))
1188 *new_env
++ = pwd_var
;
1190 if (STRINGP (display
))
1192 int vlen
= strlen ("DISPLAY=") + strlen (SDATA (display
)) + 1;
1193 char *vdata
= (char *) alloca (vlen
);
1194 strcpy (vdata
, "DISPLAY=");
1195 strcat (vdata
, SDATA (display
));
1196 new_env
= add_env (env
, new_env
, vdata
);
1200 for (tem
= Vprocess_environment
;
1201 CONSP (tem
) && STRINGP (XCAR (tem
));
1203 new_env
= add_env (env
, new_env
, SDATA (XCAR (tem
)));
1207 /* Remove variable names without values. */
1211 while (*q
!= 0 && strchr (*q
, '=') == NULL
)
1221 prepare_standard_handles (in
, out
, err
, handles
);
1222 set_process_dir (SDATA (current_dir
));
1223 #else /* not WINDOWSNT */
1224 /* Make sure that in, out, and err are not actually already in
1225 descriptors zero, one, or two; this could happen if Emacs is
1226 started with its standard in, out, or error closed, as might
1229 int oin
= in
, oout
= out
;
1231 /* We have to avoid relocating the same descriptor twice! */
1233 in
= relocate_fd (in
, 3);
1238 out
= relocate_fd (out
, 3);
1242 else if (err
== oout
)
1245 err
= relocate_fd (err
, 3);
1259 #endif /* not MSDOS */
1260 #endif /* not WINDOWSNT */
1262 #if defined(USG) && !defined(BSD_PGRPS)
1263 #ifndef SETPGRP_RELEASES_CTTY
1264 setpgrp (); /* No arguments but equivalent in this case */
1269 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1270 EMACS_SET_TTY_PGRP (0, &pid
);
1273 pid
= run_msdos_command (new_argv
, pwd_var
+ 4, in
, out
, err
, env
);
1276 /* An error occurred while trying to run the subprocess. */
1277 report_file_error ("Spawning child process", Qnil
);
1279 #else /* not MSDOS */
1281 /* Spawn the child. (See ntproc.c:Spawnve). */
1282 cpid
= spawnve (_P_NOWAIT
, new_argv
[0], new_argv
, env
);
1283 reset_standard_handles (in
, out
, err
, handles
);
1285 /* An error occurred while trying to spawn the process. */
1286 report_file_error ("Spawning child process", Qnil
);
1288 #else /* not WINDOWSNT */
1289 /* execvp does not accept an environment arg so the only way
1290 to pass this environment is to set environ. Our caller
1291 is responsible for restoring the ambient value of environ. */
1293 execvp (new_argv
[0], new_argv
);
1295 emacs_write (1, "Can't exec program: ", 20);
1296 emacs_write (1, new_argv
[0], strlen (new_argv
[0]));
1297 emacs_write (1, "\n", 1);
1299 #endif /* not WINDOWSNT */
1300 #endif /* not MSDOS */
1303 /* Move the file descriptor FD so that its number is not less than MINFD.
1304 If the file descriptor is moved at all, the original is freed. */
1306 relocate_fd (fd
, minfd
)
1316 char *message1
= "Error while setting up child: ";
1317 char *errmessage
= strerror (errno
);
1318 char *message2
= "\n";
1319 emacs_write (2, message1
, strlen (message1
));
1320 emacs_write (2, errmessage
, strlen (errmessage
));
1321 emacs_write (2, message2
, strlen (message2
));
1324 /* Note that we hold the original FD open while we recurse,
1325 to guarantee we'll get a new FD if we need it. */
1326 new = relocate_fd (new, minfd
);
1333 getenv_internal_1 (var
, varlen
, value
, valuelen
, env
)
1340 for (; CONSP (env
); env
= XCDR (env
))
1342 Lisp_Object entry
= XCAR (env
);
1344 && SBYTES (entry
) >= varlen
1346 /* NT environment variables are case insensitive. */
1347 && ! strnicmp (SDATA (entry
), var
, varlen
)
1348 #else /* not WINDOWSNT */
1349 && ! bcmp (SDATA (entry
), var
, varlen
)
1350 #endif /* not WINDOWSNT */
1353 if (SBYTES (entry
) > varlen
&& SREF (entry
, varlen
) == '=')
1355 *value
= (char *) SDATA (entry
) + (varlen
+ 1);
1356 *valuelen
= SBYTES (entry
) - (varlen
+ 1);
1359 else if (SBYTES (entry
) == varlen
)
1361 /* Lone variable names in Vprocess_environment mean that
1362 variable should be removed from the environment. */
1372 getenv_internal (var
, varlen
, value
, valuelen
, frame
)
1379 /* Try to find VAR in Vprocess_environment first. */
1380 if (getenv_internal_1 (var
, varlen
, value
, valuelen
,
1381 Vprocess_environment
))
1382 return *value
? 1 : 0;
1384 /* For DISPLAY try to get the values from the frame or the initial env. */
1385 if (strcmp (var
, "DISPLAY") == 0)
1388 = Fframe_parameter (NILP (frame
) ? selected_frame
: frame
, Qdisplay
);
1389 if (STRINGP (display
))
1391 *value
= (char *) SDATA (display
);
1392 *valuelen
= SBYTES (display
);
1395 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1396 if (getenv_internal_1 (var
, varlen
, value
, valuelen
,
1397 Vinitial_environment
))
1398 return *value
? 1 : 0;
1404 DEFUN ("getenv-internal", Fgetenv_internal
, Sgetenv_internal
, 1, 2, 0,
1405 doc
: /* Get the value of environment variable VARIABLE.
1406 VARIABLE should be a string. Value is nil if VARIABLE is undefined in
1407 the environment. Otherwise, value is a string.
1409 This function searches `process-environment' for VARIABLE.
1411 If optional parameter ENV is a list, then search this list instead of
1412 `process-environment', and return t when encountering a negative entry
1413 \(an entry for a variable with no value). */)
1415 Lisp_Object variable
, env
;
1420 CHECK_STRING (variable
);
1423 if (getenv_internal_1 (SDATA (variable
), SBYTES (variable
),
1424 &value
, &valuelen
, env
))
1425 return value
? make_string (value
, valuelen
) : Qt
;
1429 else if (getenv_internal (SDATA (variable
), SBYTES (variable
),
1430 &value
, &valuelen
, env
))
1431 return make_string (value
, valuelen
);
1436 /* A version of getenv that consults the Lisp environment lists,
1437 easily callable from C. */
1445 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
, Qnil
))
1452 /* This is run before init_cmdargs. */
1457 char *data_dir
= egetenv ("EMACSDATA");
1458 char *doc_dir
= egetenv ("EMACSDOC");
1461 = Ffile_name_as_directory (build_string (data_dir
? data_dir
1464 = Ffile_name_as_directory (build_string (doc_dir
? doc_dir
1467 /* Check the EMACSPATH environment variable, defaulting to the
1468 PATH_EXEC path from epaths.h. */
1469 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
1470 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
1471 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
1474 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1479 char *data_dir
= egetenv ("EMACSDATA");
1482 Lisp_Object tempdir
;
1484 if (!NILP (Vinstallation_directory
))
1486 /* Add to the path the lib-src subdir of the installation dir. */
1488 tem
= Fexpand_file_name (build_string ("lib-src"),
1489 Vinstallation_directory
);
1491 /* MSDOS uses wrapped binaries, so don't do this. */
1492 if (NILP (Fmember (tem
, Vexec_path
)))
1494 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
1495 Vexec_path
= Fcons (tem
, Vexec_path
);
1496 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
1499 Vexec_directory
= Ffile_name_as_directory (tem
);
1500 #endif /* not DOS_NT */
1502 /* Maybe use ../etc as well as ../lib-src. */
1505 tem
= Fexpand_file_name (build_string ("etc"),
1506 Vinstallation_directory
);
1507 Vdoc_directory
= Ffile_name_as_directory (tem
);
1511 /* Look for the files that should be in etc. We don't use
1512 Vinstallation_directory, because these files are never installed
1513 near the executable, and they are never in the build
1514 directory when that's different from the source directory.
1516 Instead, if these files are not in the nominal place, we try the
1517 source directory. */
1520 Lisp_Object tem
, tem1
, srcdir
;
1522 srcdir
= Fexpand_file_name (build_string ("../src/"),
1523 build_string (PATH_DUMPLOADSEARCH
));
1524 tem
= Fexpand_file_name (build_string ("GNU"), Vdata_directory
);
1525 tem1
= Ffile_exists_p (tem
);
1526 if (!NILP (Fequal (srcdir
, Vinvocation_directory
)) || NILP (tem1
))
1529 newdir
= Fexpand_file_name (build_string ("../etc/"),
1530 build_string (PATH_DUMPLOADSEARCH
));
1531 tem
= Fexpand_file_name (build_string ("GNU"), newdir
);
1532 tem1
= Ffile_exists_p (tem
);
1534 Vdata_directory
= newdir
;
1542 tempdir
= Fdirectory_file_name (Vexec_directory
);
1543 if (access (SDATA (tempdir
), 0) < 0)
1544 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1548 tempdir
= Fdirectory_file_name (Vdata_directory
);
1549 if (access (SDATA (tempdir
), 0) < 0)
1550 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1553 sh
= (char *) getenv ("SHELL");
1554 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
1557 Vshared_game_score_directory
= Qnil
;
1559 Vshared_game_score_directory
= build_string (PATH_GAME
);
1560 if (NILP (Ffile_directory_p (Vshared_game_score_directory
)))
1561 Vshared_game_score_directory
= Qnil
;
1566 set_initial_environment ()
1568 register char **envp
;
1574 Vprocess_environment
= Qnil
;
1576 for (envp
= environ
; *envp
; envp
++)
1577 Vprocess_environment
= Fcons (build_string (*envp
),
1578 Vprocess_environment
);
1579 /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
1580 to use `delete' and friends on process-environment. */
1581 Vinitial_environment
= Fcopy_sequence (Vprocess_environment
);
1589 Qbuffer_file_type
= intern ("buffer-file-type");
1590 staticpro (&Qbuffer_file_type
);
1594 Vtemp_file_name_pattern
= build_string ("emacsXXXXXX");
1595 #elif defined (WINDOWSNT)
1596 Vtemp_file_name_pattern
= build_string ("emXXXXXX");
1598 Vtemp_file_name_pattern
= build_string ("detmp.XXX");
1600 staticpro (&Vtemp_file_name_pattern
);
1602 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
1603 doc
: /* *File name to load inferior shells from.
1604 Initialized from the SHELL environment variable, or to a system-dependent
1605 default if SHELL is not set. */);
1607 DEFVAR_LISP ("exec-path", &Vexec_path
,
1608 doc
: /* *List of directories to search programs to run in subprocesses.
1609 Each element is a string (directory name) or nil (try default directory). */);
1611 DEFVAR_LISP ("exec-suffixes", &Vexec_suffixes
,
1612 doc
: /* *List of suffixes to try to find executable file names.
1613 Each element is a string. */);
1614 Vexec_suffixes
= Qnil
;
1616 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
1617 doc
: /* Directory for executables for Emacs to invoke.
1618 More generally, this includes any architecture-dependent files
1619 that are built and installed from the Emacs distribution. */);
1621 DEFVAR_LISP ("data-directory", &Vdata_directory
,
1622 doc
: /* Directory of machine-independent files that come with GNU Emacs.
1623 These are files intended for Emacs to use while it runs. */);
1625 DEFVAR_LISP ("doc-directory", &Vdoc_directory
,
1626 doc
: /* Directory containing the DOC file that comes with GNU Emacs.
1627 This is usually the same as `data-directory'. */);
1629 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
1630 doc
: /* For internal use by the build procedure only.
1631 This is the name of the directory in which the build procedure installed
1632 Emacs's info files; the default value for `Info-default-directory-list'
1634 Vconfigure_info_directory
= build_string (PATH_INFO
);
1636 DEFVAR_LISP ("shared-game-score-directory", &Vshared_game_score_directory
,
1637 doc
: /* Directory of score files for games which come with GNU Emacs.
1638 If this variable is nil, then Emacs is unable to use a shared directory. */);
1640 Vshared_game_score_directory
= Qnil
;
1642 Vshared_game_score_directory
= build_string (PATH_GAME
);
1645 DEFVAR_LISP ("initial-environment", &Vinitial_environment
,
1646 doc
: /* List of environment variables inherited from the parent process.
1647 Each element should be a string of the form ENVVARNAME=VALUE.
1648 The elements must normally be decoded (using `locale-coding-system') for use. */);
1649 Vinitial_environment
= Qnil
;
1651 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
1652 doc
: /* List of overridden environment variables for subprocesses to inherit.
1653 Each element should be a string of the form ENVVARNAME=VALUE.
1655 Entries in this list take precedence to those in the frame-local
1656 environments. Therefore, let-binding `process-environment' is an easy
1657 way to temporarily change the value of an environment variable,
1658 irrespective of where it comes from. To use `process-environment' to
1659 remove an environment variable, include only its name in the list,
1662 This variable is set to nil when Emacs starts.
1664 If multiple entries define the same variable, the first one always
1667 Non-ASCII characters are encoded according to the initial value of
1668 `locale-coding-system', i.e. the elements must normally be decoded for
1671 See `setenv' and `getenv'. */);
1672 Vprocess_environment
= Qnil
;
1674 defsubr (&Scall_process
);
1675 defsubr (&Sgetenv_internal
);
1676 defsubr (&Scall_process_region
);
1679 /* arch-tag: 769b8045-1df7-4d2b-8968-e3fb49017f95
1680 (do not change this comment) */