1 /* Synchronous subprocess invocation for GNU Emacs.
2 Copyright (C) 1985, 86,87,88,93,94,95, 1999 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
29 /* Define SIGCHLD as an alias for SIGCLD. */
31 #if !defined (SIGCHLD) && defined (SIGCLD)
32 #define SIGCHLD SIGCLD
35 #include <sys/types.h>
43 #define INCLUDED_FCNTL
50 #include <stdlib.h> /* for proper declaration of environ */
53 #define _P_NOWAIT 1 /* from process.h */
56 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
57 #define INCLUDED_FCNTL
60 #include <sys/param.h>
80 #include "syssignal.h"
88 extern noshare
char **environ
;
90 extern char **environ
;
94 #if !defined (USG) || defined (BSD_PGRPS)
95 #define setpgrp setpgid
99 #define max(a, b) ((a) > (b) ? (a) : (b))
101 Lisp_Object Vexec_path
, Vexec_directory
, Vdata_directory
, Vdoc_directory
;
102 Lisp_Object Vconfigure_info_directory
;
103 Lisp_Object Vtemp_file_name_pattern
;
105 Lisp_Object Vshell_file_name
;
107 Lisp_Object Vprocess_environment
;
110 Lisp_Object Qbuffer_file_type
;
113 /* True iff we are about to fork off a synchronous process or if we
114 are waiting for it. */
115 int synch_process_alive
;
117 /* Nonzero => this is a string explaining death of synchronous subprocess. */
118 char *synch_process_death
;
120 /* If synch_process_death is zero,
121 this is exit code of synchronous subprocess. */
122 int synch_process_retcode
;
124 extern Lisp_Object Vdoc_file_name
;
126 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
128 /* Clean up when exiting Fcall_process.
129 On MSDOS, delete the temporary file on any kind of termination.
130 On Unix, kill the process and any children on termination by signal. */
132 /* Nonzero if this is termination due to exit. */
133 static int call_process_exited
;
135 #ifndef VMS /* VMS version is in vmsproc.c. */
138 call_process_kill (fdpid
)
141 emacs_close (XFASTINT (Fcar (fdpid
)));
142 EMACS_KILLPG (XFASTINT (Fcdr (fdpid
)), SIGKILL
);
143 synch_process_alive
= 0;
148 call_process_cleanup (fdpid
)
151 #if defined (MSDOS) || defined (macintosh)
152 /* for MSDOS fdpid is really (fd . tempfile) */
153 register Lisp_Object file
;
155 emacs_close (XFASTINT (Fcar (fdpid
)));
156 if (strcmp (XSTRING (file
)-> data
, NULL_DEVICE
) != 0)
157 unlink (XSTRING (file
)->data
);
158 #else /* not MSDOS and not macintosh */
159 register int pid
= XFASTINT (Fcdr (fdpid
));
161 if (call_process_exited
)
163 emacs_close (XFASTINT (Fcar (fdpid
)));
167 if (EMACS_KILLPG (pid
, SIGINT
) == 0)
169 int count
= specpdl_ptr
- specpdl
;
170 record_unwind_protect (call_process_kill
, fdpid
);
171 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
174 wait_for_termination (pid
);
176 specpdl_ptr
= specpdl
+ count
; /* Discard the unwind protect. */
177 message1 ("Waiting for process to die...done");
179 synch_process_alive
= 0;
180 emacs_close (XFASTINT (Fcar (fdpid
)));
181 #endif /* not MSDOS */
185 DEFUN ("call-process", Fcall_process
, Scall_process
, 1, MANY
, 0,
186 "Call PROGRAM synchronously in separate process.\n\
187 The remaining arguments are optional.\n\
188 The program's input comes from file INFILE (nil means `/dev/null').\n\
189 Insert output in BUFFER before point; t means current buffer;\n\
190 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
191 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
192 REAL-BUFFER says what to do with standard output, as above,\n\
193 while STDERR-FILE says what to do with standard error in the child.\n\
194 STDERR-FILE may be nil (discard standard error output),\n\
195 t (mix it with ordinary output), or a file name string.\n\
197 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
198 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
200 If BUFFER is 0, `call-process' returns immediately with value nil.\n\
201 Otherwise it waits for PROGRAM to terminate\n\
202 and returns a numeric exit status or a signal description string.\n\
203 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
206 register Lisp_Object
*args
;
208 Lisp_Object infile
, buffer
, current_dir
, display
, path
;
215 int count
= specpdl_ptr
- specpdl
;
217 register unsigned char **new_argv
218 = (unsigned char **) alloca ((max (2, nargs
- 2)) * sizeof (char *));
219 struct buffer
*old
= current_buffer
;
220 /* File to use for stderr in the child.
221 t means use same as standard output. */
222 Lisp_Object error_file
;
223 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
224 char *outf
, *tempfile
;
234 struct coding_system process_coding
; /* coding-system of process output */
235 struct coding_system argument_coding
; /* coding-system of arguments */
236 /* Set to the return value of Ffind_operation_coding_system. */
237 Lisp_Object coding_systems
;
239 /* Qt denotes that Ffind_operation_coding_system is not yet called. */
242 CHECK_STRING (args
[0], 0);
247 /* Without asynchronous processes we cannot have BUFFER == 0. */
249 && (INTEGERP (CONSP (args
[2]) ? XCAR (args
[2]) : args
[2])))
250 error ("Operating system cannot handle asynchronous subprocesses");
251 #endif /* subprocesses */
253 /* Decide the coding-system for giving arguments. */
255 Lisp_Object val
, *args2
;
258 /* If arguments are supplied, we may have to encode them. */
263 for (i
= 4; i
< nargs
; i
++)
264 CHECK_STRING (args
[i
], i
);
266 for (i
= 4; i
< nargs
; i
++)
267 if (STRING_MULTIBYTE (args
[i
]))
270 if (!NILP (Vcoding_system_for_write
))
271 val
= Vcoding_system_for_write
;
272 else if (! must_encode
)
276 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
277 args2
[0] = Qcall_process
;
278 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
279 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
280 if (CONSP (coding_systems
))
281 val
= XCDR (coding_systems
);
282 else if (CONSP (Vdefault_process_coding_system
))
283 val
= XCDR (Vdefault_process_coding_system
);
287 setup_coding_system (Fcheck_coding_system (val
), &argument_coding
);
291 if (nargs
>= 2 && ! NILP (args
[1]))
293 infile
= Fexpand_file_name (args
[1], current_buffer
->directory
);
294 CHECK_STRING (infile
, 1);
297 infile
= build_string (NULL_DEVICE
);
303 /* If BUFFER is a list, its meaning is
304 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
307 if (CONSP (XCDR (buffer
)))
309 Lisp_Object stderr_file
;
310 stderr_file
= XCAR (XCDR (buffer
));
312 if (NILP (stderr_file
) || EQ (Qt
, stderr_file
))
313 error_file
= stderr_file
;
315 error_file
= Fexpand_file_name (stderr_file
, Qnil
);
318 buffer
= XCAR (buffer
);
321 if (!(EQ (buffer
, Qnil
)
323 || INTEGERP (buffer
)))
325 Lisp_Object spec_buffer
;
326 spec_buffer
= buffer
;
327 buffer
= Fget_buffer_create (buffer
);
328 /* Mention the buffer name for a better error message. */
330 CHECK_BUFFER (spec_buffer
, 2);
331 CHECK_BUFFER (buffer
, 2);
337 /* Make sure that the child will be able to chdir to the current
338 buffer's current directory, or its unhandled equivalent. We
339 can't just have the child check for an error when it does the
340 chdir, since it's in a vfork.
342 We have to GCPRO around this because Fexpand_file_name,
343 Funhandled_file_name_directory, and Ffile_accessible_directory_p
344 might call a file name handling function. The argument list is
345 protected by the caller, so all we really have to worry about is
348 struct gcpro gcpro1
, gcpro2
, gcpro3
;
350 current_dir
= current_buffer
->directory
;
352 GCPRO3 (infile
, buffer
, current_dir
);
355 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
357 if (NILP (Ffile_accessible_directory_p (current_dir
)))
358 report_file_error ("Setting current directory",
359 Fcons (current_buffer
->directory
, Qnil
));
364 display
= nargs
>= 4 ? args
[3] : Qnil
;
366 filefd
= emacs_open (XSTRING (infile
)->data
, O_RDONLY
, 0);
369 report_file_error ("Opening process input file", Fcons (infile
, Qnil
));
371 /* Search for program; barf if not found. */
375 GCPRO1 (current_dir
);
376 openp (Vexec_path
, args
[0], EXEC_SUFFIXES
, &path
, 1);
381 emacs_close (filefd
);
382 report_file_error ("Searching for program", Fcons (args
[0], Qnil
));
384 new_argv
[0] = XSTRING (path
)->data
;
388 struct gcpro gcpro1
, gcpro2
, gcpro3
;
390 GCPRO3 (infile
, buffer
, current_dir
);
391 argument_coding
.dst_multibyte
= 0;
392 for (i
= 4; i
< nargs
; i
++)
394 argument_coding
.src_multibyte
= STRING_MULTIBYTE (args
[i
]);
395 if (CODING_REQUIRE_ENCODING (&argument_coding
))
397 /* We must encode this argument. */
398 args
[i
] = encode_coding_string (args
[i
], &argument_coding
, 1);
399 if (argument_coding
.type
== coding_type_ccl
)
400 setup_ccl_program (&(argument_coding
.spec
.ccl
.encoder
), Qnil
);
402 new_argv
[i
- 3] = XSTRING (args
[i
])->data
;
405 new_argv
[nargs
- 3] = 0;
410 #ifdef MSDOS /* MW, July 1993 */
411 if ((outf
= egetenv ("TMPDIR")))
412 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
415 tempfile
= alloca (20);
418 dostounix_filename (tempfile
);
419 if (*tempfile
== '\0' || tempfile
[strlen (tempfile
) - 1] != '/')
420 strcat (tempfile
, "/");
421 strcat (tempfile
, "detmp.XXX");
424 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
427 emacs_close (filefd
);
428 report_file_error ("Opening process output file",
429 Fcons (build_string (tempfile
), Qnil
));
436 /* Since we don't have pipes on the Mac, create a temporary file to
437 hold the output of the subprocess. */
438 tempfile
= (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
439 bcopy (XSTRING (Vtemp_file_name_pattern
)->data
, tempfile
,
440 STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
444 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
448 report_file_error ("Opening process output file",
449 Fcons (build_string (tempfile
), Qnil
));
453 #endif /* macintosh */
455 if (INTEGERP (buffer
))
456 fd
[1] = emacs_open (NULL_DEVICE
, O_WRONLY
, 0), fd
[0] = -1;
465 /* Replaced by close_process_descs */
466 set_exclusive_use (fd
[0]);
471 /* child_setup must clobber environ in systems with true vfork.
472 Protect it from permanent change. */
473 register char **save_environ
= environ
;
474 register int fd1
= fd
[1];
477 #if 0 /* Some systems don't have sigblock. */
478 mask
= sigblock (sigmask (SIGCHLD
));
481 /* Record that we're about to create a synchronous process. */
482 synch_process_alive
= 1;
484 /* These vars record information from process termination.
485 Clear them now before process can possibly terminate,
486 to avoid timing error if process terminates soon. */
487 synch_process_death
= 0;
488 synch_process_retcode
= 0;
490 if (NILP (error_file
))
491 fd_error
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
492 else if (STRINGP (error_file
))
495 fd_error
= emacs_open (XSTRING (error_file
)->data
,
496 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
498 #else /* not DOS_NT */
499 fd_error
= creat (XSTRING (error_file
)->data
, 0666);
500 #endif /* not DOS_NT */
505 emacs_close (filefd
);
513 report_file_error ("Cannot redirect stderr",
514 Fcons ((NILP (error_file
)
515 ? build_string (NULL_DEVICE
) : error_file
),
519 current_dir
= ENCODE_FILE (current_dir
);
523 /* Call run_mac_command in sysdep.c here directly instead of doing
524 a child_setup as for MSDOS and other platforms. Note that this
525 code does not handle passing the environment to the synchronous
527 char *infn
, *outfn
, *errfn
, *currdn
;
529 /* close these files so subprocess can write to them */
531 if (fd_error
!= outfilefd
)
533 fd1
= -1; /* No harm in closing that one! */
535 infn
= XSTRING (infile
)->data
;
537 if (NILP (error_file
))
539 else if (EQ (Qt
, error_file
))
542 errfn
= XSTRING (error_file
)->data
;
543 currdn
= XSTRING (current_dir
)->data
;
544 pid
= run_mac_command (new_argv
, currdn
, infn
, outfn
, errfn
);
546 /* Record that the synchronous process exited and note its
547 termination status. */
548 synch_process_alive
= 0;
549 synch_process_retcode
= pid
;
550 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
552 synchronize_system_messages_locale ();
553 synch_process_death
= strerror (errno
);
556 /* Since CRLF is converted to LF within `decode_coding', we can
557 always open a file with binary mode. */
558 fd
[0] = open (tempfile
, O_BINARY
);
563 report_file_error ("Cannot re-open temporary file", Qnil
);
566 #else /* not macintosh */
567 #ifdef MSDOS /* MW, July 1993 */
568 /* Note that on MSDOS `child_setup' actually returns the child process
569 exit status, not its PID, so we assign it to `synch_process_retcode'
571 pid
= child_setup (filefd
, outfilefd
, fd_error
, (char **) new_argv
,
574 /* Record that the synchronous process exited and note its
575 termination status. */
576 synch_process_alive
= 0;
577 synch_process_retcode
= pid
;
578 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
580 synchronize_system_messages_locale ();
581 synch_process_death
= strerror (errno
);
584 emacs_close (outfilefd
);
585 if (fd_error
!= outfilefd
)
586 emacs_close (fd_error
);
587 fd1
= -1; /* No harm in closing that one! */
588 /* Since CRLF is converted to LF within `decode_coding', we can
589 always open a file with binary mode. */
590 fd
[0] = emacs_open (tempfile
, O_RDONLY
| O_BINARY
, 0);
594 emacs_close (filefd
);
595 report_file_error ("Cannot re-open temporary file", Qnil
);
597 #else /* not MSDOS */
599 pid
= child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
601 #else /* not WINDOWSNT */
611 #if defined (USG) && !defined (BSD_PGRPS)
616 child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
619 #endif /* not WINDOWSNT */
621 /* The MSDOS case did this already. */
623 emacs_close (fd_error
);
624 #endif /* not MSDOS */
625 #endif /* not macintosh */
627 environ
= save_environ
;
629 /* Close most of our fd's, but not fd[0]
630 since we will use that to read input from. */
631 emacs_close (filefd
);
632 if (fd1
>= 0 && fd1
!= fd_error
)
640 report_file_error ("Doing vfork", Qnil
);
643 if (INTEGERP (buffer
))
648 /* If Emacs has been built with asynchronous subprocess support,
649 we don't need to do this, I think because it will then have
650 the facilities for handling SIGCHLD. */
651 wait_without_blocking ();
652 #endif /* subprocesses */
656 /* Enable sending signal if user quits below. */
657 call_process_exited
= 0;
659 #if defined(MSDOS) || defined(macintosh)
660 /* MSDOS needs different cleanup information. */
661 record_unwind_protect (call_process_cleanup
,
662 Fcons (make_number (fd
[0]), build_string (tempfile
)));
664 record_unwind_protect (call_process_cleanup
,
665 Fcons (make_number (fd
[0]), make_number (pid
)));
666 #endif /* not MSDOS and not macintosh */
669 if (BUFFERP (buffer
))
670 Fset_buffer (buffer
);
674 /* If BUFFER is nil, we must read process output once and then
675 discard it, so setup coding system but with nil. */
676 setup_coding_system (Qnil
, &process_coding
);
680 Lisp_Object val
, *args2
;
683 if (!NILP (Vcoding_system_for_read
))
684 val
= Vcoding_system_for_read
;
687 if (EQ (coding_systems
, Qt
))
691 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
692 args2
[0] = Qcall_process
;
693 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
695 = Ffind_operation_coding_system (nargs
+ 1, args2
);
697 if (CONSP (coding_systems
))
698 val
= XCAR (coding_systems
);
699 else if (CONSP (Vdefault_process_coding_system
))
700 val
= XCAR (Vdefault_process_coding_system
);
704 setup_coding_system (Fcheck_coding_system (val
), &process_coding
);
705 /* In unibyte mode, character code conversion should not take
706 place but EOL conversion should. So, setup raw-text or one
707 of the subsidiary according to the information just setup. */
708 if (NILP (current_buffer
->enable_multibyte_characters
)
710 setup_raw_text_coding_system (&process_coding
);
712 process_coding
.src_multibyte
= 0;
713 process_coding
.dst_multibyte
715 ? ! NILP (XBUFFER (buffer
)->enable_multibyte_characters
)
716 : ! NILP (current_buffer
->enable_multibyte_characters
));
726 int display_on_the_fly
= !NILP (display
) && INTERACTIVE
;
727 struct coding_system saved_coding
;
729 saved_coding
= process_coding
;
733 /* Repeatedly read until we've filled as much as possible
734 of the buffer size we have. But don't read
735 less than 1024--save that for the next bufferful. */
737 while (nread
< bufsize
- 1024)
739 int this_read
= emacs_read (fd
[0], bufptr
+ nread
,
747 process_coding
.mode
|= CODING_MODE_LAST_BLOCK
;
752 total_read
+= this_read
;
754 if (display_on_the_fly
)
758 /* Now NREAD is the total amount of data in the buffer. */
763 if (! CODING_MAY_REQUIRE_DECODING (&process_coding
))
764 insert_1_both (bufptr
, nread
, nread
, 0, 1, 0);
766 { /* We have to decode the input. */
767 int size
= decoding_buffer_size (&process_coding
, nread
);
768 char *decoding_buf
= (char *) xmalloc (size
);
770 decode_coding (&process_coding
, bufptr
, decoding_buf
,
772 if (display_on_the_fly
773 && saved_coding
.type
== coding_type_undecided
774 && process_coding
.type
!= coding_type_undecided
)
776 /* We have detected some coding system. But,
777 there's a possibility that the detection was
778 done by insufficient data. So, we give up
779 displaying on the fly. */
780 xfree (decoding_buf
);
781 display_on_the_fly
= 0;
782 process_coding
= saved_coding
;
786 if (process_coding
.produced
> 0)
787 insert_1_both (decoding_buf
, process_coding
.produced_char
,
788 process_coding
.produced
, 0, 1, 0);
789 xfree (decoding_buf
);
790 carryover
= nread
- process_coding
.consumed
;
792 /* As CARRYOVER should not be that large, we had
793 better avoid overhead of bcopy. */
794 BCOPY_SHORT (bufptr
+ process_coding
.consumed
, bufptr
,
799 if (process_coding
.mode
& CODING_MODE_LAST_BLOCK
)
802 /* Make the buffer bigger as we continue to read more data,
804 if (bufsize
< 64 * 1024 && total_read
> 32 * bufsize
)
807 bufptr
= (char *) alloca (bufsize
);
810 if (!NILP (display
) && INTERACTIVE
)
813 prepare_menu_bars ();
815 redisplay_preserve_echo_area ();
822 Vlast_coding_system_used
= process_coding
.symbol
;
824 /* If the caller required, let the buffer inherit the
825 coding-system used to decode the process output. */
826 if (inherit_process_coding_system
)
827 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
828 make_number (total_read
));
831 /* Wait for it to terminate, unless it already has. */
832 wait_for_termination (pid
);
836 set_buffer_internal (old
);
838 /* Don't kill any children that the subprocess may have left behind
840 call_process_exited
= 1;
842 unbind_to (count
, Qnil
);
844 if (synch_process_death
)
845 return code_convert_string_norecord (build_string (synch_process_death
),
846 Vlocale_coding_system
, 0);
847 return make_number (synch_process_retcode
);
852 delete_temp_file (name
)
855 /* Use Fdelete_file (indirectly) because that runs a file name handler.
856 We did that when writing the file, so we should do so when deleting. */
857 internal_delete_file (name
);
860 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
862 "Send text from START to END to a synchronous process running PROGRAM.\n\
863 The remaining arguments are optional.\n\
864 Delete the text if fourth arg DELETE is non-nil.\n\
866 Insert output in BUFFER before point; t means current buffer;\n\
867 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
868 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
869 REAL-BUFFER says what to do with standard output, as above,\n\
870 while STDERR-FILE says what to do with standard error in the child.\n\
871 STDERR-FILE may be nil (discard standard error output),\n\
872 t (mix it with ordinary output), or a file name string.\n\
874 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
875 Remaining args are passed to PROGRAM at startup as command args.\n\
877 If BUFFER is nil, `call-process-region' returns immediately with value nil.\n\
878 Otherwise it waits for PROGRAM to terminate\n\
879 and returns a numeric exit status or a signal description string.\n\
880 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
883 register Lisp_Object
*args
;
886 Lisp_Object filename_string
;
887 register Lisp_Object start
, end
;
888 int count
= specpdl_ptr
- specpdl
;
889 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
890 Lisp_Object coding_systems
;
891 Lisp_Object val
, *args2
;
897 if ((outf
= egetenv ("TMPDIR"))
898 || (outf
= egetenv ("TMP"))
899 || (outf
= egetenv ("TEMP")))
900 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
903 tempfile
= alloca (20);
906 if (!IS_DIRECTORY_SEP (tempfile
[strlen (tempfile
) - 1]))
907 strcat (tempfile
, "/");
908 if ('/' == DIRECTORY_SEP
)
909 dostounix_filename (tempfile
);
911 unixtodos_filename (tempfile
);
913 strcat (tempfile
, "emXXXXXX");
915 strcat (tempfile
, "detmp.XXX");
917 #else /* not DOS_NT */
918 char *tempfile
= (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
919 bcopy (XSTRING (Vtemp_file_name_pattern
)->data
, tempfile
,
920 STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
921 #endif /* not DOS_NT */
927 filename_string
= build_string (tempfile
);
928 GCPRO1 (filename_string
);
931 /* Decide coding-system of the contents of the temporary file. */
932 if (!NILP (Vcoding_system_for_write
))
933 val
= Vcoding_system_for_write
;
934 else if (NILP (current_buffer
->enable_multibyte_characters
))
938 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
939 args2
[0] = Qcall_process_region
;
940 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
941 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
942 if (CONSP (coding_systems
))
943 val
= XCDR (coding_systems
);
944 else if (CONSP (Vdefault_process_coding_system
))
945 val
= XCDR (Vdefault_process_coding_system
);
951 int count1
= specpdl_ptr
- specpdl
;
953 specbind (intern ("coding-system-for-write"), val
);
954 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
, Qnil
, Qnil
);
956 unbind_to (count1
, Qnil
);
959 /* Note that Fcall_process takes care of binding
960 coding-system-for-read. */
962 record_unwind_protect (delete_temp_file
, filename_string
);
964 if (nargs
> 3 && !NILP (args
[3]))
965 Fdelete_region (start
, end
);
977 args
[1] = filename_string
;
979 RETURN_UNGCPRO (unbind_to (count
, Fcall_process (nargs
, args
)));
982 #ifndef VMS /* VMS version is in vmsproc.c. */
984 static int relocate_fd ();
986 /* This is the last thing run in a newly forked inferior
987 either synchronous or asynchronous.
988 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
989 Initialize inferior's priority, pgrp, connected dir and environment.
990 then exec another program based on new_argv.
992 This function may change environ for the superior process.
993 Therefore, the superior process must save and restore the value
994 of environ around the vfork and the call to this function.
996 SET_PGRP is nonzero if we should put the subprocess into a separate
999 CURRENT_DIR is an elisp string giving the path of the current
1000 directory the subprocess should have. Since we can't really signal
1001 a decent error from within the child, this should be verified as an
1002 executable directory by the parent. */
1005 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
1007 register char **new_argv
;
1009 Lisp_Object current_dir
;
1016 #endif /* WINDOWSNT */
1018 int pid
= getpid ();
1020 #ifdef SET_EMACS_PRIORITY
1022 extern int emacs_priority
;
1024 if (emacs_priority
< 0)
1025 nice (- emacs_priority
);
1030 /* Close Emacs's descriptors that this process should not have. */
1031 close_process_descs ();
1033 /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
1034 we will lose if we call close_load_descs here. */
1036 close_load_descs ();
1039 /* Note that use of alloca is always safe here. It's obvious for systems
1040 that do not have true vfork or that have true (stack) alloca.
1041 If using vfork and C_ALLOCA it is safe because that changes
1042 the superior's static variables as if the superior had done alloca
1043 and will be cleaned up in the usual way. */
1045 register char *temp
;
1048 i
= STRING_BYTES (XSTRING (current_dir
));
1049 pwd_var
= (char *) alloca (i
+ 6);
1051 bcopy ("PWD=", pwd_var
, 4);
1052 bcopy (XSTRING (current_dir
)->data
, temp
, i
);
1053 if (!IS_DIRECTORY_SEP (temp
[i
- 1])) temp
[i
++] = DIRECTORY_SEP
;
1057 /* We can't signal an Elisp error here; we're in a vfork. Since
1058 the callers check the current directory before forking, this
1059 should only return an error if the directory's permissions
1060 are changed between the check and this chdir, but we should
1062 if (chdir (temp
) < 0)
1067 /* Get past the drive letter, so that d:/ is left alone. */
1068 if (i
> 2 && IS_DEVICE_SEP (temp
[1]) && IS_DIRECTORY_SEP (temp
[2]))
1075 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1076 while (i
> 2 && IS_DIRECTORY_SEP (temp
[i
- 1]))
1080 /* Set `env' to a vector of the strings in Vprocess_environment. */
1082 register Lisp_Object tem
;
1083 register char **new_env
;
1084 register int new_length
;
1087 for (tem
= Vprocess_environment
;
1088 CONSP (tem
) && STRINGP (XCAR (tem
));
1092 /* new_length + 2 to include PWD and terminating 0. */
1093 env
= new_env
= (char **) alloca ((new_length
+ 2) * sizeof (char *));
1095 /* If we have a PWD envvar, pass one down,
1096 but with corrected value. */
1098 *new_env
++ = pwd_var
;
1100 /* Copy the Vprocess_environment strings into new_env. */
1101 for (tem
= Vprocess_environment
;
1102 CONSP (tem
) && STRINGP (XCAR (tem
));
1106 char *string
= (char *) XSTRING (XCAR (tem
))->data
;
1107 /* See if this string duplicates any string already in the env.
1108 If so, don't put it in.
1109 When an env var has multiple definitions,
1110 we keep the definition that comes first in process-environment. */
1111 for (; ep
!= new_env
; ep
++)
1113 char *p
= *ep
, *q
= string
;
1117 /* The string is malformed; might as well drop it. */
1126 *new_env
++ = string
;
1132 prepare_standard_handles (in
, out
, err
, handles
);
1133 set_process_dir (XSTRING (current_dir
)->data
);
1134 #else /* not WINDOWSNT */
1135 /* Make sure that in, out, and err are not actually already in
1136 descriptors zero, one, or two; this could happen if Emacs is
1137 started with its standard in, out, or error closed, as might
1140 int oin
= in
, oout
= out
;
1142 /* We have to avoid relocating the same descriptor twice! */
1144 in
= relocate_fd (in
, 3);
1149 out
= relocate_fd (out
, 3);
1153 else if (err
== oout
)
1156 err
= relocate_fd (err
, 3);
1170 #endif /* not MSDOS */
1171 #endif /* not WINDOWSNT */
1173 #if defined(USG) && !defined(BSD_PGRPS)
1174 #ifndef SETPGRP_RELEASES_CTTY
1175 setpgrp (); /* No arguments but equivalent in this case */
1180 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1181 EMACS_SET_TTY_PGRP (0, &pid
);
1184 something missing here
;
1188 pid
= run_msdos_command (new_argv
, pwd_var
+ 4, in
, out
, err
, env
);
1190 /* An error occurred while trying to run the subprocess. */
1191 report_file_error ("Spawning child process", Qnil
);
1193 #else /* not MSDOS */
1195 /* Spawn the child. (See ntproc.c:Spawnve). */
1196 cpid
= spawnve (_P_NOWAIT
, new_argv
[0], new_argv
, env
);
1197 reset_standard_handles (in
, out
, err
, handles
);
1199 /* An error occurred while trying to spawn the process. */
1200 report_file_error ("Spawning child process", Qnil
);
1202 #else /* not WINDOWSNT */
1203 /* execvp does not accept an environment arg so the only way
1204 to pass this environment is to set environ. Our caller
1205 is responsible for restoring the ambient value of environ. */
1207 execvp (new_argv
[0], new_argv
);
1209 emacs_write (1, "Can't exec program: ", 20);
1210 emacs_write (1, new_argv
[0], strlen (new_argv
[0]));
1211 emacs_write (1, "\n", 1);
1213 #endif /* not WINDOWSNT */
1214 #endif /* not MSDOS */
1217 /* Move the file descriptor FD so that its number is not less than MINFD.
1218 If the file descriptor is moved at all, the original is freed. */
1220 relocate_fd (fd
, minfd
)
1230 char *message1
= "Error while setting up child: ";
1231 char *errmessage
= strerror (errno
);
1232 char *message2
= "\n";
1233 emacs_write (2, message1
, strlen (message1
));
1234 emacs_write (2, errmessage
, strlen (errmessage
));
1235 emacs_write (2, message2
, strlen (message2
));
1238 /* Note that we hold the original FD open while we recurse,
1239 to guarantee we'll get a new FD if we need it. */
1240 new = relocate_fd (new, minfd
);
1247 getenv_internal (var
, varlen
, value
, valuelen
)
1255 for (scan
= Vprocess_environment
; CONSP (scan
); scan
= XCDR (scan
))
1259 entry
= XCAR (scan
);
1261 && STRING_BYTES (XSTRING (entry
)) > varlen
1262 && XSTRING (entry
)->data
[varlen
] == '='
1264 /* NT environment variables are case insensitive. */
1265 && ! strnicmp (XSTRING (entry
)->data
, var
, varlen
)
1266 #else /* not WINDOWSNT */
1267 && ! bcmp (XSTRING (entry
)->data
, var
, varlen
)
1268 #endif /* not WINDOWSNT */
1271 *value
= (char *) XSTRING (entry
)->data
+ (varlen
+ 1);
1272 *valuelen
= STRING_BYTES (XSTRING (entry
)) - (varlen
+ 1);
1280 DEFUN ("getenv-internal", Fgetenv_internal
, Sgetenv_internal
, 1, 1, 0,
1281 "Return the value of environment variable VAR, as a string.\n\
1282 VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
1283 This function consults the variable ``process-environment'' for its value.")
1290 CHECK_STRING (var
, 0);
1291 if (getenv_internal (XSTRING (var
)->data
, STRING_BYTES (XSTRING (var
)),
1293 return make_string (value
, valuelen
);
1298 /* A version of getenv that consults process_environment, easily
1307 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
))
1313 #endif /* not VMS */
1315 /* This is run before init_cmdargs. */
1320 char *data_dir
= egetenv ("EMACSDATA");
1321 char *doc_dir
= egetenv ("EMACSDOC");
1324 = Ffile_name_as_directory (build_string (data_dir
? data_dir
1327 = Ffile_name_as_directory (build_string (doc_dir
? doc_dir
1330 /* Check the EMACSPATH environment variable, defaulting to the
1331 PATH_EXEC path from epaths.h. */
1332 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
1333 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
1334 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
1337 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1342 char *data_dir
= egetenv ("EMACSDATA");
1345 Lisp_Object tempdir
;
1347 if (!NILP (Vinstallation_directory
))
1349 /* Add to the path the lib-src subdir of the installation dir. */
1351 tem
= Fexpand_file_name (build_string ("lib-src"),
1352 Vinstallation_directory
);
1354 /* MSDOS uses wrapped binaries, so don't do this. */
1355 if (NILP (Fmember (tem
, Vexec_path
)))
1356 Vexec_path
= nconc2 (Vexec_path
, Fcons (tem
, Qnil
));
1358 Vexec_directory
= Ffile_name_as_directory (tem
);
1359 #endif /* not DOS_NT */
1361 /* Maybe use ../etc as well as ../lib-src. */
1364 tem
= Fexpand_file_name (build_string ("etc"),
1365 Vinstallation_directory
);
1366 Vdoc_directory
= Ffile_name_as_directory (tem
);
1370 /* Look for the files that should be in etc. We don't use
1371 Vinstallation_directory, because these files are never installed
1372 near the executable, and they are never in the build
1373 directory when that's different from the source directory.
1375 Instead, if these files are not in the nominal place, we try the
1376 source directory. */
1379 Lisp_Object tem
, tem1
, newdir
;
1381 tem
= Fexpand_file_name (build_string ("GNU"), Vdata_directory
);
1382 tem1
= Ffile_exists_p (tem
);
1385 newdir
= Fexpand_file_name (build_string ("../etc/"),
1386 build_string (PATH_DUMPLOADSEARCH
));
1387 tem
= Fexpand_file_name (build_string ("GNU"), newdir
);
1388 tem1
= Ffile_exists_p (tem
);
1390 Vdata_directory
= newdir
;
1398 tempdir
= Fdirectory_file_name (Vexec_directory
);
1399 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1400 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1404 tempdir
= Fdirectory_file_name (Vdata_directory
);
1405 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1406 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1410 Vshell_file_name
= build_string ("*dcl*");
1412 sh
= (char *) getenv ("SHELL");
1413 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
1417 Vtemp_file_name_pattern
= build_string ("tmp:emacsXXXXXX.");
1419 if (getenv ("TMPDIR"))
1421 char *dir
= getenv ("TMPDIR");
1422 Vtemp_file_name_pattern
1423 = Fexpand_file_name (build_string ("emacsXXXXXX"),
1424 build_string (dir
));
1427 Vtemp_file_name_pattern
= build_string ("/tmp/emacsXXXXXX");
1432 set_process_environment ()
1434 register char **envp
;
1436 Vprocess_environment
= Qnil
;
1440 for (envp
= environ
; *envp
; envp
++)
1441 Vprocess_environment
= Fcons (build_string (*envp
),
1442 Vprocess_environment
);
1449 Qbuffer_file_type
= intern ("buffer-file-type");
1450 staticpro (&Qbuffer_file_type
);
1453 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
1454 "*File name to load inferior shells from.\n\
1455 Initialized from the SHELL environment variable.");
1457 DEFVAR_LISP ("exec-path", &Vexec_path
,
1458 "*List of directories to search programs to run in subprocesses.\n\
1459 Each element is a string (directory name) or nil (try default directory).");
1461 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
1462 "Directory for executables for Emacs to invoke.\n\
1463 More generally, this includes any architecture-dependent files\n\
1464 that are built and installed from the Emacs distribution.");
1466 DEFVAR_LISP ("data-directory", &Vdata_directory
,
1467 "Directory of machine-independent files that come with GNU Emacs.\n\
1468 These are files intended for Emacs to use while it runs.");
1470 DEFVAR_LISP ("doc-directory", &Vdoc_directory
,
1471 "Directory containing the DOC file that comes with GNU Emacs.\n\
1472 This is usually the same as data-directory.");
1474 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
1475 "For internal use by the build procedure only.\n\
1476 This is the name of the directory in which the build procedure installed\n\
1477 Emacs's info files; the default value for Info-default-directory-list\n\
1479 Vconfigure_info_directory
= build_string (PATH_INFO
);
1481 DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern
,
1482 "Pattern for making names for temporary files.\n\
1483 This is used by `call-process-region'.");
1484 /* This variable is initialized in init_callproc. */
1486 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
1487 "List of environment variables for subprocesses to inherit.\n\
1488 Each element should be a string of the form ENVVARNAME=VALUE.\n\
1489 The environment which Emacs inherits is placed in this variable\n\
1490 when Emacs starts.");
1493 defsubr (&Scall_process
);
1494 defsubr (&Sgetenv_internal
);
1496 defsubr (&Scall_process_region
);