1 /* Synchronous subprocess invocation for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 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, 675 Mass Ave, Cambridge, MA 02139, USA. */
28 extern char *strerror ();
30 /* Define SIGCHLD as an alias for SIGCLD. */
32 #if !defined (SIGCHLD) && defined (SIGCLD)
33 #define SIGCHLD SIGCLD
36 #include <sys/types.h>
43 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
46 #include <sys/param.h>
63 #include "syssignal.h"
67 extern noshare
char **environ
;
69 extern char **environ
;
72 #define max(a, b) ((a) > (b) ? (a) : (b))
75 Lisp_Object Vbinary_process
;
78 Lisp_Object Vexec_path
, Vexec_directory
, Vdata_directory
, Vdoc_directory
;
79 Lisp_Object Vconfigure_info_directory
;
81 Lisp_Object Vshell_file_name
;
83 Lisp_Object Vprocess_environment
;
85 /* True iff we are about to fork off a synchronous process or if we
86 are waiting for it. */
87 int synch_process_alive
;
89 /* Nonzero => this is a string explaining death of synchronous subprocess. */
90 char *synch_process_death
;
92 /* If synch_process_death is zero,
93 this is exit code of synchronous subprocess. */
94 int synch_process_retcode
;
96 extern Lisp_Object Vdoc_file_name
;
98 /* Clean up when exiting Fcall_process.
99 On MSDOS, delete the temporary file on any kind of termination.
100 On Unix, kill the process and any children on termination by signal. */
102 /* Nonzero if this is termination due to exit. */
103 static int call_process_exited
;
105 #ifndef VMS /* VMS version is in vmsproc.c. */
108 call_process_kill (fdpid
)
111 close (XFASTINT (Fcar (fdpid
)));
112 EMACS_KILLPG (XFASTINT (Fcdr (fdpid
)), SIGKILL
);
113 synch_process_alive
= 0;
118 call_process_cleanup (fdpid
)
122 /* for MSDOS fdpid is really (fd . tempfile) */
123 register Lisp_Object file
;
125 close (XFASTINT (Fcar (fdpid
)));
126 if (strcmp (XSTRING (file
)-> data
, NULL_DEVICE
) != 0)
127 unlink (XSTRING (file
)->data
);
128 #else /* not MSDOS */
129 register int pid
= XFASTINT (Fcdr (fdpid
));
132 if (call_process_exited
)
134 close (XFASTINT (Fcar (fdpid
)));
138 if (EMACS_KILLPG (pid
, SIGINT
) == 0)
140 int count
= specpdl_ptr
- specpdl
;
141 record_unwind_protect (call_process_kill
, fdpid
);
142 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
145 wait_for_termination (pid
);
147 specpdl_ptr
= specpdl
+ count
; /* Discard the unwind protect. */
148 message1 ("Waiting for process to die...done");
150 synch_process_alive
= 0;
151 close (XFASTINT (Fcar (fdpid
)));
152 #endif /* not MSDOS */
156 DEFUN ("call-process", Fcall_process
, Scall_process
, 1, MANY
, 0,
157 "Call PROGRAM synchronously in separate process.\n\
158 The program's input comes from file INFILE (nil means `/dev/null').\n\
159 Insert output in BUFFER before point; t means current buffer;\n\
160 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
161 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
162 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
163 If BUFFER is 0, returns immediately with value nil.\n\
164 Otherwise waits for PROGRAM to terminate\n\
165 and returns a numeric exit status or a signal description string.\n\
166 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
169 register Lisp_Object
*args
;
171 Lisp_Object infile
, buffer
, current_dir
, display
, path
;
176 int count
= specpdl_ptr
- specpdl
;
177 register unsigned char **new_argv
178 = (unsigned char **) alloca ((max (2, nargs
- 2)) * sizeof (char *));
179 struct buffer
*old
= current_buffer
;
180 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
181 char *outf
, *tempfile
;
187 CHECK_STRING (args
[0], 0);
190 /* Without asynchronous processes we cannot have BUFFER == 0. */
191 if (nargs
>= 3 && XTYPE (args
[2]) == Lisp_Int
)
192 error ("Operating system cannot handle asynchronous subprocesses");
193 #endif /* subprocesses */
195 if (nargs
>= 2 && ! NILP (args
[1]))
197 infile
= Fexpand_file_name (args
[1], current_buffer
->directory
);
198 CHECK_STRING (infile
, 1);
201 infile
= build_string (NULL_DEVICE
);
205 register Lisp_Object tem
;
207 buffer
= tem
= args
[2];
210 || XFASTINT (tem
) == 0))
212 buffer
= Fget_buffer (tem
);
213 CHECK_BUFFER (buffer
, 2);
219 /* Make sure that the child will be able to chdir to the current
220 buffer's current directory, or its unhandled equivalent. We
221 can't just have the child check for an error when it does the
222 chdir, since it's in a vfork.
224 We have to GCPRO around this because Fexpand_file_name,
225 Funhandled_file_name_directory, and Ffile_accessible_directory_p
226 might call a file name handling function. The argument list is
227 protected by the caller, so all we really have to worry about is
230 struct gcpro gcpro1
, gcpro2
, gcpro3
;
232 current_dir
= current_buffer
->directory
;
234 GCPRO3 (infile
, buffer
, current_dir
);
237 = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir
),
239 if (NILP (Ffile_accessible_directory_p (current_dir
)))
240 report_file_error ("Setting current directory",
241 Fcons (current_buffer
->directory
, Qnil
));
246 display
= nargs
>= 4 ? args
[3] : Qnil
;
248 filefd
= open (XSTRING (infile
)->data
, O_RDONLY
, 0);
251 report_file_error ("Opening process input file", Fcons (infile
, Qnil
));
253 /* Search for program; barf if not found. */
257 GCPRO1 (current_dir
);
258 openp (Vexec_path
, args
[0], EXEC_SUFFIXES
, &path
, 1);
264 report_file_error ("Searching for program", Fcons (args
[0], Qnil
));
266 new_argv
[0] = XSTRING (path
)->data
;
269 for (i
= 4; i
< nargs
; i
++)
271 CHECK_STRING (args
[i
], i
);
272 new_argv
[i
- 3] = XSTRING (args
[i
])->data
;
277 #ifdef MSDOS /* MW, July 1993 */
278 /* These vars record information from process termination.
279 Clear them now before process can possibly terminate,
280 to avoid timing error if process terminates soon. */
281 synch_process_death
= 0;
282 synch_process_retcode
= 0;
284 if ((outf
= egetenv ("TMP")) || (outf
= egetenv ("TEMP")))
285 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
288 tempfile
= alloca (20);
291 dostounix_filename (tempfile
);
292 if (*tempfile
== '\0' || tempfile
[strlen (tempfile
) - 1] != '/')
293 strcat (tempfile
, "/");
294 strcat (tempfile
, "detmp.XXX");
297 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
301 report_file_error ("Opening process output file", Fcons (tempfile
, Qnil
));
305 if (XTYPE (buffer
) == Lisp_Int
)
306 fd
[1] = open (NULL_DEVICE
, O_WRONLY
), fd
[0] = -1;
313 /* Replaced by close_process_descs */
314 set_exclusive_use (fd
[0]);
319 /* child_setup must clobber environ in systems with true vfork.
320 Protect it from permanent change. */
321 register char **save_environ
= environ
;
322 register int fd1
= fd
[1];
324 #if 0 /* Some systems don't have sigblock. */
325 mask
= sigblock (sigmask (SIGCHLD
));
328 /* Record that we're about to create a synchronous process. */
329 synch_process_alive
= 1;
331 /* These vars record information from process termination.
332 Clear them now before process can possibly terminate,
333 to avoid timing error if process terminates soon. */
334 synch_process_death
= 0;
335 synch_process_retcode
= 0;
337 #ifdef MSDOS /* MW, July 1993 */
338 /* ??? Someone who knows MSDOG needs to check whether this properly
339 closes all descriptors that it opens. */
340 pid
= run_msdos_command (new_argv
, current_dir
, filefd
, outfilefd
);
342 fd1
= -1; /* No harm in closing that one! */
343 fd
[0] = open (tempfile
, NILP (Vbinary_process
) ? O_TEXT
: O_BINARY
);
348 report_file_error ("Cannot re-open temporary file", Qnil
);
350 #else /* not MSDOS */
362 child_setup (filefd
, fd1
, fd1
, new_argv
, 0, current_dir
);
364 #endif /* not MSDOS */
366 environ
= save_environ
;
368 /* Close most of our fd's, but not fd[0]
369 since we will use that to read input from. */
379 report_file_error ("Doing vfork", Qnil
);
382 if (XTYPE (buffer
) == Lisp_Int
)
387 /* If Emacs has been built with asynchronous subprocess support,
388 we don't need to do this, I think because it will then have
389 the facilities for handling SIGCHLD. */
390 wait_without_blocking ();
391 #endif /* subprocesses */
395 /* Enable sending signal if user quits below. */
396 call_process_exited
= 0;
399 /* MSDOS needs different cleanup information. */
400 record_unwind_protect (call_process_cleanup
,
401 Fcons (make_number (fd
[0]), build_string (tempfile
)));
403 record_unwind_protect (call_process_cleanup
,
404 Fcons (make_number (fd
[0]), make_number (pid
)));
405 #endif /* not MSDOS */
408 if (XTYPE (buffer
) == Lisp_Buffer
)
409 Fset_buffer (buffer
);
418 while ((nread
= read (fd
[0], buf
, sizeof buf
)) > 0)
423 if (!NILP (display
) && INTERACTIVE
)
426 prepare_menu_bars ();
428 redisplay_preserve_echo_area ();
435 /* Wait for it to terminate, unless it already has. */
436 wait_for_termination (pid
);
440 set_buffer_internal (old
);
442 /* Don't kill any children that the subprocess may have left behind
444 call_process_exited
= 1;
446 unbind_to (count
, Qnil
);
448 if (synch_process_death
)
449 return build_string (synch_process_death
);
450 return make_number (synch_process_retcode
);
455 delete_temp_file (name
)
458 unlink (XSTRING (name
)->data
);
461 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
463 "Send text from START to END to a synchronous process running PROGRAM.\n\
464 Delete the text if fourth arg DELETE is non-nil.\n\
465 Insert output in BUFFER before point; t means current buffer;\n\
466 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
467 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
468 Remaining args are passed to PROGRAM at startup as command args.\n\
469 If BUFFER is nil, returns immediately with value nil.\n\
470 Otherwise waits for PROGRAM to terminate\n\
471 and returns a numeric exit status or a signal description string.\n\
472 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
475 register Lisp_Object
*args
;
477 register Lisp_Object filename_string
, start
, end
;
483 int count
= specpdl_ptr
- specpdl
;
487 if ((outf
= egetenv ("TMP")) || (outf
= egetenv ("TEMP")))
488 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
491 tempfile
= alloca (20);
494 dostounix_filename (tempfile
);
495 if (tempfile
[strlen (tempfile
) - 1] != '/')
496 strcat (tempfile
, "/");
497 strcat (tempfile
, "detmp.XXX");
498 #else /* not MSDOS */
501 strcpy (tempfile
, "tmp:emacsXXXXXX.");
503 strcpy (tempfile
, "/tmp/emacsXXXXXX");
505 #endif /* not MSDOS */
509 filename_string
= build_string (tempfile
);
512 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
);
513 record_unwind_protect (delete_temp_file
, filename_string
);
516 Fdelete_region (start
, end
);
518 args
[3] = filename_string
;
520 return unbind_to (count
, Fcall_process (nargs
- 2, args
+ 2));
523 #ifndef VMS /* VMS version is in vmsproc.c. */
525 /* This is the last thing run in a newly forked inferior
526 either synchronous or asynchronous.
527 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
528 Initialize inferior's priority, pgrp, connected dir and environment.
529 then exec another program based on new_argv.
531 This function may change environ for the superior process.
532 Therefore, the superior process must save and restore the value
533 of environ around the vfork and the call to this function.
535 ENV is the environment for the subprocess.
537 SET_PGRP is nonzero if we should put the subprocess into a separate
540 CURRENT_DIR is an elisp string giving the path of the current
541 directory the subprocess should have. Since we can't really signal
542 a decent error from within the child, this should be verified as an
543 executable directory by the parent. */
545 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
547 register char **new_argv
;
549 Lisp_Object current_dir
;
552 /* The MSDOS port of gcc cannot fork, vfork, ... so we must call system
554 #else /* not MSDOS */
560 extern int emacs_priority
;
562 nice (- emacs_priority
);
566 /* Close Emacs's descriptors that this process should not have. */
567 close_process_descs ();
571 /* Note that use of alloca is always safe here. It's obvious for systems
572 that do not have true vfork or that have true (stack) alloca.
573 If using vfork and C_ALLOCA it is safe because that changes
574 the superior's static variables as if the superior had done alloca
575 and will be cleaned up in the usual way. */
577 register unsigned char *temp
;
580 i
= XSTRING (current_dir
)->size
;
581 temp
= (unsigned char *) alloca (i
+ 2);
582 bcopy (XSTRING (current_dir
)->data
, temp
, i
);
583 if (temp
[i
- 1] != '/') temp
[i
++] = '/';
586 /* We can't signal an Elisp error here; we're in a vfork. Since
587 the callers check the current directory before forking, this
588 should only return an error if the directory's permissions
589 are changed between the check and this chdir, but we should
591 if (chdir (temp
) < 0)
595 /* Set `env' to a vector of the strings in Vprocess_environment. */
597 register Lisp_Object tem
;
598 register char **new_env
;
599 register int new_length
;
602 for (tem
= Vprocess_environment
;
603 (XTYPE (tem
) == Lisp_Cons
604 && XTYPE (XCONS (tem
)->car
) == Lisp_String
);
605 tem
= XCONS (tem
)->cdr
)
608 /* new_length + 1 to include terminating 0. */
609 env
= new_env
= (char **) alloca ((new_length
+ 1) * sizeof (char *));
611 /* Copy the Vprocess_environment strings into new_env. */
612 for (tem
= Vprocess_environment
;
613 (XTYPE (tem
) == Lisp_Cons
614 && XTYPE (XCONS (tem
)->car
) == Lisp_String
);
615 tem
= XCONS (tem
)->cdr
)
618 char *string
= (char *) XSTRING (XCONS (tem
)->car
)->data
;
619 /* See if this string duplicates any string already in the env.
620 If so, don't put it in.
621 When an env var has multiple definitions,
622 we keep the definition that comes first in process-environment. */
623 for (; ep
!= new_env
; ep
++)
625 char *p
= *ep
, *q
= string
;
629 /* The string is malformed; might as well drop it. */
644 /* Make sure that in, out, and err are not actually already in
645 descriptors zero, one, or two; this could happen if Emacs is
646 started with its standard in, out, or error closed, as might
648 in
= relocate_fd (in
, 3);
649 out
= relocate_fd (out
, 3);
650 err
= relocate_fd (err
, 3);
664 #ifndef SETPGRP_RELEASES_CTTY
665 setpgrp (); /* No arguments but equivalent in this case */
670 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
671 EMACS_SET_TTY_PGRP (0, &pid
);
674 something missing here
;
677 /* execvp does not accept an environment arg so the only way
678 to pass this environment is to set environ. Our caller
679 is responsible for restoring the ambient value of environ. */
681 execvp (new_argv
[0], new_argv
);
683 write (1, "Couldn't exec the program ", 26);
684 write (1, new_argv
[0], strlen (new_argv
[0]));
686 #endif /* not MSDOS */
689 /* Move the file descriptor FD so that its number is not less than MIN.
690 If the file descriptor is moved at all, the original is freed. */
692 relocate_fd (fd
, min
)
702 char *message1
= "Error while setting up child: ";
703 char *errmessage
= strerror (errno
);
704 char *message2
= "\n";
705 write (2, message1
, strlen (message1
));
706 write (2, errmessage
, strlen (errmessage
));
707 write (2, message2
, strlen (message2
));
710 /* Note that we hold the original FD open while we recurse,
711 to guarantee we'll get a new FD if we need it. */
712 new = relocate_fd (new, min
);
719 getenv_internal (var
, varlen
, value
, valuelen
)
727 for (scan
= Vprocess_environment
; CONSP (scan
); scan
= XCONS (scan
)->cdr
)
731 entry
= XCONS (scan
)->car
;
732 if (XTYPE (entry
) == Lisp_String
733 && XSTRING (entry
)->size
> varlen
734 && XSTRING (entry
)->data
[varlen
] == '='
735 && ! bcmp (XSTRING (entry
)->data
, var
, varlen
))
737 *value
= (char *) XSTRING (entry
)->data
+ (varlen
+ 1);
738 *valuelen
= XSTRING (entry
)->size
- (varlen
+ 1);
746 DEFUN ("getenv", Fgetenv
, Sgetenv
, 1, 1, 0,
747 "Return the value of environment variable VAR, as a string.\n\
748 VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
749 This function consults the variable ``process-environment'' for its value.")
756 CHECK_STRING (var
, 0);
757 if (getenv_internal (XSTRING (var
)->data
, XSTRING (var
)->size
,
759 return make_string (value
, valuelen
);
764 /* A version of getenv that consults process_environment, easily
773 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
))
781 /* This is run before init_cmdargs. */
785 char *data_dir
= egetenv ("EMACSDATA");
786 char *doc_dir
= egetenv ("EMACSDOC");
789 = Ffile_name_as_directory (build_string (data_dir
? data_dir
792 = Ffile_name_as_directory (build_string (doc_dir
? doc_dir
795 /* Check the EMACSPATH environment variable, defaulting to the
796 PATH_EXEC path from paths.h. */
797 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
798 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
799 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
802 /* This is run after init_cmdargs, so that Vinvocation_directory is valid. */
806 char *data_dir
= egetenv ("EMACSDATA");
811 if (initialized
&& !NILP (Vinstallation_directory
))
813 /* Add to the path the lib-src subdir of the installation dir. */
815 tem
= Fexpand_file_name (build_string ("lib-src"),
816 Vinstallation_directory
);
817 if (NILP (Fmember (tem
, Vexec_path
)))
819 Vexec_path
= nconc2 (Vexec_path
, Fcons (tem
, Qnil
));
820 Vexec_directory
= Ffile_name_as_directory (tem
);
822 /* If we use ../lib-src, maybe use ../etc as well.
823 Do so if ../etc exists and has our DOC-... file in it. */
826 tem
= Fexpand_file_name (build_string ("etc"),
827 Vinstallation_directory
);
828 Vdata_directory
= Ffile_name_as_directory (tem
);
833 tempdir
= Fdirectory_file_name (Vexec_directory
);
834 if (access (XSTRING (tempdir
)->data
, 0) < 0)
837 "Warning: arch-dependent data dir (%s) does not exist.\n",
838 XSTRING (Vexec_directory
)->data
);
842 tempdir
= Fdirectory_file_name (Vdata_directory
);
843 if (access (XSTRING (tempdir
)->data
, 0) < 0)
846 "Warning: arch-independent data dir (%s) does not exist.\n",
847 XSTRING (Vdata_directory
)->data
);
852 Vshell_file_name
= build_string ("*dcl*");
854 sh
= (char *) getenv ("SHELL");
855 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
859 set_process_environment ()
861 register char **envp
;
863 Vprocess_environment
= Qnil
;
867 for (envp
= environ
; *envp
; envp
++)
868 Vprocess_environment
= Fcons (build_string (*envp
),
869 Vprocess_environment
);
875 DEFVAR_LISP ("binary-process", &Vbinary_process
,
876 "*If non-nil then new subprocesses are assumed to produce binary output.");
877 Vbinary_process
= Qnil
;
880 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
881 "*File name to load inferior shells from.\n\
882 Initialized from the SHELL environment variable.");
884 DEFVAR_LISP ("exec-path", &Vexec_path
,
885 "*List of directories to search programs to run in subprocesses.\n\
886 Each element is a string (directory name) or nil (try default directory).");
888 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
889 "Directory of architecture-dependent files that come with GNU Emacs,\n\
890 especially executable programs intended for Emacs to invoke.");
892 DEFVAR_LISP ("data-directory", &Vdata_directory
,
893 "Directory of architecture-independent files that come with GNU Emacs,\n\
894 intended for Emacs to use.");
896 DEFVAR_LISP ("doc-directory", &Vdoc_directory
,
897 "Directory containing the DOC file that comes with GNU Emacs.\n\
898 This is usually the same as data-directory.");
900 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
901 "For internal use by the build procedure only.\n\
902 This is the name of the directory in which the build procedure installed\n\
903 Emacs's info files; the default value for Info-default-directory-list\n\
905 Vconfigure_info_directory
= build_string (PATH_INFO
);
907 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
908 "List of environment variables for subprocesses to inherit.\n\
909 Each element should be a string of the form ENVVARNAME=VALUE.\n\
910 The environment which Emacs inherits is placed in this variable\n\
911 when Emacs starts.");
914 defsubr (&Scall_process
);
917 defsubr (&Scall_process_region
);