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, 2010
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/>. */
27 #include <sys/types.h>
43 #define _P_NOWAIT 1 /* from process.h */
46 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
49 #include <sys/param.h>
63 #include "character.h"
66 #include "composite.h"
69 #include "syssignal.h"
71 #include "blockinput.h"
73 #include "termhooks.h"
80 extern char **environ
;
86 #define setpgrp setpgid
90 Lisp_Object Vexec_path
, Vexec_directory
, Vexec_suffixes
;
91 Lisp_Object Vdata_directory
, Vdoc_directory
;
92 Lisp_Object Vconfigure_info_directory
, Vshared_game_score_directory
;
94 /* Pattern used by call-process-region to make temp files. */
95 static Lisp_Object Vtemp_file_name_pattern
;
97 Lisp_Object Vshell_file_name
;
99 Lisp_Object Vprocess_environment
, Vinitial_environment
;
102 Lisp_Object Qbuffer_file_type
;
105 /* True if we are about to fork off a synchronous process or if we
106 are waiting for it. */
107 int synch_process_alive
;
109 /* Nonzero => this is a string explaining death of synchronous subprocess. */
110 const char *synch_process_death
;
112 /* Nonzero => this is the signal number that terminated the subprocess. */
113 int synch_process_termsig
;
115 /* If synch_process_death is zero,
116 this is exit code of synchronous subprocess. */
117 int synch_process_retcode
;
120 /* Clean up when exiting Fcall_process.
121 On MSDOS, delete the temporary file on any kind of termination.
122 On Unix, kill the process and any children on termination by signal. */
124 /* Nonzero if this is termination due to exit. */
125 static int call_process_exited
;
127 EXFUN (Fgetenv_internal
, 2);
130 call_process_kill (Lisp_Object fdpid
)
132 emacs_close (XFASTINT (Fcar (fdpid
)));
133 EMACS_KILLPG (XFASTINT (Fcdr (fdpid
)), SIGKILL
);
134 synch_process_alive
= 0;
139 call_process_cleanup (Lisp_Object arg
)
141 Lisp_Object fdpid
= Fcdr (arg
);
148 Fset_buffer (Fcar (arg
));
151 /* for MSDOS fdpid is really (fd . tempfile) */
153 emacs_close (XFASTINT (Fcar (fdpid
)));
154 if (strcmp (SDATA (file
), NULL_DEVICE
) != 0)
155 unlink (SDATA (file
));
156 #else /* not MSDOS */
157 pid
= XFASTINT (Fcdr (fdpid
));
159 if (call_process_exited
)
161 emacs_close (XFASTINT (Fcar (fdpid
)));
165 if (EMACS_KILLPG (pid
, SIGINT
) == 0)
167 int count
= SPECPDL_INDEX ();
168 record_unwind_protect (call_process_kill
, fdpid
);
169 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
172 wait_for_termination (pid
);
174 specpdl_ptr
= specpdl
+ count
; /* Discard the unwind protect. */
175 message1 ("Waiting for process to die...done");
177 synch_process_alive
= 0;
178 emacs_close (XFASTINT (Fcar (fdpid
)));
179 #endif /* not MSDOS */
183 DEFUN ("call-process", Fcall_process
, Scall_process
, 1, MANY
, 0,
184 doc
: /* Call PROGRAM synchronously in separate process.
185 The remaining arguments are optional.
186 The program's input comes from file INFILE (nil means `/dev/null').
187 Insert output in BUFFER before point; t means current buffer;
188 nil for BUFFER means discard it; 0 means discard and don't wait.
189 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
190 REAL-BUFFER says what to do with standard output, as above,
191 while STDERR-FILE says what to do with standard error in the child.
192 STDERR-FILE may be nil (discard standard error output),
193 t (mix it with ordinary output), or a file name string.
195 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
196 Remaining arguments are strings passed as command arguments to PROGRAM.
198 If executable PROGRAM can't be found as an executable, `call-process'
199 signals a Lisp error. `call-process' reports errors in execution of
200 the program only through its return and output.
202 If BUFFER is 0, `call-process' returns immediately with value nil.
203 Otherwise it waits for PROGRAM to terminate
204 and returns a numeric exit status or a signal description string.
205 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
207 usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */)
208 (int nargs
, register Lisp_Object
*args
)
210 Lisp_Object infile
, buffer
, current_dir
, path
;
215 #define CALLPROC_BUFFER_SIZE_MIN (16 * 1024)
216 #define CALLPROC_BUFFER_SIZE_MAX (4 * CALLPROC_BUFFER_SIZE_MIN)
217 char buf
[CALLPROC_BUFFER_SIZE_MAX
];
218 int bufsize
= CALLPROC_BUFFER_SIZE_MIN
;
219 int count
= SPECPDL_INDEX ();
221 register const unsigned char **new_argv
;
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
;
229 struct coding_system process_coding
; /* coding-system of process output */
230 struct coding_system argument_coding
; /* coding-system of arguments */
231 /* Set to the return value of Ffind_operation_coding_system. */
232 Lisp_Object coding_systems
;
234 /* Qt denotes that Ffind_operation_coding_system is not yet called. */
237 CHECK_STRING (args
[0]);
242 /* Without asynchronous processes we cannot have BUFFER == 0. */
244 && (INTEGERP (CONSP (args
[2]) ? XCAR (args
[2]) : args
[2])))
245 error ("Operating system cannot handle asynchronous subprocesses");
246 #endif /* subprocesses */
248 /* Decide the coding-system for giving arguments. */
250 Lisp_Object val
, *args2
;
253 /* If arguments are supplied, we may have to encode them. */
257 Lisp_Object coding_attrs
;
259 for (i
= 4; i
< nargs
; i
++)
260 CHECK_STRING (args
[i
]);
262 for (i
= 4; i
< nargs
; i
++)
263 if (STRING_MULTIBYTE (args
[i
]))
266 if (!NILP (Vcoding_system_for_write
))
267 val
= Vcoding_system_for_write
;
268 else if (! must_encode
)
272 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
273 args2
[0] = Qcall_process
;
274 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
275 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
276 if (CONSP (coding_systems
))
277 val
= XCDR (coding_systems
);
278 else if (CONSP (Vdefault_process_coding_system
))
279 val
= XCDR (Vdefault_process_coding_system
);
283 val
= coding_inherit_eol_type (val
, Qnil
);
284 setup_coding_system (Fcheck_coding_system (val
), &argument_coding
);
285 coding_attrs
= CODING_ID_ATTRS (argument_coding
.id
);
286 if (NILP (CODING_ATTR_ASCII_COMPAT (coding_attrs
)))
288 /* We should not use an ASCII incompatible coding system. */
289 val
= raw_text_coding_system (val
);
290 setup_coding_system (val
, &argument_coding
);
295 if (nargs
>= 2 && ! NILP (args
[1]))
297 infile
= Fexpand_file_name (args
[1], current_buffer
->directory
);
298 CHECK_STRING (infile
);
301 infile
= build_string (NULL_DEVICE
);
307 /* If BUFFER is a list, its meaning is
308 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
311 if (CONSP (XCDR (buffer
)))
313 Lisp_Object stderr_file
;
314 stderr_file
= XCAR (XCDR (buffer
));
316 if (NILP (stderr_file
) || EQ (Qt
, stderr_file
))
317 error_file
= stderr_file
;
319 error_file
= Fexpand_file_name (stderr_file
, Qnil
);
322 buffer
= XCAR (buffer
);
325 if (!(EQ (buffer
, Qnil
)
327 || INTEGERP (buffer
)))
329 Lisp_Object spec_buffer
;
330 spec_buffer
= buffer
;
331 buffer
= Fget_buffer_create (buffer
);
332 /* Mention the buffer name for a better error message. */
334 CHECK_BUFFER (spec_buffer
);
335 CHECK_BUFFER (buffer
);
341 /* Make sure that the child will be able to chdir to the current
342 buffer's current directory, or its unhandled equivalent. We
343 can't just have the child check for an error when it does the
344 chdir, since it's in a vfork.
346 We have to GCPRO around this because Fexpand_file_name,
347 Funhandled_file_name_directory, and Ffile_accessible_directory_p
348 might call a file name handling function. The argument list is
349 protected by the caller, so all we really have to worry about is
352 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
354 current_dir
= current_buffer
->directory
;
356 GCPRO4 (infile
, buffer
, current_dir
, error_file
);
358 current_dir
= Funhandled_file_name_directory (current_dir
);
359 if (NILP (current_dir
))
360 /* If the file name handler says that current_dir is unreachable, use
361 a sensible default. */
362 current_dir
= build_string ("~/");
363 current_dir
= expand_and_dir_to_file (current_dir
, Qnil
);
364 current_dir
= Ffile_name_as_directory (current_dir
);
366 if (NILP (Ffile_accessible_directory_p (current_dir
)))
367 report_file_error ("Setting current directory",
368 Fcons (current_buffer
->directory
, Qnil
));
370 if (STRING_MULTIBYTE (infile
))
371 infile
= ENCODE_FILE (infile
);
372 if (STRING_MULTIBYTE (current_dir
))
373 current_dir
= ENCODE_FILE (current_dir
);
374 if (STRINGP (error_file
) && STRING_MULTIBYTE (error_file
))
375 error_file
= ENCODE_FILE (error_file
);
379 display_p
= INTERACTIVE
&& nargs
>= 4 && !NILP (args
[3]);
381 filefd
= emacs_open (SDATA (infile
), O_RDONLY
, 0);
384 infile
= DECODE_FILE (infile
);
385 report_file_error ("Opening process input file", Fcons (infile
, Qnil
));
387 /* Search for program; barf if not found. */
389 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
391 GCPRO4 (infile
, buffer
, current_dir
, error_file
);
392 openp (Vexec_path
, args
[0], Vexec_suffixes
, &path
, make_number (X_OK
));
397 emacs_close (filefd
);
398 report_file_error ("Searching for program", Fcons (args
[0], Qnil
));
401 /* If program file name starts with /: for quoting a magic name,
403 if (SBYTES (path
) > 2 && SREF (path
, 0) == '/'
404 && SREF (path
, 1) == ':')
405 path
= Fsubstring (path
, make_number (2), Qnil
);
407 new_argv
= (const unsigned char **)
408 alloca (max (2, nargs
- 2) * sizeof (char *));
412 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
414 GCPRO5 (infile
, buffer
, current_dir
, path
, error_file
);
415 argument_coding
.dst_multibyte
= 0;
416 for (i
= 4; i
< nargs
; i
++)
418 argument_coding
.src_multibyte
= STRING_MULTIBYTE (args
[i
]);
419 if (CODING_REQUIRE_ENCODING (&argument_coding
))
420 /* We must encode this argument. */
421 args
[i
] = encode_coding_string (&argument_coding
, args
[i
], 1);
424 for (i
= 4; i
< nargs
; i
++)
425 new_argv
[i
- 3] = SDATA (args
[i
]);
430 new_argv
[0] = SDATA (path
);
432 #ifdef MSDOS /* MW, July 1993 */
433 if ((outf
= egetenv ("TMPDIR")))
434 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
437 tempfile
= alloca (20);
440 dostounix_filename (tempfile
);
441 if (*tempfile
== '\0' || tempfile
[strlen (tempfile
) - 1] != '/')
442 strcat (tempfile
, "/");
443 strcat (tempfile
, "detmp.XXX");
446 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
449 emacs_close (filefd
);
450 report_file_error ("Opening process output file",
451 Fcons (build_string (tempfile
), Qnil
));
457 if (INTEGERP (buffer
))
458 fd
[1] = emacs_open (NULL_DEVICE
, O_WRONLY
, 0), fd
[0] = -1;
465 emacs_close (filefd
);
466 report_file_error ("Creating process pipe", Qnil
);
472 /* child_setup must clobber environ in systems with true vfork.
473 Protect it from permanent change. */
474 register char **save_environ
= environ
;
475 register int fd1
= fd
[1];
478 #if 0 /* Some systems don't have sigblock. */
479 mask
= sigblock (sigmask (SIGCHLD
));
482 /* Record that we're about to create a synchronous process. */
483 synch_process_alive
= 1;
485 /* These vars record information from process termination.
486 Clear them now before process can possibly terminate,
487 to avoid timing error if process terminates soon. */
488 synch_process_death
= 0;
489 synch_process_retcode
= 0;
490 synch_process_termsig
= 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 (SDATA (error_file
),
498 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
500 #else /* not DOS_NT */
501 fd_error
= creat (SDATA (error_file
), 0666);
502 #endif /* not DOS_NT */
507 emacs_close (filefd
);
515 if (NILP (error_file
))
516 error_file
= build_string (NULL_DEVICE
);
517 else if (STRINGP (error_file
))
518 error_file
= DECODE_FILE (error_file
);
519 report_file_error ("Cannot redirect stderr", Fcons (error_file
, Qnil
));
522 #ifdef MSDOS /* MW, July 1993 */
523 /* Note that on MSDOS `child_setup' actually returns the child process
524 exit status, not its PID, so we assign it to `synch_process_retcode'
526 pid
= child_setup (filefd
, outfilefd
, fd_error
, (char **) new_argv
,
529 /* Record that the synchronous process exited and note its
530 termination status. */
531 synch_process_alive
= 0;
532 synch_process_retcode
= pid
;
533 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
535 synchronize_system_messages_locale ();
536 synch_process_death
= strerror (errno
);
539 emacs_close (outfilefd
);
540 if (fd_error
!= outfilefd
)
541 emacs_close (fd_error
);
542 fd1
= -1; /* No harm in closing that one! */
543 /* Since CRLF is converted to LF within `decode_coding', we can
544 always open a file with binary mode. */
545 fd
[0] = emacs_open (tempfile
, O_RDONLY
| O_BINARY
, 0);
549 emacs_close (filefd
);
550 report_file_error ("Cannot re-open temporary file", Qnil
);
552 #else /* not MSDOS */
554 pid
= child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
556 #else /* not WINDOWSNT */
573 child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
578 #endif /* not WINDOWSNT */
580 /* The MSDOS case did this already. */
582 emacs_close (fd_error
);
583 #endif /* not MSDOS */
585 environ
= save_environ
;
587 /* Close most of our fd's, but not fd[0]
588 since we will use that to read input from. */
589 emacs_close (filefd
);
590 if (fd1
>= 0 && fd1
!= fd_error
)
598 report_file_error ("Doing vfork", Qnil
);
601 if (INTEGERP (buffer
))
608 /* Enable sending signal if user quits below. */
609 call_process_exited
= 0;
612 /* MSDOS needs different cleanup information. */
613 record_unwind_protect (call_process_cleanup
,
614 Fcons (Fcurrent_buffer (),
615 Fcons (make_number (fd
[0]),
616 build_string (tempfile
))));
618 record_unwind_protect (call_process_cleanup
,
619 Fcons (Fcurrent_buffer (),
620 Fcons (make_number (fd
[0]), make_number (pid
))));
621 #endif /* not MSDOS */
624 if (BUFFERP (buffer
))
625 Fset_buffer (buffer
);
629 /* If BUFFER is nil, we must read process output once and then
630 discard it, so setup coding system but with nil. */
631 setup_coding_system (Qnil
, &process_coding
);
635 Lisp_Object val
, *args2
;
638 if (!NILP (Vcoding_system_for_read
))
639 val
= Vcoding_system_for_read
;
642 if (EQ (coding_systems
, Qt
))
646 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
647 args2
[0] = Qcall_process
;
648 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
650 = Ffind_operation_coding_system (nargs
+ 1, args2
);
652 if (CONSP (coding_systems
))
653 val
= XCAR (coding_systems
);
654 else if (CONSP (Vdefault_process_coding_system
))
655 val
= XCAR (Vdefault_process_coding_system
);
659 Fcheck_coding_system (val
);
660 /* In unibyte mode, character code conversion should not take
661 place but EOL conversion should. So, setup raw-text or one
662 of the subsidiary according to the information just setup. */
663 if (NILP (current_buffer
->enable_multibyte_characters
)
665 val
= raw_text_coding_system (val
);
666 setup_coding_system (val
, &process_coding
);
673 register EMACS_INT nread
;
675 EMACS_INT total_read
= 0;
677 int display_on_the_fly
= display_p
;
678 struct coding_system saved_coding
;
680 saved_coding
= process_coding
;
683 /* Repeatedly read until we've filled as much as possible
684 of the buffer size we have. But don't read
685 less than 1024--save that for the next bufferful. */
687 while (nread
< bufsize
- 1024)
689 int this_read
= emacs_read (fd
[0], buf
+ nread
,
697 process_coding
.mode
|= CODING_MODE_LAST_BLOCK
;
702 total_read
+= this_read
;
704 if (display_on_the_fly
)
708 /* Now NREAD is the total amount of data in the buffer. */
713 if (NILP (current_buffer
->enable_multibyte_characters
)
714 && ! CODING_MAY_REQUIRE_DECODING (&process_coding
))
715 insert_1_both (buf
, nread
, nread
, 0, 1, 0);
717 { /* We have to decode the input. */
719 int count1
= SPECPDL_INDEX ();
721 XSETBUFFER (curbuf
, current_buffer
);
722 /* We cannot allow after-change-functions be run
723 during decoding, because that might modify the
724 buffer, while we rely on process_coding.produced to
725 faithfully reflect inserted text until we
726 TEMP_SET_PT_BOTH below. */
727 specbind (Qinhibit_modification_hooks
, Qt
);
728 decode_coding_c_string (&process_coding
, buf
, nread
,
730 unbind_to (count1
, Qnil
);
731 if (display_on_the_fly
732 && CODING_REQUIRE_DETECTION (&saved_coding
)
733 && ! CODING_REQUIRE_DETECTION (&process_coding
))
735 /* We have detected some coding system. But,
736 there's a possibility that the detection was
737 done by insufficient data. So, we give up
738 displaying on the fly. */
739 if (process_coding
.produced
> 0)
740 del_range_2 (process_coding
.dst_pos
,
741 process_coding
.dst_pos_byte
,
742 process_coding
.dst_pos
743 + process_coding
.produced_char
,
744 process_coding
.dst_pos_byte
745 + process_coding
.produced
, 0);
746 display_on_the_fly
= 0;
747 process_coding
= saved_coding
;
749 /* This is to make the above condition always
750 fails in the future. */
751 saved_coding
.common_flags
752 &= ~CODING_REQUIRE_DETECTION_MASK
;
756 TEMP_SET_PT_BOTH (PT
+ process_coding
.produced_char
,
757 PT_BYTE
+ process_coding
.produced
);
758 carryover
= process_coding
.carryover_bytes
;
760 memcpy (buf
, process_coding
.carryover
,
761 process_coding
.carryover_bytes
);
765 if (process_coding
.mode
& CODING_MODE_LAST_BLOCK
)
768 /* Make the buffer bigger as we continue to read more data,
769 but not past CALLPROC_BUFFER_SIZE_MAX. */
770 if (bufsize
< CALLPROC_BUFFER_SIZE_MAX
&& total_read
> 32 * bufsize
)
771 if ((bufsize
*= 2) > CALLPROC_BUFFER_SIZE_MAX
)
772 bufsize
= CALLPROC_BUFFER_SIZE_MAX
;
777 prepare_menu_bars ();
779 redisplay_preserve_echo_area (1);
780 /* This variable might have been set to 0 for code
781 detection. In that case, we set it back to 1 because
782 we should have already detected a coding system. */
783 display_on_the_fly
= 1;
790 Vlast_coding_system_used
= CODING_ID_NAME (process_coding
.id
);
791 /* If the caller required, let the buffer inherit the
792 coding-system used to decode the process output. */
793 if (inherit_process_coding_system
)
794 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
795 make_number (total_read
));
799 /* Wait for it to terminate, unless it already has. */
800 wait_for_termination (pid
);
805 /* Don't kill any children that the subprocess may have left behind
807 call_process_exited
= 1;
809 unbind_to (count
, Qnil
);
811 if (synch_process_termsig
)
815 synchronize_system_messages_locale ();
816 signame
= strsignal (synch_process_termsig
);
821 synch_process_death
= signame
;
824 if (synch_process_death
)
825 return code_convert_string_norecord (build_string (synch_process_death
),
826 Vlocale_coding_system
, 0);
827 return make_number (synch_process_retcode
);
831 delete_temp_file (Lisp_Object name
)
833 /* Suppress jka-compr handling, etc. */
834 int count
= SPECPDL_INDEX ();
835 specbind (intern ("file-name-handler-alist"), Qnil
);
836 internal_delete_file (name
);
837 unbind_to (count
, Qnil
);
841 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
843 doc
: /* Send text from START to END to a synchronous process running PROGRAM.
844 The remaining arguments are optional.
845 Delete the text if fourth arg DELETE is non-nil.
847 Insert output in BUFFER before point; t means current buffer;
848 nil for BUFFER means discard it; 0 means discard and don't wait.
849 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
850 REAL-BUFFER says what to do with standard output, as above,
851 while STDERR-FILE says what to do with standard error in the child.
852 STDERR-FILE may be nil (discard standard error output),
853 t (mix it with ordinary output), or a file name string.
855 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
856 Remaining args are passed to PROGRAM at startup as command args.
858 If BUFFER is 0, `call-process-region' returns immediately with value nil.
859 Otherwise it waits for PROGRAM to terminate
860 and returns a numeric exit status or a signal description string.
861 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
863 usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
864 (int nargs
, register Lisp_Object
*args
)
867 Lisp_Object filename_string
;
868 register Lisp_Object start
, end
;
869 int count
= SPECPDL_INDEX ();
870 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
871 Lisp_Object coding_systems
;
872 Lisp_Object val
, *args2
;
875 Lisp_Object tmpdir
, pattern
;
877 if (STRINGP (Vtemporary_file_directory
))
878 tmpdir
= Vtemporary_file_directory
;
882 if (getenv ("TMPDIR"))
883 tmpdir
= build_string (getenv ("TMPDIR"));
885 tmpdir
= build_string ("/tmp/");
888 if ((outf
= egetenv ("TMPDIR"))
889 || (outf
= egetenv ("TMP"))
890 || (outf
= egetenv ("TEMP")))
891 tmpdir
= build_string (outf
);
893 tmpdir
= Ffile_name_as_directory (build_string ("c:/temp"));
897 pattern
= Fexpand_file_name (Vtemp_file_name_pattern
, tmpdir
);
898 tempfile
= (char *) alloca (SBYTES (pattern
) + 1);
899 memcpy (tempfile
, SDATA (pattern
), SBYTES (pattern
) + 1);
907 fd
= mkstemp (tempfile
);
910 report_file_error ("Failed to open temporary file",
911 Fcons (Vtemp_file_name_pattern
, Qnil
));
919 filename_string
= build_string (tempfile
);
920 GCPRO1 (filename_string
);
923 /* Decide coding-system of the contents of the temporary file. */
924 if (!NILP (Vcoding_system_for_write
))
925 val
= Vcoding_system_for_write
;
926 else if (NILP (current_buffer
->enable_multibyte_characters
))
930 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
931 args2
[0] = Qcall_process_region
;
932 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
933 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
934 if (CONSP (coding_systems
))
935 val
= XCDR (coding_systems
);
936 else if (CONSP (Vdefault_process_coding_system
))
937 val
= XCDR (Vdefault_process_coding_system
);
943 int count1
= SPECPDL_INDEX ();
945 specbind (intern ("coding-system-for-write"), val
);
946 /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
947 happen to get a ".Z" suffix. */
948 specbind (intern ("file-name-handler-alist"), Qnil
);
949 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
, Qnil
, Qnil
);
951 unbind_to (count1
, Qnil
);
954 /* Note that Fcall_process takes care of binding
955 coding-system-for-read. */
957 record_unwind_protect (delete_temp_file
, filename_string
);
959 if (nargs
> 3 && !NILP (args
[3]))
960 Fdelete_region (start
, end
);
972 args
[1] = filename_string
;
974 RETURN_UNGCPRO (unbind_to (count
, Fcall_process (nargs
, args
)));
978 static int relocate_fd (int fd
, int minfd
);
982 add_env (char **env
, char **new_env
, char *string
)
989 /* See if this string duplicates any string already in the env.
990 If so, don't put it in.
991 When an env var has multiple definitions,
992 we keep the definition that comes first in process-environment. */
993 for (ep
= env
; ok
&& ep
!= new_env
; ep
++)
995 char *p
= *ep
, *q
= string
;
1001 /* The string is a lone variable name; keep it for now, we
1002 will remove it later. It is a placeholder for a
1003 variable that is not to be included in the environment. */
1011 *new_env
++ = string
;
1015 /* This is the last thing run in a newly forked inferior
1016 either synchronous or asynchronous.
1017 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
1018 Initialize inferior's priority, pgrp, connected dir and environment.
1019 then exec another program based on new_argv.
1021 This function may change environ for the superior process.
1022 Therefore, the superior process must save and restore the value
1023 of environ around the vfork and the call to this function.
1025 SET_PGRP is nonzero if we should put the subprocess into a separate
1028 CURRENT_DIR is an elisp string giving the path of the current
1029 directory the subprocess should have. Since we can't really signal
1030 a decent error from within the child, this should be verified as an
1031 executable directory by the parent. */
1034 child_setup (int in
, int out
, int err
, register char **new_argv
, int set_pgrp
, Lisp_Object current_dir
)
1041 #endif /* WINDOWSNT */
1043 int pid
= getpid ();
1045 /* Close Emacs's descriptors that this process should not have. */
1046 close_process_descs ();
1048 /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
1049 we will lose if we call close_load_descs here. */
1051 close_load_descs ();
1054 /* Note that use of alloca is always safe here. It's obvious for systems
1055 that do not have true vfork or that have true (stack) alloca.
1056 If using vfork and C_ALLOCA (when Emacs used to include
1057 src/alloca.c) it is safe because that changes the superior's
1058 static variables as if the superior had done alloca and will be
1059 cleaned up in the usual way. */
1061 register char *temp
;
1064 i
= SBYTES (current_dir
);
1066 /* MSDOS must have all environment variables malloc'ed, because
1067 low-level libc functions that launch subsidiary processes rely
1069 pwd_var
= (char *) xmalloc (i
+ 6);
1071 pwd_var
= (char *) alloca (i
+ 6);
1074 memcpy (pwd_var
, "PWD=", 4);
1075 memcpy (temp
, SDATA (current_dir
), i
);
1076 if (!IS_DIRECTORY_SEP (temp
[i
- 1])) temp
[i
++] = DIRECTORY_SEP
;
1080 /* We can't signal an Elisp error here; we're in a vfork. Since
1081 the callers check the current directory before forking, this
1082 should only return an error if the directory's permissions
1083 are changed between the check and this chdir, but we should
1085 if (chdir (temp
) < 0)
1088 /* Get past the drive letter, so that d:/ is left alone. */
1089 if (i
> 2 && IS_DEVICE_SEP (temp
[1]) && IS_DIRECTORY_SEP (temp
[2]))
1096 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1097 while (i
> 2 && IS_DIRECTORY_SEP (temp
[i
- 1]))
1101 /* Set `env' to a vector of the strings in the environment. */
1103 register Lisp_Object tem
;
1104 register char **new_env
;
1106 register int new_length
;
1107 Lisp_Object display
= Qnil
;
1111 for (tem
= Vprocess_environment
;
1112 CONSP (tem
) && STRINGP (XCAR (tem
));
1115 if (strncmp (SDATA (XCAR (tem
)), "DISPLAY", 7) == 0
1116 && (SDATA (XCAR (tem
)) [7] == '\0'
1117 || SDATA (XCAR (tem
)) [7] == '='))
1118 /* DISPLAY is specified in process-environment. */
1123 /* If not provided yet, use the frame's DISPLAY. */
1126 Lisp_Object tmp
= Fframe_parameter (selected_frame
, Qdisplay
);
1127 if (!STRINGP (tmp
) && CONSP (Vinitial_environment
))
1128 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1129 tmp
= Fgetenv_internal (build_string ("DISPLAY"),
1130 Vinitial_environment
);
1138 /* new_length + 2 to include PWD and terminating 0. */
1139 env
= new_env
= (char **) alloca ((new_length
+ 2) * sizeof (char *));
1140 /* If we have a PWD envvar, pass one down,
1141 but with corrected value. */
1142 if (egetenv ("PWD"))
1143 *new_env
++ = pwd_var
;
1145 if (STRINGP (display
))
1147 int vlen
= strlen ("DISPLAY=") + strlen (SDATA (display
)) + 1;
1148 char *vdata
= (char *) alloca (vlen
);
1149 strcpy (vdata
, "DISPLAY=");
1150 strcat (vdata
, SDATA (display
));
1151 new_env
= add_env (env
, new_env
, vdata
);
1155 for (tem
= Vprocess_environment
;
1156 CONSP (tem
) && STRINGP (XCAR (tem
));
1158 new_env
= add_env (env
, new_env
, SDATA (XCAR (tem
)));
1162 /* Remove variable names without values. */
1166 while (*q
!= 0 && strchr (*q
, '=') == NULL
)
1176 prepare_standard_handles (in
, out
, err
, handles
);
1177 set_process_dir (SDATA (current_dir
));
1178 #else /* not WINDOWSNT */
1179 /* Make sure that in, out, and err are not actually already in
1180 descriptors zero, one, or two; this could happen if Emacs is
1181 started with its standard in, out, or error closed, as might
1184 int oin
= in
, oout
= out
;
1186 /* We have to avoid relocating the same descriptor twice! */
1188 in
= relocate_fd (in
, 3);
1193 out
= relocate_fd (out
, 3);
1197 else if (err
== oout
)
1200 err
= relocate_fd (err
, 3);
1214 if (err
!= in
&& err
!= out
)
1216 #endif /* not MSDOS */
1217 #endif /* not WINDOWSNT */
1220 #ifndef SETPGRP_RELEASES_CTTY
1221 setpgrp (); /* No arguments but equivalent in this case */
1228 pid
= run_msdos_command (new_argv
, pwd_var
+ 4, in
, out
, err
, env
);
1231 /* An error occurred while trying to run the subprocess. */
1232 report_file_error ("Spawning child process", Qnil
);
1234 #else /* not MSDOS */
1236 /* Spawn the child. (See ntproc.c:Spawnve). */
1237 cpid
= spawnve (_P_NOWAIT
, new_argv
[0], new_argv
, env
);
1238 reset_standard_handles (in
, out
, err
, handles
);
1240 /* An error occurred while trying to spawn the process. */
1241 report_file_error ("Spawning child process", Qnil
);
1243 #else /* not WINDOWSNT */
1244 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1245 EMACS_SET_TTY_PGRP (0, &pid
);
1247 /* execvp does not accept an environment arg so the only way
1248 to pass this environment is to set environ. Our caller
1249 is responsible for restoring the ambient value of environ. */
1251 execvp (new_argv
[0], new_argv
);
1253 emacs_write (1, "Can't exec program: ", 20);
1254 emacs_write (1, new_argv
[0], strlen (new_argv
[0]));
1255 emacs_write (1, "\n", 1);
1257 #endif /* not WINDOWSNT */
1258 #endif /* not MSDOS */
1262 /* Move the file descriptor FD so that its number is not less than MINFD.
1263 If the file descriptor is moved at all, the original is freed. */
1265 relocate_fd (int fd
, int minfd
)
1273 new = fcntl (fd
, F_DUPFD
, minfd
);
1277 /* Note that we hold the original FD open while we recurse,
1278 to guarantee we'll get a new FD if we need it. */
1279 new = relocate_fd (new, minfd
);
1283 const char *message1
= "Error while setting up child: ";
1284 const char *errmessage
= strerror (errno
);
1285 const char *message2
= "\n";
1286 emacs_write (2, message1
, strlen (message1
));
1287 emacs_write (2, errmessage
, strlen (errmessage
));
1288 emacs_write (2, message2
, strlen (message2
));
1295 #endif /* not WINDOWSNT */
1298 getenv_internal_1 (const char *var
, int varlen
, char **value
, int *valuelen
,
1301 for (; CONSP (env
); env
= XCDR (env
))
1303 Lisp_Object entry
= XCAR (env
);
1305 && SBYTES (entry
) >= varlen
1307 /* NT environment variables are case insensitive. */
1308 && ! strnicmp (SDATA (entry
), var
, varlen
)
1309 #else /* not WINDOWSNT */
1310 && ! memcmp (SDATA (entry
), var
, varlen
)
1311 #endif /* not WINDOWSNT */
1314 if (SBYTES (entry
) > varlen
&& SREF (entry
, varlen
) == '=')
1316 *value
= (char *) SDATA (entry
) + (varlen
+ 1);
1317 *valuelen
= SBYTES (entry
) - (varlen
+ 1);
1320 else if (SBYTES (entry
) == varlen
)
1322 /* Lone variable names in Vprocess_environment mean that
1323 variable should be removed from the environment. */
1333 getenv_internal (const char *var
, int varlen
, char **value
, int *valuelen
,
1336 /* Try to find VAR in Vprocess_environment first. */
1337 if (getenv_internal_1 (var
, varlen
, value
, valuelen
,
1338 Vprocess_environment
))
1339 return *value
? 1 : 0;
1341 /* For DISPLAY try to get the values from the frame or the initial env. */
1342 if (strcmp (var
, "DISPLAY") == 0)
1345 = Fframe_parameter (NILP (frame
) ? selected_frame
: frame
, Qdisplay
);
1346 if (STRINGP (display
))
1348 *value
= (char *) SDATA (display
);
1349 *valuelen
= SBYTES (display
);
1352 /* If still not found, Look for DISPLAY in Vinitial_environment. */
1353 if (getenv_internal_1 (var
, varlen
, value
, valuelen
,
1354 Vinitial_environment
))
1355 return *value
? 1 : 0;
1361 DEFUN ("getenv-internal", Fgetenv_internal
, Sgetenv_internal
, 1, 2, 0,
1362 doc
: /* Get the value of environment variable VARIABLE.
1363 VARIABLE should be a string. Value is nil if VARIABLE is undefined in
1364 the environment. Otherwise, value is a string.
1366 This function searches `process-environment' for VARIABLE.
1368 If optional parameter ENV is a list, then search this list instead of
1369 `process-environment', and return t when encountering a negative entry
1370 \(an entry for a variable with no value). */)
1371 (Lisp_Object variable
, Lisp_Object env
)
1376 CHECK_STRING (variable
);
1379 if (getenv_internal_1 (SDATA (variable
), SBYTES (variable
),
1380 &value
, &valuelen
, env
))
1381 return value
? make_string (value
, valuelen
) : Qt
;
1385 else if (getenv_internal (SDATA (variable
), SBYTES (variable
),
1386 &value
, &valuelen
, env
))
1387 return make_string (value
, valuelen
);
1392 /* A version of getenv that consults the Lisp environment lists,
1393 easily callable from C. */
1395 egetenv (const char *var
)
1400 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
, Qnil
))
1407 /* This is run before init_cmdargs. */
1410 init_callproc_1 (void)
1412 char *data_dir
= egetenv ("EMACSDATA");
1413 char *doc_dir
= egetenv ("EMACSDOC");
1416 = Ffile_name_as_directory (build_string (data_dir
? data_dir
1419 = Ffile_name_as_directory (build_string (doc_dir
? doc_dir
1422 /* Check the EMACSPATH environment variable, defaulting to the
1423 PATH_EXEC path from epaths.h. */
1424 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
1425 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
1426 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
1429 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1432 init_callproc (void)
1434 char *data_dir
= egetenv ("EMACSDATA");
1437 Lisp_Object tempdir
;
1439 if (!NILP (Vinstallation_directory
))
1441 /* Add to the path the lib-src subdir of the installation dir. */
1443 tem
= Fexpand_file_name (build_string ("lib-src"),
1444 Vinstallation_directory
);
1446 /* MSDOS uses wrapped binaries, so don't do this. */
1447 if (NILP (Fmember (tem
, Vexec_path
)))
1449 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
1450 Vexec_path
= Fcons (tem
, Vexec_path
);
1451 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
1454 Vexec_directory
= Ffile_name_as_directory (tem
);
1455 #endif /* not DOS_NT */
1457 /* Maybe use ../etc as well as ../lib-src. */
1460 tem
= Fexpand_file_name (build_string ("etc"),
1461 Vinstallation_directory
);
1462 Vdoc_directory
= Ffile_name_as_directory (tem
);
1466 /* Look for the files that should be in etc. We don't use
1467 Vinstallation_directory, because these files are never installed
1468 near the executable, and they are never in the build
1469 directory when that's different from the source directory.
1471 Instead, if these files are not in the nominal place, we try the
1472 source directory. */
1475 Lisp_Object tem
, tem1
, srcdir
;
1477 srcdir
= Fexpand_file_name (build_string ("../src/"),
1478 build_string (PATH_DUMPLOADSEARCH
));
1479 tem
= Fexpand_file_name (build_string ("GNU"), Vdata_directory
);
1480 tem1
= Ffile_exists_p (tem
);
1481 if (!NILP (Fequal (srcdir
, Vinvocation_directory
)) || NILP (tem1
))
1484 newdir
= Fexpand_file_name (build_string ("../etc/"),
1485 build_string (PATH_DUMPLOADSEARCH
));
1486 tem
= Fexpand_file_name (build_string ("GNU"), newdir
);
1487 tem1
= Ffile_exists_p (tem
);
1489 Vdata_directory
= newdir
;
1497 tempdir
= Fdirectory_file_name (Vexec_directory
);
1498 if (access (SDATA (tempdir
), 0) < 0)
1499 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1503 tempdir
= Fdirectory_file_name (Vdata_directory
);
1504 if (access (SDATA (tempdir
), 0) < 0)
1505 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1508 sh
= (char *) getenv ("SHELL");
1509 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
1512 Vshared_game_score_directory
= Qnil
;
1514 Vshared_game_score_directory
= build_string (PATH_GAME
);
1515 if (NILP (Ffile_directory_p (Vshared_game_score_directory
)))
1516 Vshared_game_score_directory
= Qnil
;
1521 set_initial_environment (void)
1523 register char **envp
;
1525 Vprocess_environment
= Qnil
;
1530 for (envp
= environ
; *envp
; envp
++)
1531 Vprocess_environment
= Fcons (build_string (*envp
),
1532 Vprocess_environment
);
1533 /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
1534 to use `delete' and friends on process-environment. */
1535 Vinitial_environment
= Fcopy_sequence (Vprocess_environment
);
1540 syms_of_callproc (void)
1543 Qbuffer_file_type
= intern ("buffer-file-type");
1544 staticpro (&Qbuffer_file_type
);
1548 Vtemp_file_name_pattern
= build_string ("emacsXXXXXX");
1549 #elif defined (WINDOWSNT)
1550 Vtemp_file_name_pattern
= build_string ("emXXXXXX");
1552 Vtemp_file_name_pattern
= build_string ("detmp.XXX");
1554 staticpro (&Vtemp_file_name_pattern
);
1556 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
1557 doc
: /* *File name to load inferior shells from.
1558 Initialized from the SHELL environment variable, or to a system-dependent
1559 default if SHELL is not set. */);
1561 DEFVAR_LISP ("exec-path", &Vexec_path
,
1562 doc
: /* *List of directories to search programs to run in subprocesses.
1563 Each element is a string (directory name) or nil (try default directory). */);
1565 DEFVAR_LISP ("exec-suffixes", &Vexec_suffixes
,
1566 doc
: /* *List of suffixes to try to find executable file names.
1567 Each element is a string. */);
1568 Vexec_suffixes
= Qnil
;
1570 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
1571 doc
: /* Directory for executables for Emacs to invoke.
1572 More generally, this includes any architecture-dependent files
1573 that are built and installed from the Emacs distribution. */);
1575 DEFVAR_LISP ("data-directory", &Vdata_directory
,
1576 doc
: /* Directory of machine-independent files that come with GNU Emacs.
1577 These are files intended for Emacs to use while it runs. */);
1579 DEFVAR_LISP ("doc-directory", &Vdoc_directory
,
1580 doc
: /* Directory containing the DOC file that comes with GNU Emacs.
1581 This is usually the same as `data-directory'. */);
1583 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
1584 doc
: /* For internal use by the build procedure only.
1585 This is the name of the directory in which the build procedure installed
1586 Emacs's info files; the default value for `Info-default-directory-list'
1588 Vconfigure_info_directory
= build_string (PATH_INFO
);
1590 DEFVAR_LISP ("shared-game-score-directory", &Vshared_game_score_directory
,
1591 doc
: /* Directory of score files for games which come with GNU Emacs.
1592 If this variable is nil, then Emacs is unable to use a shared directory. */);
1594 Vshared_game_score_directory
= Qnil
;
1596 Vshared_game_score_directory
= build_string (PATH_GAME
);
1599 DEFVAR_LISP ("initial-environment", &Vinitial_environment
,
1600 doc
: /* List of environment variables inherited from the parent process.
1601 Each element should be a string of the form ENVVARNAME=VALUE.
1602 The elements must normally be decoded (using `locale-coding-system') for use. */);
1603 Vinitial_environment
= Qnil
;
1605 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
1606 doc
: /* List of overridden environment variables for subprocesses to inherit.
1607 Each element should be a string of the form ENVVARNAME=VALUE.
1609 Entries in this list take precedence to those in the frame-local
1610 environments. Therefore, let-binding `process-environment' is an easy
1611 way to temporarily change the value of an environment variable,
1612 irrespective of where it comes from. To use `process-environment' to
1613 remove an environment variable, include only its name in the list,
1616 This variable is set to nil when Emacs starts.
1618 If multiple entries define the same variable, the first one always
1621 Non-ASCII characters are encoded according to the initial value of
1622 `locale-coding-system', i.e. the elements must normally be decoded for
1625 See `setenv' and `getenv'. */);
1626 Vprocess_environment
= Qnil
;
1628 defsubr (&Scall_process
);
1629 defsubr (&Sgetenv_internal
);
1630 defsubr (&Scall_process_region
);
1633 /* arch-tag: 769b8045-1df7-4d2b-8968-e3fb49017f95
1634 (do not change this comment) */