1 /* Synchronous subprocess invocation for GNU Emacs.
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95 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 extern char *strerror ();
31 /* Define SIGCHLD as an alias for SIGCLD. */
33 #if !defined (SIGCHLD) && defined (SIGCLD)
34 #define SIGCHLD SIGCLD
37 #include <sys/types.h>
41 #define INCLUDED_FCNTL
48 #include <stdlib.h> /* for proper declaration of environ */
51 #define _P_NOWAIT 1 /* from process.h */
54 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
55 #define INCLUDED_FCNTL
58 #include <sys/param.h>
78 #include "syssignal.h"
86 extern noshare
char **environ
;
88 extern char **environ
;
91 #define max(a, b) ((a) > (b) ? (a) : (b))
93 Lisp_Object Vexec_path
, Vexec_directory
, Vdata_directory
, Vdoc_directory
;
94 Lisp_Object Vconfigure_info_directory
;
95 Lisp_Object Vtemp_file_name_pattern
;
97 Lisp_Object Vshell_file_name
;
99 Lisp_Object Vprocess_environment
;
102 Lisp_Object Qbuffer_file_type
;
105 /* True iff 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 char *synch_process_death
;
112 /* If synch_process_death is zero,
113 this is exit code of synchronous subprocess. */
114 int synch_process_retcode
;
116 extern Lisp_Object Vdoc_file_name
;
118 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
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 #ifndef VMS /* VMS version is in vmsproc.c. */
130 call_process_kill (fdpid
)
133 close (XFASTINT (Fcar (fdpid
)));
134 EMACS_KILLPG (XFASTINT (Fcdr (fdpid
)), SIGKILL
);
135 synch_process_alive
= 0;
140 call_process_cleanup (fdpid
)
143 #if defined (MSDOS) || defined (macintosh)
144 /* for MSDOS fdpid is really (fd . tempfile) */
145 register Lisp_Object file
;
147 close (XFASTINT (Fcar (fdpid
)));
148 if (strcmp (XSTRING (file
)-> data
, NULL_DEVICE
) != 0)
149 unlink (XSTRING (file
)->data
);
150 #else /* not MSDOS and not macintosh */
151 register int pid
= XFASTINT (Fcdr (fdpid
));
153 if (call_process_exited
)
155 close (XFASTINT (Fcar (fdpid
)));
159 if (EMACS_KILLPG (pid
, SIGINT
) == 0)
161 int count
= specpdl_ptr
- specpdl
;
162 record_unwind_protect (call_process_kill
, fdpid
);
163 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
166 wait_for_termination (pid
);
168 specpdl_ptr
= specpdl
+ count
; /* Discard the unwind protect. */
169 message1 ("Waiting for process to die...done");
171 synch_process_alive
= 0;
172 close (XFASTINT (Fcar (fdpid
)));
173 #endif /* not MSDOS */
177 DEFUN ("call-process", Fcall_process
, Scall_process
, 1, MANY
, 0,
178 "Call PROGRAM synchronously in separate process.\n\
179 The remaining arguments are optional.\n\
180 The program's input comes from file INFILE (nil means `/dev/null').\n\
181 Insert output in BUFFER before point; t means current buffer;\n\
182 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
183 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
184 REAL-BUFFER says what to do with standard output, as above,\n\
185 while STDERR-FILE says what to do with standard error in the child.\n\
186 STDERR-FILE may be nil (discard standard error output),\n\
187 t (mix it with ordinary output), or a file name string.\n\
189 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
190 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
192 If BUFFER is 0, `call-process' returns immediately with value nil.\n\
193 Otherwise it waits for PROGRAM to terminate\n\
194 and returns a numeric exit status or a signal description string.\n\
195 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
198 register Lisp_Object
*args
;
200 Lisp_Object infile
, buffer
, current_dir
, display
, path
;
207 int count
= specpdl_ptr
- specpdl
;
209 register unsigned char **new_argv
210 = (unsigned char **) alloca ((max (2, nargs
- 2)) * sizeof (char *));
211 struct buffer
*old
= current_buffer
;
212 /* File to use for stderr in the child.
213 t means use same as standard output. */
214 Lisp_Object error_file
;
215 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
216 char *outf
, *tempfile
;
226 struct coding_system process_coding
; /* coding-system of process output */
227 struct coding_system argument_coding
; /* coding-system of arguments */
228 /* Set to the return value of Ffind_operation_coding_system. */
229 Lisp_Object coding_systems
;
231 /* Qt denotes that Ffind_operation_coding_system is not yet called. */
234 CHECK_STRING (args
[0], 0);
239 /* Without asynchronous processes we cannot have BUFFER == 0. */
241 && (INTEGERP (CONSP (args
[2]) ? XCAR (args
[2]) : args
[2])))
242 error ("Operating system cannot handle asynchronous subprocesses");
243 #endif /* subprocesses */
245 /* Decide the coding-system for giving arguments. */
247 Lisp_Object val
, *args2
;
250 /* If arguments are supplied, we may have to encode them. */
255 for (i
= 4; i
< nargs
; i
++)
256 CHECK_STRING (args
[i
], i
);
258 for (i
= 4; i
< nargs
; i
++)
259 if (STRING_MULTIBYTE (args
[i
]))
262 if (!NILP (Vcoding_system_for_write
))
263 val
= Vcoding_system_for_write
;
264 else if (! must_encode
)
268 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
269 args2
[0] = Qcall_process
;
270 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
271 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
272 if (CONSP (coding_systems
))
273 val
= XCONS (coding_systems
)->cdr
;
274 else if (CONSP (Vdefault_process_coding_system
))
275 val
= XCONS (Vdefault_process_coding_system
)->cdr
;
279 setup_coding_system (Fcheck_coding_system (val
), &argument_coding
);
283 if (nargs
>= 2 && ! NILP (args
[1]))
285 infile
= Fexpand_file_name (args
[1], current_buffer
->directory
);
286 CHECK_STRING (infile
, 1);
289 infile
= build_string (NULL_DEVICE
);
295 /* If BUFFER is a list, its meaning is
296 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
299 if (CONSP (XCONS (buffer
)->cdr
))
301 Lisp_Object stderr_file
;
302 stderr_file
= XCONS (XCONS (buffer
)->cdr
)->car
;
304 if (NILP (stderr_file
) || EQ (Qt
, stderr_file
))
305 error_file
= stderr_file
;
307 error_file
= Fexpand_file_name (stderr_file
, Qnil
);
310 buffer
= XCONS (buffer
)->car
;
313 if (!(EQ (buffer
, Qnil
)
315 || INTEGERP (buffer
)))
317 Lisp_Object spec_buffer
;
318 spec_buffer
= buffer
;
319 buffer
= Fget_buffer_create (buffer
);
320 /* Mention the buffer name for a better error message. */
322 CHECK_BUFFER (spec_buffer
, 2);
323 CHECK_BUFFER (buffer
, 2);
329 /* Make sure that the child will be able to chdir to the current
330 buffer's current directory, or its unhandled equivalent. We
331 can't just have the child check for an error when it does the
332 chdir, since it's in a vfork.
334 We have to GCPRO around this because Fexpand_file_name,
335 Funhandled_file_name_directory, and Ffile_accessible_directory_p
336 might call a file name handling function. The argument list is
337 protected by the caller, so all we really have to worry about is
340 struct gcpro gcpro1
, gcpro2
, gcpro3
;
342 current_dir
= current_buffer
->directory
;
344 GCPRO3 (infile
, buffer
, current_dir
);
347 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
349 if (NILP (Ffile_accessible_directory_p (current_dir
)))
350 report_file_error ("Setting current directory",
351 Fcons (current_buffer
->directory
, Qnil
));
356 display
= nargs
>= 4 ? args
[3] : Qnil
;
358 filefd
= open (XSTRING (infile
)->data
, O_RDONLY
, 0);
361 report_file_error ("Opening process input file", Fcons (infile
, Qnil
));
363 /* Search for program; barf if not found. */
367 GCPRO1 (current_dir
);
368 openp (Vexec_path
, args
[0], EXEC_SUFFIXES
, &path
, 1);
374 report_file_error ("Searching for program", Fcons (args
[0], Qnil
));
376 new_argv
[0] = XSTRING (path
)->data
;
381 if (! CODING_REQUIRE_ENCODING (&argument_coding
))
383 for (i
= 4; i
< nargs
; i
++)
384 new_argv
[i
- 3] = XSTRING (args
[i
])->data
;
388 /* We must encode the arguments. */
389 struct gcpro gcpro1
, gcpro2
, gcpro3
;
391 GCPRO3 (infile
, buffer
, current_dir
);
392 for (i
= 4; i
< nargs
; i
++)
394 int size
= encoding_buffer_size (&argument_coding
,
395 STRING_BYTES (XSTRING (args
[i
])));
396 unsigned char *dummy1
= (unsigned char *) alloca (size
);
399 /* The Irix 4.0 compiler barfs if we eliminate dummy. */
400 new_argv
[i
- 3] = dummy1
;
401 argument_coding
.mode
|= CODING_MODE_LAST_BLOCK
;
402 encode_coding (&argument_coding
,
403 XSTRING (args
[i
])->data
,
405 STRING_BYTES (XSTRING (args
[i
])),
407 new_argv
[i
- 3][argument_coding
.produced
] = 0;
408 /* We have to initialize CCL program status again. */
409 if (argument_coding
.type
== coding_type_ccl
)
410 setup_ccl_program (&(argument_coding
.spec
.ccl
.encoder
), Qnil
);
414 new_argv
[nargs
- 3] = 0;
419 #ifdef MSDOS /* MW, July 1993 */
420 if ((outf
= egetenv ("TMPDIR")))
421 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
424 tempfile
= alloca (20);
427 dostounix_filename (tempfile
);
428 if (*tempfile
== '\0' || tempfile
[strlen (tempfile
) - 1] != '/')
429 strcat (tempfile
, "/");
430 strcat (tempfile
, "detmp.XXX");
433 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
437 report_file_error ("Opening process output file",
438 Fcons (build_string (tempfile
), Qnil
));
445 /* Since we don't have pipes on the Mac, create a temporary file to
446 hold the output of the subprocess. */
447 tempfile
= (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
448 bcopy (XSTRING (Vtemp_file_name_pattern
)->data
, tempfile
,
449 STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
453 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
457 report_file_error ("Opening process output file",
458 Fcons (build_string (tempfile
), Qnil
));
462 #endif /* macintosh */
464 if (INTEGERP (buffer
))
465 fd
[1] = open (NULL_DEVICE
, O_WRONLY
), fd
[0] = -1;
474 /* Replaced by close_process_descs */
475 set_exclusive_use (fd
[0]);
480 /* child_setup must clobber environ in systems with true vfork.
481 Protect it from permanent change. */
482 register char **save_environ
= environ
;
483 register int fd1
= fd
[1];
486 #if 0 /* Some systems don't have sigblock. */
487 mask
= sigblock (sigmask (SIGCHLD
));
490 /* Record that we're about to create a synchronous process. */
491 synch_process_alive
= 1;
493 /* These vars record information from process termination.
494 Clear them now before process can possibly terminate,
495 to avoid timing error if process terminates soon. */
496 synch_process_death
= 0;
497 synch_process_retcode
= 0;
499 if (NILP (error_file
))
500 fd_error
= open (NULL_DEVICE
, O_WRONLY
);
501 else if (STRINGP (error_file
))
504 fd_error
= open (XSTRING (error_file
)->data
,
505 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
507 #else /* not DOS_NT */
508 fd_error
= creat (XSTRING (error_file
)->data
, 0666);
509 #endif /* not DOS_NT */
522 report_file_error ("Cannot redirect stderr",
523 Fcons ((NILP (error_file
)
524 ? build_string (NULL_DEVICE
) : error_file
),
528 current_dir
= ENCODE_FILE (current_dir
);
532 /* Call run_mac_command in sysdep.c here directly instead of doing
533 a child_setup as for MSDOS and other platforms. Note that this
534 code does not handle passing the environment to the synchronous
536 char *infn
, *outfn
, *errfn
, *currdn
;
538 /* close these files so subprocess can write to them */
540 if (fd_error
!= outfilefd
)
542 fd1
= -1; /* No harm in closing that one! */
544 infn
= XSTRING (infile
)->data
;
546 if (NILP (error_file
))
548 else if (EQ (Qt
, error_file
))
551 errfn
= XSTRING (error_file
)->data
;
552 currdn
= XSTRING (current_dir
)->data
;
553 pid
= run_mac_command (new_argv
, currdn
, infn
, outfn
, errfn
);
555 /* Record that the synchronous process exited and note its
556 termination status. */
557 synch_process_alive
= 0;
558 synch_process_retcode
= pid
;
559 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
560 synch_process_death
= strerror (errno
);
562 /* Since CRLF is converted to LF within `decode_coding', we can
563 always open a file with binary mode. */
564 fd
[0] = open (tempfile
, O_BINARY
);
569 report_file_error ("Cannot re-open temporary file", Qnil
);
572 #else /* not macintosh */
573 #ifdef MSDOS /* MW, July 1993 */
574 /* Note that on MSDOS `child_setup' actually returns the child process
575 exit status, not its PID, so we assign it to `synch_process_retcode'
577 pid
= child_setup (filefd
, outfilefd
, fd_error
, (char **) new_argv
,
580 /* Record that the synchronous process exited and note its
581 termination status. */
582 synch_process_alive
= 0;
583 synch_process_retcode
= pid
;
584 if (synch_process_retcode
< 0) /* means it couldn't be exec'ed */
585 synch_process_death
= strerror (errno
);
588 if (fd_error
!= outfilefd
)
590 fd1
= -1; /* No harm in closing that one! */
591 /* Since CRLF is converted to LF within `decode_coding', we can
592 always open a file with binary mode. */
593 fd
[0] = open (tempfile
, O_BINARY
);
598 report_file_error ("Cannot re-open temporary file", Qnil
);
600 #else /* not MSDOS */
602 pid
= child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
604 #else /* not WINDOWSNT */
614 #if defined (USG) && !defined (BSD_PGRPS)
619 child_setup (filefd
, fd1
, fd_error
, (char **) new_argv
,
622 #endif /* not WINDOWSNT */
624 /* The MSDOS case did this already. */
627 #endif /* not MSDOS */
628 #endif /* not macintosh */
630 environ
= save_environ
;
632 /* Close most of our fd's, but not fd[0]
633 since we will use that to read input from. */
635 if (fd1
>= 0 && fd1
!= fd_error
)
643 report_file_error ("Doing vfork", Qnil
);
646 if (INTEGERP (buffer
))
651 /* If Emacs has been built with asynchronous subprocess support,
652 we don't need to do this, I think because it will then have
653 the facilities for handling SIGCHLD. */
654 wait_without_blocking ();
655 #endif /* subprocesses */
659 /* Enable sending signal if user quits below. */
660 call_process_exited
= 0;
662 #if defined(MSDOS) || defined(macintosh)
663 /* MSDOS needs different cleanup information. */
664 record_unwind_protect (call_process_cleanup
,
665 Fcons (make_number (fd
[0]), build_string (tempfile
)));
667 record_unwind_protect (call_process_cleanup
,
668 Fcons (make_number (fd
[0]), make_number (pid
)));
669 #endif /* not MSDOS and not macintosh */
672 if (BUFFERP (buffer
))
673 Fset_buffer (buffer
);
677 /* If BUFFER is nil, we must read process output once and then
678 discard it, so setup coding system but with nil. */
679 setup_coding_system (Qnil
, &process_coding
);
683 Lisp_Object val
, *args2
;
686 if (!NILP (Vcoding_system_for_read
))
687 val
= Vcoding_system_for_read
;
690 if (EQ (coding_systems
, Qt
))
694 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
695 args2
[0] = Qcall_process
;
696 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
698 = Ffind_operation_coding_system (nargs
+ 1, args2
);
700 if (CONSP (coding_systems
))
701 val
= XCONS (coding_systems
)->car
;
702 else if (CONSP (Vdefault_process_coding_system
))
703 val
= XCONS (Vdefault_process_coding_system
)->car
;
707 setup_coding_system (Fcheck_coding_system (val
), &process_coding
);
708 /* In unibyte mode, character code conversion should not take
709 place but EOL conversion should. So, setup raw-text or one
710 of the subsidiary according to the information just setup. */
711 if (NILP (current_buffer
->enable_multibyte_characters
)
713 setup_raw_text_coding_system (&process_coding
);
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
= read (fd
[0], bufptr
+ nread
, bufsize
- nread
);
744 process_coding
.mode
|= CODING_MODE_LAST_BLOCK
;
749 total_read
+= this_read
;
751 if (display_on_the_fly
)
755 /* Now NREAD is the total amount of data in the buffer. */
760 if (process_coding
.type
== coding_type_no_conversion
)
761 insert (bufptr
, nread
);
763 { /* We have to decode the input. */
764 int size
= decoding_buffer_size (&process_coding
, nread
);
765 char *decoding_buf
= (char *) xmalloc (size
);
767 decode_coding (&process_coding
, bufptr
, decoding_buf
,
769 if (display_on_the_fly
770 && saved_coding
.type
== coding_type_undecided
771 && process_coding
.type
!= coding_type_undecided
)
773 /* We have detected some coding system. But,
774 there's a possibility that the detection was
775 done by insufficient data. So, we give up
776 displaying on the fly. */
777 xfree (decoding_buf
);
778 display_on_the_fly
= 0;
779 process_coding
= saved_coding
;
783 if (process_coding
.produced
> 0)
784 insert (decoding_buf
, process_coding
.produced
);
785 xfree (decoding_buf
);
786 carryover
= nread
- process_coding
.consumed
;
789 /* As CARRYOVER should not be that large, we had
790 better avoid overhead of bcopy. */
791 char *p
= bufptr
+ process_coding
.consumed
;
792 char *pend
= p
+ carryover
;
795 while (p
< pend
) *dst
++ = *p
++;
799 if (process_coding
.mode
& CODING_MODE_LAST_BLOCK
)
802 insert (bufptr
, carryover
);
806 /* Make the buffer bigger as we continue to read more data,
808 if (bufsize
< 64 * 1024 && total_read
> 32 * bufsize
)
811 bufptr
= (char *) alloca (bufsize
);
814 if (!NILP (display
) && INTERACTIVE
)
817 prepare_menu_bars ();
819 redisplay_preserve_echo_area ();
826 Vlast_coding_system_used
= process_coding
.symbol
;
828 /* If the caller required, let the buffer inherit the
829 coding-system used to decode the process output. */
830 if (inherit_process_coding_system
)
831 call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
832 make_number (total_read
));
835 /* Wait for it to terminate, unless it already has. */
836 wait_for_termination (pid
);
840 set_buffer_internal (old
);
842 /* Don't kill any children that the subprocess may have left behind
844 call_process_exited
= 1;
846 unbind_to (count
, Qnil
);
848 if (synch_process_death
)
849 return build_string (synch_process_death
);
850 return make_number (synch_process_retcode
);
855 delete_temp_file (name
)
858 /* Use Fdelete_file (indirectly) because that runs a file name handler.
859 We did that when writing the file, so we should do so when deleting. */
860 internal_delete_file (name
);
863 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
865 "Send text from START to END to a synchronous process running PROGRAM.\n\
866 The remaining arguments are optional.\n\
867 Delete the text if fourth arg DELETE is non-nil.\n\
869 Insert output in BUFFER before point; t means current buffer;\n\
870 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
871 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,\n\
872 REAL-BUFFER says what to do with standard output, as above,\n\
873 while STDERR-FILE says what to do with standard error in the child.\n\
874 STDERR-FILE may be nil (discard standard error output),\n\
875 t (mix it with ordinary output), or a file name string.\n\
877 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
878 Remaining args are passed to PROGRAM at startup as command args.\n\
880 If BUFFER is nil, `call-process-region' returns immediately with value nil.\n\
881 Otherwise it waits for PROGRAM to terminate\n\
882 and returns a numeric exit status or a signal description string.\n\
883 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
886 register Lisp_Object
*args
;
889 Lisp_Object filename_string
;
890 register Lisp_Object start
, end
;
891 int count
= specpdl_ptr
- specpdl
;
892 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
893 Lisp_Object coding_systems
;
894 Lisp_Object val
, *args2
;
900 if ((outf
= egetenv ("TMPDIR"))
901 || (outf
= egetenv ("TMP"))
902 || (outf
= egetenv ("TEMP")))
903 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
906 tempfile
= alloca (20);
909 if (!IS_DIRECTORY_SEP (tempfile
[strlen (tempfile
) - 1]))
910 strcat (tempfile
, "/");
911 if ('/' == DIRECTORY_SEP
)
912 dostounix_filename (tempfile
);
914 unixtodos_filename (tempfile
);
916 strcat (tempfile
, "emXXXXXX");
918 strcat (tempfile
, "detmp.XXX");
920 #else /* not DOS_NT */
921 char *tempfile
= (char *) alloca (STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
922 bcopy (XSTRING (Vtemp_file_name_pattern
)->data
, tempfile
,
923 STRING_BYTES (XSTRING (Vtemp_file_name_pattern
)) + 1);
924 #endif /* not DOS_NT */
930 filename_string
= build_string (tempfile
);
931 GCPRO1 (filename_string
);
934 /* Decide coding-system of the contents of the temporary file. */
935 if (!NILP (Vcoding_system_for_write
))
936 val
= Vcoding_system_for_write
;
937 else if (NILP (current_buffer
->enable_multibyte_characters
))
941 args2
= (Lisp_Object
*) alloca ((nargs
+ 1) * sizeof *args2
);
942 args2
[0] = Qcall_process_region
;
943 for (i
= 0; i
< nargs
; i
++) args2
[i
+ 1] = args
[i
];
944 coding_systems
= Ffind_operation_coding_system (nargs
+ 1, args2
);
945 if (CONSP (coding_systems
))
946 val
= XCONS (coding_systems
)->cdr
;
947 else if (CONSP (Vdefault_process_coding_system
))
948 val
= XCONS (Vdefault_process_coding_system
)->cdr
;
954 int count1
= specpdl_ptr
- specpdl
;
956 specbind (intern ("coding-system-for-write"), val
);
957 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
, Qnil
, Qnil
);
959 unbind_to (count1
, Qnil
);
962 /* Note that Fcall_process takes care of binding
963 coding-system-for-read. */
965 record_unwind_protect (delete_temp_file
, filename_string
);
967 if (nargs
> 3 && !NILP (args
[3]))
968 Fdelete_region (start
, end
);
980 args
[1] = filename_string
;
982 RETURN_UNGCPRO (unbind_to (count
, Fcall_process (nargs
, args
)));
985 #ifndef VMS /* VMS version is in vmsproc.c. */
987 static int relocate_fd ();
989 /* This is the last thing run in a newly forked inferior
990 either synchronous or asynchronous.
991 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
992 Initialize inferior's priority, pgrp, connected dir and environment.
993 then exec another program based on new_argv.
995 This function may change environ for the superior process.
996 Therefore, the superior process must save and restore the value
997 of environ around the vfork and the call to this function.
999 SET_PGRP is nonzero if we should put the subprocess into a separate
1002 CURRENT_DIR is an elisp string giving the path of the current
1003 directory the subprocess should have. Since we can't really signal
1004 a decent error from within the child, this should be verified as an
1005 executable directory by the parent. */
1008 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
1010 register char **new_argv
;
1012 Lisp_Object current_dir
;
1019 #endif /* WINDOWSNT */
1021 int pid
= getpid ();
1023 #ifdef SET_EMACS_PRIORITY
1025 extern int emacs_priority
;
1027 if (emacs_priority
< 0)
1028 nice (- emacs_priority
);
1033 /* Close Emacs's descriptors that this process should not have. */
1034 close_process_descs ();
1036 /* DOS_NT isn't in a vfork, so if we are in the middle of load-file,
1037 we will lose if we call close_load_descs here. */
1039 close_load_descs ();
1042 /* Note that use of alloca is always safe here. It's obvious for systems
1043 that do not have true vfork or that have true (stack) alloca.
1044 If using vfork and C_ALLOCA it is safe because that changes
1045 the superior's static variables as if the superior had done alloca
1046 and will be cleaned up in the usual way. */
1048 register char *temp
;
1051 i
= STRING_BYTES (XSTRING (current_dir
));
1052 pwd_var
= (char *) alloca (i
+ 6);
1054 bcopy ("PWD=", pwd_var
, 4);
1055 bcopy (XSTRING (current_dir
)->data
, temp
, i
);
1056 if (!IS_DIRECTORY_SEP (temp
[i
- 1])) temp
[i
++] = DIRECTORY_SEP
;
1060 /* We can't signal an Elisp error here; we're in a vfork. Since
1061 the callers check the current directory before forking, this
1062 should only return an error if the directory's permissions
1063 are changed between the check and this chdir, but we should
1065 if (chdir (temp
) < 0)
1070 /* Get past the drive letter, so that d:/ is left alone. */
1071 if (i
> 2 && IS_DEVICE_SEP (temp
[1]) && IS_DIRECTORY_SEP (temp
[2]))
1078 /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
1079 while (i
> 2 && IS_DIRECTORY_SEP (temp
[i
- 1]))
1083 /* Set `env' to a vector of the strings in Vprocess_environment. */
1085 register Lisp_Object tem
;
1086 register char **new_env
;
1087 register int new_length
;
1090 for (tem
= Vprocess_environment
;
1091 CONSP (tem
) && STRINGP (XCONS (tem
)->car
);
1092 tem
= XCONS (tem
)->cdr
)
1095 /* new_length + 2 to include PWD and terminating 0. */
1096 env
= new_env
= (char **) alloca ((new_length
+ 2) * sizeof (char *));
1098 /* If we have a PWD envvar, pass one down,
1099 but with corrected value. */
1101 *new_env
++ = pwd_var
;
1103 /* Copy the Vprocess_environment strings into new_env. */
1104 for (tem
= Vprocess_environment
;
1105 CONSP (tem
) && STRINGP (XCONS (tem
)->car
);
1106 tem
= XCONS (tem
)->cdr
)
1109 char *string
= (char *) XSTRING (XCONS (tem
)->car
)->data
;
1110 /* See if this string duplicates any string already in the env.
1111 If so, don't put it in.
1112 When an env var has multiple definitions,
1113 we keep the definition that comes first in process-environment. */
1114 for (; ep
!= new_env
; ep
++)
1116 char *p
= *ep
, *q
= string
;
1120 /* The string is malformed; might as well drop it. */
1129 *new_env
++ = string
;
1135 prepare_standard_handles (in
, out
, err
, handles
);
1136 set_process_dir (XSTRING (current_dir
)->data
);
1137 #else /* not WINDOWSNT */
1138 /* Make sure that in, out, and err are not actually already in
1139 descriptors zero, one, or two; this could happen if Emacs is
1140 started with its standard in, out, or error closed, as might
1143 int oin
= in
, oout
= out
;
1145 /* We have to avoid relocating the same descriptor twice! */
1147 in
= relocate_fd (in
, 3);
1152 out
= relocate_fd (out
, 3);
1156 else if (err
== oout
)
1159 err
= relocate_fd (err
, 3);
1173 #endif /* not MSDOS */
1174 #endif /* not WINDOWSNT */
1176 #if defined(USG) && !defined(BSD_PGRPS)
1177 #ifndef SETPGRP_RELEASES_CTTY
1178 setpgrp (); /* No arguments but equivalent in this case */
1183 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
1184 EMACS_SET_TTY_PGRP (0, &pid
);
1187 something missing here
;
1191 pid
= run_msdos_command (new_argv
, pwd_var
+ 4, in
, out
, err
, env
);
1193 /* An error occurred while trying to run the subprocess. */
1194 report_file_error ("Spawning child process", Qnil
);
1196 #else /* not MSDOS */
1198 /* Spawn the child. (See ntproc.c:Spawnve). */
1199 cpid
= spawnve (_P_NOWAIT
, new_argv
[0], new_argv
, env
);
1200 reset_standard_handles (in
, out
, err
, handles
);
1202 /* An error occurred while trying to spawn the process. */
1203 report_file_error ("Spawning child process", Qnil
);
1205 #else /* not WINDOWSNT */
1206 /* execvp does not accept an environment arg so the only way
1207 to pass this environment is to set environ. Our caller
1208 is responsible for restoring the ambient value of environ. */
1210 execvp (new_argv
[0], new_argv
);
1212 write (1, "Can't exec program: ", 20);
1213 write (1, new_argv
[0], strlen (new_argv
[0]));
1216 #endif /* not WINDOWSNT */
1217 #endif /* not MSDOS */
1220 /* Move the file descriptor FD so that its number is not less than MINFD.
1221 If the file descriptor is moved at all, the original is freed. */
1223 relocate_fd (fd
, minfd
)
1233 char *message1
= "Error while setting up child: ";
1234 char *errmessage
= strerror (errno
);
1235 char *message2
= "\n";
1236 write (2, message1
, strlen (message1
));
1237 write (2, errmessage
, strlen (errmessage
));
1238 write (2, message2
, strlen (message2
));
1241 /* Note that we hold the original FD open while we recurse,
1242 to guarantee we'll get a new FD if we need it. */
1243 new = relocate_fd (new, minfd
);
1250 getenv_internal (var
, varlen
, value
, valuelen
)
1258 for (scan
= Vprocess_environment
; CONSP (scan
); scan
= XCONS (scan
)->cdr
)
1262 entry
= XCONS (scan
)->car
;
1264 && STRING_BYTES (XSTRING (entry
)) > varlen
1265 && XSTRING (entry
)->data
[varlen
] == '='
1267 /* NT environment variables are case insensitive. */
1268 && ! strnicmp (XSTRING (entry
)->data
, var
, varlen
)
1269 #else /* not WINDOWSNT */
1270 && ! bcmp (XSTRING (entry
)->data
, var
, varlen
)
1271 #endif /* not WINDOWSNT */
1274 *value
= (char *) XSTRING (entry
)->data
+ (varlen
+ 1);
1275 *valuelen
= STRING_BYTES (XSTRING (entry
)) - (varlen
+ 1);
1283 DEFUN ("getenv", Fgetenv
, Sgetenv
, 1, 1, 0,
1284 "Return the value of environment variable VAR, as a string.\n\
1285 VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
1286 This function consults the variable ``process-environment'' for its value.")
1293 CHECK_STRING (var
, 0);
1294 if (getenv_internal (XSTRING (var
)->data
, STRING_BYTES (XSTRING (var
)),
1296 return make_string (value
, valuelen
);
1301 /* A version of getenv that consults process_environment, easily
1310 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
))
1316 #endif /* not VMS */
1318 /* This is run before init_cmdargs. */
1323 char *data_dir
= egetenv ("EMACSDATA");
1324 char *doc_dir
= egetenv ("EMACSDOC");
1327 = Ffile_name_as_directory (build_string (data_dir
? data_dir
1330 = Ffile_name_as_directory (build_string (doc_dir
? doc_dir
1333 /* Check the EMACSPATH environment variable, defaulting to the
1334 PATH_EXEC path from epaths.h. */
1335 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
1336 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
1337 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
1340 /* This is run after init_cmdargs, when Vinstallation_directory is valid. */
1345 char *data_dir
= egetenv ("EMACSDATA");
1348 Lisp_Object tempdir
;
1350 if (!NILP (Vinstallation_directory
))
1352 /* Add to the path the lib-src subdir of the installation dir. */
1354 tem
= Fexpand_file_name (build_string ("lib-src"),
1355 Vinstallation_directory
);
1357 /* MSDOS uses wrapped binaries, so don't do this. */
1358 if (NILP (Fmember (tem
, Vexec_path
)))
1359 Vexec_path
= nconc2 (Vexec_path
, Fcons (tem
, Qnil
));
1361 Vexec_directory
= Ffile_name_as_directory (tem
);
1362 #endif /* not DOS_NT */
1364 /* Maybe use ../etc as well as ../lib-src. */
1367 tem
= Fexpand_file_name (build_string ("etc"),
1368 Vinstallation_directory
);
1369 Vdoc_directory
= Ffile_name_as_directory (tem
);
1373 /* Look for the files that should be in etc. We don't use
1374 Vinstallation_directory, because these files are never installed
1375 near the executable, and they are never in the build
1376 directory when that's different from the source directory.
1378 Instead, if these files are not in the nominal place, we try the
1379 source directory. */
1382 Lisp_Object tem
, tem1
, newdir
;
1384 tem
= Fexpand_file_name (build_string ("GNU"), Vdata_directory
);
1385 tem1
= Ffile_exists_p (tem
);
1388 newdir
= Fexpand_file_name (build_string ("../etc/"),
1389 build_string (PATH_DUMPLOADSEARCH
));
1390 tem
= Fexpand_file_name (build_string ("GNU"), newdir
);
1391 tem1
= Ffile_exists_p (tem
);
1393 Vdata_directory
= newdir
;
1401 tempdir
= Fdirectory_file_name (Vexec_directory
);
1402 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1403 dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n",
1407 tempdir
= Fdirectory_file_name (Vdata_directory
);
1408 if (access (XSTRING (tempdir
)->data
, 0) < 0)
1409 dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n",
1413 Vshell_file_name
= build_string ("*dcl*");
1415 sh
= (char *) getenv ("SHELL");
1416 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
1420 Vtemp_file_name_pattern
= build_string ("tmp:emacsXXXXXX.");
1422 if (getenv ("TMPDIR"))
1424 char *dir
= getenv ("TMPDIR");
1425 Vtemp_file_name_pattern
1426 = Fexpand_file_name (build_string ("emacsXXXXXX"),
1427 build_string (dir
));
1430 Vtemp_file_name_pattern
= build_string ("/tmp/emacsXXXXXX");
1435 set_process_environment ()
1437 register char **envp
;
1439 Vprocess_environment
= Qnil
;
1443 for (envp
= environ
; *envp
; envp
++)
1444 Vprocess_environment
= Fcons (build_string (*envp
),
1445 Vprocess_environment
);
1452 Qbuffer_file_type
= intern ("buffer-file-type");
1453 staticpro (&Qbuffer_file_type
);
1456 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
1457 "*File name to load inferior shells from.\n\
1458 Initialized from the SHELL environment variable.");
1460 DEFVAR_LISP ("exec-path", &Vexec_path
,
1461 "*List of directories to search programs to run in subprocesses.\n\
1462 Each element is a string (directory name) or nil (try default directory).");
1464 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
1465 "Directory for executables for Emacs to invoke.\n\
1466 More generally, this includes any architecture-dependent files\n\
1467 that are built and installed from the Emacs distribution.");
1469 DEFVAR_LISP ("data-directory", &Vdata_directory
,
1470 "Directory of machine-independent files that come with GNU Emacs.\n\
1471 These are files intended for Emacs to use while it runs.");
1473 DEFVAR_LISP ("doc-directory", &Vdoc_directory
,
1474 "Directory containing the DOC file that comes with GNU Emacs.\n\
1475 This is usually the same as data-directory.");
1477 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
1478 "For internal use by the build procedure only.\n\
1479 This is the name of the directory in which the build procedure installed\n\
1480 Emacs's info files; the default value for Info-default-directory-list\n\
1482 Vconfigure_info_directory
= build_string (PATH_INFO
);
1484 DEFVAR_LISP ("temp-file-name-pattern", &Vtemp_file_name_pattern
,
1485 "Pattern for making names for temporary files.\n\
1486 This is used by `call-process-region'.");
1487 /* This variable is initialized in init_callproc. */
1489 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
1490 "List of environment variables for subprocesses to inherit.\n\
1491 Each element should be a string of the form ENVVARNAME=VALUE.\n\
1492 The environment which Emacs inherits is placed in this variable\n\
1493 when Emacs starts.");
1496 defsubr (&Scall_process
);
1499 defsubr (&Scall_process_region
);