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 #define setpgrp setpgid
97 #define max(a, b) ((a) > (b) ? (a) : (b))
99 Lisp_Object Vexec_path
, Vexec_directory
, Vdata_directory
, Vdoc_directory
;
100 Lisp_Object Vconfigure_info_directory
;
101 Lisp_Object Vtemp_file_name_pattern
;
103 Lisp_Object Vshell_file_name
;
105 Lisp_Object Vprocess_environment
;
108 Lisp_Object Qbuffer_file_type
;
111 /* True iff we are about to fork off a synchronous process or if we
112 are waiting for it. */
113 int synch_process_alive
;
115 /* Nonzero => this is a string explaining death of synchronous subprocess. */
116 char *synch_process_death
;
118 /* If synch_process_death is zero,
119 this is exit code of synchronous subprocess. */
120 int synch_process_retcode
;
122 extern Lisp_Object Vdoc_file_name
;
124 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
126 /* Clean up when exiting Fcall_process.
127 On MSDOS, delete the temporary file on any kind of termination.
128 On Unix, kill the process and any children on termination by signal. */
130 /* Nonzero if this is termination due to exit. */
131 static int call_process_exited
;
133 #ifndef VMS /* VMS version is in vmsproc.c. */
136 call_process_kill (fdpid
)
139 emacs_close (XFASTINT (Fcar (fdpid
)));
140 EMACS_KILLPG (XFASTINT (Fcdr (fdpid
)), SIGKILL
);
141 synch_process_alive
= 0;
146 call_process_cleanup (fdpid
)
149 #if defined (MSDOS) || defined (macintosh)
150 /* for MSDOS fdpid is really (fd . tempfile) */
151 register Lisp_Object file
;
153 emacs_close (XFASTINT (Fcar (fdpid
)));
154 if (strcmp (XSTRING (file
)-> data
, NULL_DEVICE
) != 0)
155 unlink (XSTRING (file
)->data
);
156 #else /* not MSDOS and not macintosh */
157 register int 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_ptr
- specpdl
;
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 "Call PROGRAM synchronously in separate process.\n\
185 The remaining arguments are optional.\n\
186 The program's input comes from file INFILE (nil means `/dev/null').\n\
187 Insert output in BUFFER before point; t means current buffer;\n\
188 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
189 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
190 REAL-BUFFER says what to do with standard output, as above,\n\
191 while STDERR-FILE says what to do with standard error in the child.\n\
192 STDERR-FILE may be nil (discard standard error output),\n\
193 t (mix it with ordinary output), or a file name string.\n\
195 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
196 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
198 If BUFFER is 0, `call-process' returns immediately with value nil.\n\
199 Otherwise it waits for PROGRAM to terminate\n\
200 and returns a numeric exit status or a signal description string.\n\
201 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
204 register Lisp_Object
*args
;
206 Lisp_Object infile
, buffer
, current_dir
, display
, path
;
213 int count
= specpdl_ptr
- specpdl
;
215 register unsigned char **new_argv
216 = (unsigned char **) alloca ((max (2, nargs
- 2)) * sizeof (char *));
217 struct buffer
*old
= current_buffer
;
218 /* File to use for stderr in the child.
219 t means use same as standard output. */
220 Lisp_Object error_file
;
221 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
222 char *outf
, *tempfile
;
232 struct coding_system process_coding
; /* coding-system of process output */
233 struct coding_system argument_coding
; /* coding-system of arguments */
234 /* Set to the return value of Ffind_operation_coding_system. */
235 Lisp_Object coding_systems
;
237 /* Qt denotes that Ffind_operation_coding_system is not yet called. */
240 CHECK_STRING (args
[0], 0);
245 /* Without asynchronous processes we cannot have BUFFER == 0. */
247 && (INTEGERP (CONSP (args
[2]) ? XCAR (args
[2]) : args
[2])))
248 error ("Operating system cannot handle asynchronous subprocesses");
249 #endif /* subprocesses */
251 /* Decide the coding-system for giving arguments. */
253 Lisp_Object val
, *args2
;
256 /* If arguments are supplied, we may have to encode them. */
261 for (i
= 4; i
< nargs
; i
++)
262 CHECK_STRING (args
[i
], i
);
264 for (i
= 4; i
< nargs
; i
++)
265 if (STRING_MULTIBYTE (args
[i
]))
268 if (!NILP (Vcoding_system_for_write
))
269 val
= Vcoding_system_for_write
;
270 else if (! must_encode
)
274 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
275 args2
[0] = Qcall_process
;
276 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
277 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
278 if (CONSP (coding_systems
))
279 val
= XCDR (coding_systems
);
280 else if (CONSP (Vdefault_process_coding_system
))
281 val
= XCDR (Vdefault_process_coding_system
);
285 setup_coding_system (Fcheck_coding_system (val
), &argument_coding
);
289 if (nargs
>= 2 && ! NILP (args
[1]))
291 infile
= Fexpand_file_name (args
[1], current_buffer
->directory
);
292 CHECK_STRING (infile
, 1);
295 infile
= build_string (NULL_DEVICE
);
301 /* If BUFFER is a list, its meaning is
302 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
305 if (CONSP (XCDR (buffer
)))
307 Lisp_Object stderr_file
;
308 stderr_file
= XCAR (XCDR (buffer
));
310 if (NILP (stderr_file
) || EQ (Qt
, stderr_file
))
311 error_file
= stderr_file
;
313 error_file
= Fexpand_file_name (stderr_file
, Qnil
);
316 buffer
= XCAR (buffer
);
319 if (!(EQ (buffer
, Qnil
)
321 || INTEGERP (buffer
)))
323 Lisp_Object spec_buffer
;
324 spec_buffer
= buffer
;
325 buffer
= Fget_buffer_create (buffer
);
326 /* Mention the buffer name for a better error message. */
328 CHECK_BUFFER (spec_buffer
, 2);
329 CHECK_BUFFER (buffer
, 2);
335 /* Make sure that the child will be able to chdir to the current
336 buffer's current directory, or its unhandled equivalent. We
337 can't just have the child check for an error when it does the
338 chdir, since it's in a vfork.
340 We have to GCPRO around this because Fexpand_file_name,
341 Funhandled_file_name_directory, and Ffile_accessible_directory_p
342 might call a file name handling function. The argument list is
343 protected by the caller, so all we really have to worry about is
346 struct gcpro gcpro1
, gcpro2
, gcpro3
;
348 current_dir
= current_buffer
->directory
;
350 GCPRO3 (infile
, buffer
, current_dir
);
353 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
355 if (NILP (Ffile_accessible_directory_p (current_dir
)))
356 report_file_error ("Setting current directory",
357 Fcons (current_buffer
->directory
, Qnil
));
362 display
= nargs
>= 4 ? args
[3] : Qnil
;
364 filefd
= emacs_open (XSTRING (infile
)->data
, O_RDONLY
, 0);
367 report_file_error ("Opening process input file", Fcons (infile
, Qnil
));
369 /* Search for program; barf if not found. */
373 GCPRO1 (current_dir
);
374 openp (Vexec_path
, args
[0], EXEC_SUFFIXES
, &path
, 1);
379 emacs_close (filefd
);
380 report_file_error ("Searching for program", Fcons (args
[0], Qnil
));
382 new_argv
[0] = XSTRING (path
)->data
;
386 struct gcpro gcpro1
, gcpro2
, gcpro3
;
388 GCPRO3 (infile
, buffer
, current_dir
);
389 argument_coding
.dst_multibyte
= 0;
390 for (i
= 4; i
< nargs
; i
++)
392 argument_coding
.src_multibyte
= STRING_MULTIBYTE (args
[i
]);
393 if (CODING_REQUIRE_ENCODING (&argument_coding
))
395 /* We must encode this argument. */
396 args
[i
] = encode_coding_string (args
[i
], &argument_coding
, 1);
397 if (argument_coding
.type
== coding_type_ccl
)
398 setup_ccl_program (&(argument_coding
.spec
.ccl
.encoder
), Qnil
);
400 new_argv
[i
- 3] = XSTRING (args
[i
])->data
;
403 new_argv
[nargs
- 3] = 0;
408 #ifdef MSDOS /* MW, July 1993 */
409 if ((outf
= egetenv ("TMPDIR")))
410 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
413 tempfile
= alloca (20);
416 dostounix_filename (tempfile
);
417 if (*tempfile
== '\0' || tempfile
[strlen (tempfile
) - 1] != '/')
418 strcat (tempfile
, "/");
419 strcat (tempfile
, "detmp.XXX");
422 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
425 emacs_close (filefd
);
426 report_file_error ("Opening process output file",
427 Fcons (build_string (tempfile
), Qnil
));
434 /* Since we don't have pipes on the Mac, create a temporary file to
435 hold the output of the subprocess. */
436 tempfile
= (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
437 bcopy (XSTRING (Vtemp_file_name_pattern
)->data
, tempfile
,
438 STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
442 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
446 report_file_error ("Opening process output file",
447 Fcons (build_string (tempfile
), Qnil
));
451 #endif /* macintosh */
453 if (INTEGERP (buffer
))
454 fd
[1] = emacs_open (NULL_DEVICE
, O_WRONLY
, 0), fd
[0] = -1;
463 /* Replaced by close_process_descs */
464 set_exclusive_use (fd
[0]);
469 /* child_setup must clobber environ in systems with true vfork.
470 Protect it from permanent change. */
471 register char **save_environ
= environ
;
472 register int fd1
= fd
[1];
475 #if 0 /* Some systems don't have sigblock. */
476 mask
= sigblock (sigmask (SIGCHLD
));
479 /* Record that we're about to create a synchronous process. */
480 synch_process_alive
= 1;
482 /* These vars record information from process termination.
483 Clear them now before process can possibly terminate,
484 to avoid timing error if process terminates soon. */
485 synch_process_death
= 0;
486 synch_process_retcode
= 0;
488 if (NILP (error_file
))
489 fd_error
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
490 else if (STRINGP (error_file
))
493 fd_error
= emacs_open (XSTRING (error_file
)->data
,
494 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
496 #else /* not DOS_NT */
497 fd_error
= creat (XSTRING (error_file
)->data
, 0666);
498 #endif /* not DOS_NT */
503 emacs_close (filefd
);
511 report_file_error ("Cannot redirect stderr",
512 Fcons ((NILP (error_file
)
513 ? build_string (NULL_DEVICE
) : error_file
),
517 current_dir
= ENCODE_FILE (current_dir
);
521 /* Call run_mac_command in sysdep.c here directly instead of doing
522 a child_setup as for MSDOS and other platforms. Note that this
523 code does not handle passing the environment to the synchronous
525 char *infn
, *outfn
, *errfn
, *currdn
;
527 /* close these files so subprocess can write to them */
529 if (fd_error
!= outfilefd
)
531 fd1
= -1; /* No harm in closing that one! */
533 infn
= XSTRING (infile
)->data
;
535 if (NILP (error_file
))
537 else if (EQ (Qt
, error_file
))
540 errfn
= XSTRING (error_file
)->data
;
541 currdn
= XSTRING (current_dir
)->data
;
542 pid
= run_mac_command (new_argv
, currdn
, infn
, outfn
, errfn
);
544 /* Record that the synchronous process exited and note its
545 termination status. */
546 synch_process_alive
= 0;
547 synch_process_retcode
= pid
;
548 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
550 synchronize_system_messages_locale ();
551 synch_process_death
= strerror (errno
);
554 /* Since CRLF is converted to LF within `decode_coding', we can
555 always open a file with binary mode. */
556 fd
[0] = open (tempfile
, O_BINARY
);
561 report_file_error ("Cannot re-open temporary file", Qnil
);
564 #else /* not macintosh */
565 #ifdef MSDOS /* MW, July 1993 */
566 /* Note that on MSDOS `child_setup' actually returns the child process
567 exit status, not its PID, so we assign it to `synch_process_retcode'
569 pid
= child_setup (filefd
, outfilefd
, fd_error
, (char **) new_argv
,
572 /* Record that the synchronous process exited and note its
573 termination status. */
574 synch_process_alive
= 0;
575 synch_process_retcode
= pid
;
576 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
578 synchronize_system_messages_locale ();
579 synch_process_death
= strerror (errno
);
582 emacs_close (outfilefd
);
583 if (fd_error
!= outfilefd
)
584 emacs_close (fd_error
);
585 fd1
= -1; /* No harm in closing that one! */
586 /* Since CRLF is converted to LF within `decode_coding', we can
587 always open a file with binary mode. */
588 fd
[0] = emacs_open (tempfile
, O_RDONLY
| O_BINARY
, 0);
592 emacs_close (filefd
);
593 report_file_error ("Cannot re-open temporary file", Qnil
);
595 #else /* not MSDOS */
597 pid
= child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
599 #else /* not WINDOWSNT */
609 #if defined (USG) && !defined (BSD_PGRPS)
614 child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
617 #endif /* not WINDOWSNT */
619 /* The MSDOS case did this already. */
621 emacs_close (fd_error
);
622 #endif /* not MSDOS */
623 #endif /* not macintosh */
625 environ
= save_environ
;
627 /* Close most of our fd's, but not fd[0]
628 since we will use that to read input from. */
629 emacs_close (filefd
);
630 if (fd1
>= 0 && fd1
!= fd_error
)
638 report_file_error ("Doing vfork", Qnil
);
641 if (INTEGERP (buffer
))
646 /* If Emacs has been built with asynchronous subprocess support,
647 we don't need to do this, I think because it will then have
648 the facilities for handling SIGCHLD. */
649 wait_without_blocking ();
650 #endif /* subprocesses */
654 /* Enable sending signal if user quits below. */
655 call_process_exited
= 0;
657 #if defined(MSDOS) || defined(macintosh)
658 /* MSDOS needs different cleanup information. */
659 record_unwind_protect (call_process_cleanup
,
660 Fcons (make_number (fd
[0]), build_string (tempfile
)));
662 record_unwind_protect (call_process_cleanup
,
663 Fcons (make_number (fd
[0]), make_number (pid
)));
664 #endif /* not MSDOS and not macintosh */
667 if (BUFFERP (buffer
))
668 Fset_buffer (buffer
);
672 /* If BUFFER is nil, we must read process output once and then
673 discard it, so setup coding system but with nil. */
674 setup_coding_system (Qnil
, &process_coding
);
678 Lisp_Object val
, *args2
;
681 if (!NILP (Vcoding_system_for_read
))
682 val
= Vcoding_system_for_read
;
685 if (EQ (coding_systems
, Qt
))
689 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
690 args2
[0] = Qcall_process
;
691 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
693 = Ffind_operation_coding_system (nargs
+ 1, args2
);
695 if (CONSP (coding_systems
))
696 val
= XCAR (coding_systems
);
697 else if (CONSP (Vdefault_process_coding_system
))
698 val
= XCAR (Vdefault_process_coding_system
);
702 setup_coding_system (Fcheck_coding_system (val
), &process_coding
);
703 /* In unibyte mode, character code conversion should not take
704 place but EOL conversion should. So, setup raw-text or one
705 of the subsidiary according to the information just setup. */
706 if (NILP (current_buffer
->enable_multibyte_characters
)
708 setup_raw_text_coding_system (&process_coding
);
710 process_coding
.src_multibyte
= 0;
711 process_coding
.dst_multibyte
713 ? ! NILP (XBUFFER (buffer
)->enable_multibyte_characters
)
714 : ! NILP (current_buffer
->enable_multibyte_characters
));
724 int display_on_the_fly
= !NILP (display
) && INTERACTIVE
;
725 struct coding_system saved_coding
;
727 saved_coding
= process_coding
;
731 /* Repeatedly read until we've filled as much as possible
732 of the buffer size we have. But don't read
733 less than 1024--save that for the next bufferful. */
735 while (nread
< bufsize
- 1024)
737 int this_read
= emacs_read (fd
[0], bufptr
+ nread
,
745 process_coding
.mode
|= CODING_MODE_LAST_BLOCK
;
750 total_read
+= this_read
;
752 if (display_on_the_fly
)
756 /* Now NREAD is the total amount of data in the buffer. */
761 if (! CODING_MAY_REQUIRE_DECODING (&process_coding
))
762 insert_1_both (bufptr
, nread
, nread
, 0, 1, 0);
764 { /* We have to decode the input. */
765 int size
= decoding_buffer_size (&process_coding
, nread
);
766 char *decoding_buf
= (char *) xmalloc (size
);
768 decode_coding (&process_coding
, bufptr
, decoding_buf
,
770 if (display_on_the_fly
771 && saved_coding
.type
== coding_type_undecided
772 && process_coding
.type
!= coding_type_undecided
)
774 /* We have detected some coding system. But,
775 there's a possibility that the detection was
776 done by insufficient data. So, we give up
777 displaying on the fly. */
778 xfree (decoding_buf
);
779 display_on_the_fly
= 0;
780 process_coding
= saved_coding
;
784 if (process_coding
.produced
> 0)
785 insert_1_both (decoding_buf
, process_coding
.produced_char
,
786 process_coding
.produced
, 0, 1, 0);
787 xfree (decoding_buf
);
788 carryover
= nread
- process_coding
.consumed
;
790 /* As CARRYOVER should not be that large, we had
791 better avoid overhead of bcopy. */
792 BCOPY_SHORT (bufptr
+ process_coding
.consumed
, bufptr
,
797 if (process_coding
.mode
& CODING_MODE_LAST_BLOCK
)
800 /* Make the buffer bigger as we continue to read more data,
802 if (bufsize
< 64 * 1024 && total_read
> 32 * bufsize
)
805 bufptr
= (char *) alloca (bufsize
);
808 if (!NILP (display
) && INTERACTIVE
)
811 prepare_menu_bars ();
813 redisplay_preserve_echo_area ();
820 Vlast_coding_system_used
= process_coding
.symbol
;
822 /* If the caller required, let the buffer inherit the
823 coding-system used to decode the process output. */
824 if (inherit_process_coding_system
)
825 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
826 make_number (total_read
));
829 /* Wait for it to terminate, unless it already has. */
830 wait_for_termination (pid
);
834 set_buffer_internal (old
);
836 /* Don't kill any children that the subprocess may have left behind
838 call_process_exited
= 1;
840 unbind_to (count
, Qnil
);
842 if (synch_process_death
)
843 return code_convert_string_norecord (build_string (synch_process_death
),
844 Vlocale_coding_system
, 0);
845 return make_number (synch_process_retcode
);
850 delete_temp_file (name
)
853 /* Use Fdelete_file (indirectly) because that runs a file name handler.
854 We did that when writing the file, so we should do so when deleting. */
855 internal_delete_file (name
);
858 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
860 "Send text from START to END to a synchronous process running PROGRAM.\n\
861 The remaining arguments are optional.\n\
862 Delete the text if fourth arg DELETE is non-nil.\n\
864 Insert output in BUFFER before point; t means current buffer;\n\
865 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
866 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
867 REAL-BUFFER says what to do with standard output, as above,\n\
868 while STDERR-FILE says what to do with standard error in the child.\n\
869 STDERR-FILE may be nil (discard standard error output),\n\
870 t (mix it with ordinary output), or a file name string.\n\
872 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
873 Remaining args are passed to PROGRAM at startup as command args.\n\
875 If BUFFER is nil, `call-process-region' returns immediately with value nil.\n\
876 Otherwise it waits for PROGRAM to terminate\n\
877 and returns a numeric exit status or a signal description string.\n\
878 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
881 register Lisp_Object
*args
;
884 Lisp_Object filename_string
;
885 register Lisp_Object start
, end
;
886 int count
= specpdl_ptr
- specpdl
;
887 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
888 Lisp_Object coding_systems
;
889 Lisp_Object val
, *args2
;
895 if ((outf
= egetenv ("TMPDIR"))
896 || (outf
= egetenv ("TMP"))
897 || (outf
= egetenv ("TEMP")))
898 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
901 tempfile
= alloca (20);
904 if (!IS_DIRECTORY_SEP (tempfile
[strlen (tempfile
) - 1]))
905 strcat (tempfile
, "/");
906 if ('/' == DIRECTORY_SEP
)
907 dostounix_filename (tempfile
);
909 unixtodos_filename (tempfile
);
911 strcat (tempfile
, "emXXXXXX");
913 strcat (tempfile
, "detmp.XXX");
915 #else /* not DOS_NT */
916 char *tempfile
= (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
917 bcopy (XSTRING (Vtemp_file_name_pattern
)->data
, tempfile
,
918 STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
919 #endif /* not DOS_NT */
925 filename_string
= build_string (tempfile
);
926 GCPRO1 (filename_string
);
929 /* Decide coding-system of the contents of the temporary file. */
930 if (!NILP (Vcoding_system_for_write
))
931 val
= Vcoding_system_for_write
;
932 else if (NILP (current_buffer
->enable_multibyte_characters
))
936 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
937 args2
[0] = Qcall_process_region
;
938 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
939 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
940 if (CONSP (coding_systems
))
941 val
= XCDR (coding_systems
);
942 else if (CONSP (Vdefault_process_coding_system
))
943 val
= XCDR (Vdefault_process_coding_system
);
949 int count1
= specpdl_ptr
- specpdl
;
951 specbind (intern ("coding-system-for-write"), val
);
952 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
, Qnil
, Qnil
);
954 unbind_to (count1
, Qnil
);
957 /* Note that Fcall_process takes care of binding
958 coding-system-for-read. */
960 record_unwind_protect (delete_temp_file
, filename_string
);
962 if (nargs
> 3 && !NILP (args
[3]))
963 Fdelete_region (start
, end
);
975 args
[1] = filename_string
;
977 RETURN_UNGCPRO (unbind_to (count
, Fcall_process (nargs
, args
)));
980 #ifndef VMS /* VMS version is in vmsproc.c. */
982 static int relocate_fd ();
984 /* This is the last thing run in a newly forked inferior
985 either synchronous or asynchronous.
986 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
987 Initialize inferior's priority, pgrp, connected dir and environment.
988 then exec another program based on new_argv.
990 This function may change environ for the superior process.
991 Therefore, the superior process must save and restore the value
992 of environ around the vfork and the call to this function.
994 SET_PGRP is nonzero if we should put the subprocess into a separate
997 CURRENT_DIR is an elisp string giving the path of the current
998 directory the subprocess should have. Since we can't really signal
999 a decent error from within the child, this should be verified as an
1000 executable directory by the parent. */
1003 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
1005 register char **new_argv
;
1007 Lisp_Object current_dir
;
1014 #endif /* WINDOWSNT */
1016 int pid
= getpid ();
1018 #ifdef SET_EMACS_PRIORITY
1020 extern int emacs_priority
;
1022 if (emacs_priority
< 0)
1023 nice (- emacs_priority
);
1028 /* Close Emacs's descriptors that this process should not have. */
1029 close_process_descs ();
1031 /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
1032 we will lose if we call close_load_descs here. */
1034 close_load_descs ();
1037 /* Note that use of alloca is always safe here. It's obvious for systems
1038 that do not have true vfork or that have true (stack) alloca.
1039 If using vfork and C_ALLOCA it is safe because that changes
1040 the superior's static variables as if the superior had done alloca
1041 and will be cleaned up in the usual way. */
1043 register char *temp
;
1046 i
= STRING_BYTES (XSTRING (current_dir
));
1047 pwd_var
= (char *) alloca (i
+ 6);
1049 bcopy ("PWD=", pwd_var
, 4);
1050 bcopy (XSTRING (current_dir
)->data
, temp
, i
);
1051 if (!IS_DIRECTORY_SEP (temp
[i
- 1])) temp
[i
++] = DIRECTORY_SEP
;
1055 /* We can't signal an Elisp error here; we're in a vfork. Since
1056 the callers check the current directory before forking, this
1057 should only return an error if the directory's permissions
1058 are changed between the check and this chdir, but we should
1060 if (chdir (temp
) < 0)
1065 /* Get past the drive letter, so that d:/ is left alone. */
1066 if (i
> 2 && IS_DEVICE_SEP (temp
[1]) && IS_DIRECTORY_SEP (temp
[2]))
1073 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1074 while (i
> 2 && IS_DIRECTORY_SEP (temp
[i
- 1]))
1078 /* Set `env' to a vector of the strings in Vprocess_environment. */
1080 register Lisp_Object tem
;
1081 register char **new_env
;
1082 register int new_length
;
1085 for (tem
= Vprocess_environment
;
1086 CONSP (tem
) && STRINGP (XCAR (tem
));
1090 /* new_length + 2 to include PWD and terminating 0. */
1091 env
= new_env
= (char **) alloca ((new_length
+ 2) * sizeof (char *));
1093 /* If we have a PWD envvar, pass one down,
1094 but with corrected value. */
1096 *new_env
++ = pwd_var
;
1098 /* Copy the Vprocess_environment strings into new_env. */
1099 for (tem
= Vprocess_environment
;
1100 CONSP (tem
) && STRINGP (XCAR (tem
));
1104 char *string
= (char *) XSTRING (XCAR (tem
))->data
;
1105 /* See if this string duplicates any string already in the env.
1106 If so, don't put it in.
1107 When an env var has multiple definitions,
1108 we keep the definition that comes first in process-environment. */
1109 for (; ep
!= new_env
; ep
++)
1111 char *p
= *ep
, *q
= string
;
1115 /* The string is malformed; might as well drop it. */
1124 *new_env
++ = string
;
1130 prepare_standard_handles (in
, out
, err
, handles
);
1131 set_process_dir (XSTRING (current_dir
)->data
);
1132 #else /* not WINDOWSNT */
1133 /* Make sure that in, out, and err are not actually already in
1134 descriptors zero, one, or two; this could happen if Emacs is
1135 started with its standard in, out, or error closed, as might
1138 int oin
= in
, oout
= out
;
1140 /* We have to avoid relocating the same descriptor twice! */
1142 in
= relocate_fd (in
, 3);
1147 out
= relocate_fd (out
, 3);
1151 else if (err
== oout
)
1154 err
= relocate_fd (err
, 3);
1168 #endif /* not MSDOS */
1169 #endif /* not WINDOWSNT */
1171 #if defined(USG) && !defined(BSD_PGRPS)
1172 #ifndef SETPGRP_RELEASES_CTTY
1173 setpgrp (); /* No arguments but equivalent in this case */
1178 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1179 EMACS_SET_TTY_PGRP (0, &pid
);
1182 something missing here
;
1186 pid
= run_msdos_command (new_argv
, pwd_var
+ 4, in
, out
, err
, env
);
1188 /* An error occurred while trying to run the subprocess. */
1189 report_file_error ("Spawning child process", Qnil
);
1191 #else /* not MSDOS */
1193 /* Spawn the child. (See ntproc.c:Spawnve). */
1194 cpid
= spawnve (_P_NOWAIT
, new_argv
[0], new_argv
, env
);
1195 reset_standard_handles (in
, out
, err
, handles
);
1197 /* An error occurred while trying to spawn the process. */
1198 report_file_error ("Spawning child process", Qnil
);
1200 #else /* not WINDOWSNT */
1201 /* execvp does not accept an environment arg so the only way
1202 to pass this environment is to set environ. Our caller
1203 is responsible for restoring the ambient value of environ. */
1205 execvp (new_argv
[0], new_argv
);
1207 emacs_write (1, "Can't exec program: ", 20);
1208 emacs_write (1, new_argv
[0], strlen (new_argv
[0]));
1209 emacs_write (1, "\n", 1);
1211 #endif /* not WINDOWSNT */
1212 #endif /* not MSDOS */
1215 /* Move the file descriptor FD so that its number is not less than MINFD.
1216 If the file descriptor is moved at all, the original is freed. */
1218 relocate_fd (fd
, minfd
)
1228 char *message1
= "Error while setting up child: ";
1229 char *errmessage
= strerror (errno
);
1230 char *message2
= "\n";
1231 emacs_write (2, message1
, strlen (message1
));
1232 emacs_write (2, errmessage
, strlen (errmessage
));
1233 emacs_write (2, message2
, strlen (message2
));
1236 /* Note that we hold the original FD open while we recurse,
1237 to guarantee we'll get a new FD if we need it. */
1238 new = relocate_fd (new, minfd
);
1245 getenv_internal (var
, varlen
, value
, valuelen
)
1253 for (scan
= Vprocess_environment
; CONSP (scan
); scan
= XCDR (scan
))
1257 entry
= XCAR (scan
);
1259 && STRING_BYTES (XSTRING (entry
)) > varlen
1260 && XSTRING (entry
)->data
[varlen
] == '='
1262 /* NT environment variables are case insensitive. */
1263 && ! strnicmp (XSTRING (entry
)->data
, var
, varlen
)
1264 #else /* not WINDOWSNT */
1265 && ! bcmp (XSTRING (entry
)->data
, var
, varlen
)
1266 #endif /* not WINDOWSNT */
1269 *value
= (char *) XSTRING (entry
)->data
+ (varlen
+ 1);
1270 *valuelen
= STRING_BYTES (XSTRING (entry
)) - (varlen
+ 1);
1278 DEFUN ("getenv-internal", Fgetenv_internal
, Sgetenv_internal
, 1, 1, 0,
1279 "Return the value of environment variable VAR, as a string.\n\
1280 VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
1281 This function consults the variable ``process-environment'' for its value.")
1288 CHECK_STRING (var
, 0);
1289 if (getenv_internal (XSTRING (var
)->data
, STRING_BYTES (XSTRING (var
)),
1291 return make_string (value
, valuelen
);
1296 /* A version of getenv that consults process_environment, easily
1305 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
))
1311 #endif /* not VMS */
1313 /* This is run before init_cmdargs. */
1318 char *data_dir
= egetenv ("EMACSDATA");
1319 char *doc_dir
= egetenv ("EMACSDOC");
1322 = Ffile_name_as_directory (build_string (data_dir
? data_dir
1325 = Ffile_name_as_directory (build_string (doc_dir
? doc_dir
1328 /* Check the EMACSPATH environment variable, defaulting to the
1329 PATH_EXEC path from epaths.h. */
1330 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
1331 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
1332 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
1335 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1340 char *data_dir
= egetenv ("EMACSDATA");
1343 Lisp_Object tempdir
;
1345 if (!NILP (Vinstallation_directory
))
1347 /* Add to the path the lib-src subdir of the installation dir. */
1349 tem
= Fexpand_file_name (build_string ("lib-src"),
1350 Vinstallation_directory
);
1352 /* MSDOS uses wrapped binaries, so don't do this. */
1353 if (NILP (Fmember (tem
, Vexec_path
)))
1354 Vexec_path
= nconc2 (Vexec_path
, Fcons (tem
, Qnil
));
1356 Vexec_directory
= Ffile_name_as_directory (tem
);
1357 #endif /* not DOS_NT */
1359 /* Maybe use ../etc as well as ../lib-src. */
1362 tem
= Fexpand_file_name (build_string ("etc"),
1363 Vinstallation_directory
);
1364 Vdoc_directory
= Ffile_name_as_directory (tem
);
1368 /* Look for the files that should be in etc. We don't use
1369 Vinstallation_directory, because these files are never installed
1370 near the executable, and they are never in the build
1371 directory when that's different from the source directory.
1373 Instead, if these files are not in the nominal place, we try the
1374 source directory. */
1377 Lisp_Object tem
, tem1
, newdir
;
1379 tem
= Fexpand_file_name (build_string ("GNU"), Vdata_directory
);
1380 tem1
= Ffile_exists_p (tem
);
1383 newdir
= Fexpand_file_name (build_string ("../etc/"),
1384 build_string (PATH_DUMPLOADSEARCH
));
1385 tem
= Fexpand_file_name (build_string ("GNU"), newdir
);
1386 tem1
= Ffile_exists_p (tem
);
1388 Vdata_directory
= newdir
;
1396 tempdir
= Fdirectory_file_name (Vexec_directory
);
1397 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1398 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1402 tempdir
= Fdirectory_file_name (Vdata_directory
);
1403 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1404 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1408 Vshell_file_name
= build_string ("*dcl*");
1410 sh
= (char *) getenv ("SHELL");
1411 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
1415 Vtemp_file_name_pattern
= build_string ("tmp:emacsXXXXXX.");
1417 if (getenv ("TMPDIR"))
1419 char *dir
= getenv ("TMPDIR");
1420 Vtemp_file_name_pattern
1421 = Fexpand_file_name (build_string ("emacsXXXXXX"),
1422 build_string (dir
));
1425 Vtemp_file_name_pattern
= build_string ("/tmp/emacsXXXXXX");
1430 set_process_environment ()
1432 register char **envp
;
1434 Vprocess_environment
= Qnil
;
1438 for (envp
= environ
; *envp
; envp
++)
1439 Vprocess_environment
= Fcons (build_string (*envp
),
1440 Vprocess_environment
);
1447 Qbuffer_file_type
= intern ("buffer-file-type");
1448 staticpro (&Qbuffer_file_type
);
1451 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
1452 "*File name to load inferior shells from.\n\
1453 Initialized from the SHELL environment variable.");
1455 DEFVAR_LISP ("exec-path", &Vexec_path
,
1456 "*List of directories to search programs to run in subprocesses.\n\
1457 Each element is a string (directory name) or nil (try default directory).");
1459 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
1460 "Directory for executables for Emacs to invoke.\n\
1461 More generally, this includes any architecture-dependent files\n\
1462 that are built and installed from the Emacs distribution.");
1464 DEFVAR_LISP ("data-directory", &Vdata_directory
,
1465 "Directory of machine-independent files that come with GNU Emacs.\n\
1466 These are files intended for Emacs to use while it runs.");
1468 DEFVAR_LISP ("doc-directory", &Vdoc_directory
,
1469 "Directory containing the DOC file that comes with GNU Emacs.\n\
1470 This is usually the same as data-directory.");
1472 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
1473 "For internal use by the build procedure only.\n\
1474 This is the name of the directory in which the build procedure installed\n\
1475 Emacs's info files; the default value for Info-default-directory-list\n\
1477 Vconfigure_info_directory
= build_string (PATH_INFO
);
1479 DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern
,
1480 "Pattern for making names for temporary files.\n\
1481 This is used by `call-process-region'.");
1482 /* This variable is initialized in init_callproc. */
1484 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
1485 "List of environment variables for subprocesses to inherit.\n\
1486 Each element should be a string of the form ENVVARNAME=VALUE.\n\
1487 The environment which Emacs inherits is placed in this variable\n\
1488 when Emacs starts.");
1491 defsubr (&Scall_process
);
1492 defsubr (&Sgetenv_internal
);
1494 defsubr (&Scall_process_region
);