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
= Fcdr (fdpid
);
124 close (XFASTINT (Fcar (fdpid
)));
125 if (strcmp (XSTRING (file
)-> data
, NULL_DEVICE
) != 0)
126 unlink (XSTRING (file
)->data
);
127 #else /* not MSDOS */
128 register int pid
= XFASTINT (Fcdr (fdpid
));
130 if (call_process_exited
)
133 if (EMACS_KILLPG (pid
, SIGINT
) == 0)
135 int count
= specpdl_ptr
- specpdl
;
136 record_unwind_protect (call_process_kill
, fdpid
);
137 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
140 wait_for_termination (pid
);
142 specpdl_ptr
= specpdl
+ count
; /* Discard the unwind protect. */
143 message1 ("Waiting for process to die...done");
145 synch_process_alive
= 0;
146 close (XFASTINT (Fcar (fdpid
)));
147 #endif /* not MSDOS */
151 DEFUN ("call-process", Fcall_process
, Scall_process
, 1, MANY
, 0,
152 "Call PROGRAM synchronously in separate process.\n\
153 The program's input comes from file INFILE (nil means `/dev/null').\n\
154 Insert output in BUFFER before point; t means current buffer;\n\
155 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
156 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
157 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
158 If BUFFER is 0, returns immediately with value nil.\n\
159 Otherwise waits for PROGRAM to terminate\n\
160 and returns a numeric exit status or a signal description string.\n\
161 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
164 register Lisp_Object
*args
;
166 Lisp_Object infile
, buffer
, current_dir
, display
, path
;
171 int count
= specpdl_ptr
- specpdl
;
172 register unsigned char **new_argv
173 = (unsigned char **) alloca ((max (2, nargs
- 2)) * sizeof (char *));
174 struct buffer
*old
= current_buffer
;
175 #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
176 char *outf
, *tempfile
;
182 CHECK_STRING (args
[0], 0);
185 /* Without asynchronous processes we cannot have BUFFER == 0. */
186 if (nargs
>= 3 && XTYPE (args
[2]) == Lisp_Int
)
187 error ("Operating system cannot handle asynchronous subprocesses");
188 #endif /* subprocesses */
190 if (nargs
>= 2 && ! NILP (args
[1]))
192 infile
= Fexpand_file_name (args
[1], current_buffer
->directory
);
193 CHECK_STRING (infile
, 1);
196 infile
= build_string (NULL_DEVICE
);
200 register Lisp_Object tem
;
202 buffer
= tem
= args
[2];
205 || XFASTINT (tem
) == 0))
207 buffer
= Fget_buffer (tem
);
208 CHECK_BUFFER (buffer
, 2);
214 /* Make sure that the child will be able to chdir to the current
215 buffer's current directory, or its unhandled equivalent. We
216 can't just have the child check for an error when it does the
217 chdir, since it's in a vfork.
219 We have to GCPRO around this because Fexpand_file_name,
220 Funhandled_file_name_directory, and Ffile_accessible_directory_p
221 might call a file name handling function. The argument list is
222 protected by the caller, so all we really have to worry about is
225 struct gcpro gcpro1
, gcpro2
, gcpro3
;
227 current_dir
= current_buffer
->directory
;
229 GCPRO3 (infile
, buffer
, current_dir
);
232 expand_and_dir_to_file
233 (Funhandled_file_name_directory (current_dir
), Qnil
);
234 if (NILP (Ffile_accessible_directory_p (current_dir
)))
235 report_file_error ("Setting current directory",
236 Fcons (current_buffer
->directory
, Qnil
));
241 display
= nargs
>= 4 ? args
[3] : Qnil
;
245 for (i
= 4; i
< nargs
; i
++)
247 CHECK_STRING (args
[i
], i
);
248 new_argv
[i
- 3] = XSTRING (args
[i
])->data
;
250 /* Program name is first command arg */
251 new_argv
[0] = XSTRING (args
[0])->data
;
255 filefd
= open (XSTRING (infile
)->data
, O_RDONLY
, 0);
258 report_file_error ("Opening process input file", Fcons (infile
, Qnil
));
260 /* Search for program; barf if not found. */
261 openp (Vexec_path
, args
[0], EXEC_SUFFIXES
, &path
, 1);
265 report_file_error ("Searching for program", Fcons (args
[0], Qnil
));
267 new_argv
[0] = XSTRING (path
)->data
;
269 #ifdef MSDOS /* MW, July 1993 */
270 /* These vars record information from process termination.
271 Clear them now before process can possibly terminate,
272 to avoid timing error if process terminates soon. */
273 synch_process_death
= 0;
274 synch_process_retcode
= 0;
276 if ((outf
= egetenv ("TMP")) || (outf
= egetenv ("TEMP")))
277 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
280 tempfile
= alloca (20);
283 dostounix_filename (tempfile
);
284 if (*tempfile
== '\0' || tempfile
[strlen (tempfile
) - 1] != '/')
285 strcat (tempfile
, "/");
286 strcat (tempfile
, "detmp.XXX");
289 outfilefd
= creat (tempfile
, S_IREAD
| S_IWRITE
);
293 report_file_error ("Opening process output file", Fcons (tempfile
, Qnil
));
297 if (XTYPE (buffer
) == Lisp_Int
)
298 fd
[1] = open (NULL_DEVICE
, O_WRONLY
), fd
[0] = -1;
305 /* Replaced by close_process_descs */
306 set_exclusive_use (fd
[0]);
311 /* child_setup must clobber environ in systems with true vfork.
312 Protect it from permanent change. */
313 register char **save_environ
= environ
;
314 register int fd1
= fd
[1];
316 #if 0 /* Some systems don't have sigblock. */
317 mask
= sigblock (sigmask (SIGCHLD
));
320 /* Record that we're about to create a synchronous process. */
321 synch_process_alive
= 1;
323 /* These vars record information from process termination.
324 Clear them now before process can possibly terminate,
325 to avoid timing error if process terminates soon. */
326 synch_process_death
= 0;
327 synch_process_retcode
= 0;
329 #ifdef MSDOS /* MW, July 1993 */
330 pid
= run_msdos_command (new_argv
, current_dir
, filefd
, outfilefd
);
332 fd1
= -1; /* No harm in closing that one! */
333 fd
[0] = open (tempfile
, NILP (Vbinary_process
) ? O_TEXT
: O_BINARY
);
337 report_file_error ("Cannot re-open temporary file", Qnil
);
339 #else /* not MSDOS */
351 child_setup (filefd
, fd1
, fd1
, new_argv
, 0, current_dir
);
353 #endif /* not MSDOS */
356 /* Tell SIGCHLD handler to look for this pid. */
357 synch_process_pid
= pid
;
358 /* Now let SIGCHLD come through. */
362 environ
= save_environ
;
372 report_file_error ("Doing vfork", Qnil
);
375 if (XTYPE (buffer
) == Lisp_Int
)
378 /* If Emacs has been built with asynchronous subprocess support,
379 we don't need to do this, I think because it will then have
380 the facilities for handling SIGCHLD. */
381 wait_without_blocking ();
382 #endif /* subprocesses */
386 call_process_exited
= 0;
389 /* MSDOS needs different cleanup information. */
390 record_unwind_protect (call_process_cleanup
,
391 Fcons (make_number (fd
[0]), build_string (tempfile
)));
393 record_unwind_protect (call_process_cleanup
,
394 Fcons (make_number (fd
[0]), make_number (pid
)));
395 #endif /* not MSDOS */
398 if (XTYPE (buffer
) == Lisp_Buffer
)
399 Fset_buffer (buffer
);
408 while ((nread
= read (fd
[0], buf
, sizeof buf
)) > 0)
413 if (!NILP (display
) && INTERACTIVE
)
416 prepare_menu_bars ();
418 redisplay_preserve_echo_area ();
425 /* Wait for it to terminate, unless it already has. */
426 wait_for_termination (pid
);
430 set_buffer_internal (old
);
432 /* Don't kill any children that the subprocess may have left behind
434 call_process_exited
= 1;
436 unbind_to (count
, Qnil
);
438 if (synch_process_death
)
439 return build_string (synch_process_death
);
440 return make_number (synch_process_retcode
);
445 delete_temp_file (name
)
448 unlink (XSTRING (name
)->data
);
451 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
453 "Send text from START to END to a synchronous process running PROGRAM.\n\
454 Delete the text if fourth arg DELETE is non-nil.\n\
455 Insert output in BUFFER before point; t means current buffer;\n\
456 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
457 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
458 Remaining args are passed to PROGRAM at startup as command args.\n\
459 If BUFFER is nil, returns immediately with value nil.\n\
460 Otherwise waits for PROGRAM to terminate\n\
461 and returns a numeric exit status or a signal description string.\n\
462 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
465 register Lisp_Object
*args
;
467 register Lisp_Object filename_string
, start
, end
;
473 int count
= specpdl_ptr
- specpdl
;
477 if ((outf
= egetenv ("TMP")) || (outf
= egetenv ("TEMP")))
478 strcpy (tempfile
= alloca (strlen (outf
) + 20), outf
);
481 tempfile
= alloca (20);
484 dostounix_filename (tempfile
);
485 if (tempfile
[strlen (tempfile
) - 1] != '/')
486 strcat (tempfile
, "/");
487 strcat (tempfile
, "detmp.XXX");
488 #else /* not MSDOS */
491 strcpy (tempfile
, "tmp:emacsXXXXXX.");
493 strcpy (tempfile
, "/tmp/emacsXXXXXX");
495 #endif /* not MSDOS */
499 filename_string
= build_string (tempfile
);
502 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
);
503 record_unwind_protect (delete_temp_file
, filename_string
);
506 Fdelete_region (start
, end
);
508 args
[3] = filename_string
;
510 return unbind_to (count
, Fcall_process (nargs
- 2, args
+ 2));
513 #ifndef VMS /* VMS version is in vmsproc.c. */
515 /* This is the last thing run in a newly forked inferior
516 either synchronous or asynchronous.
517 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
518 Initialize inferior's priority, pgrp, connected dir and environment.
519 then exec another program based on new_argv.
521 This function may change environ for the superior process.
522 Therefore, the superior process must save and restore the value
523 of environ around the vfork and the call to this function.
525 ENV is the environment for the subprocess.
527 SET_PGRP is nonzero if we should put the subprocess into a separate
530 CURRENT_DIR is an elisp string giving the path of the current
531 directory the subprocess should have. Since we can't really signal
532 a decent error from within the child, this should be verified as an
533 executable directory by the parent. */
535 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
537 register char **new_argv
;
539 Lisp_Object current_dir
;
542 /* The MSDOS port of gcc cannot fork, vfork, ... so we must call system
544 #else /* not MSDOS */
550 extern int emacs_priority
;
552 nice (- emacs_priority
);
556 /* Close Emacs's descriptors that this process should not have. */
557 close_process_descs ();
561 /* Note that use of alloca is always safe here. It's obvious for systems
562 that do not have true vfork or that have true (stack) alloca.
563 If using vfork and C_ALLOCA it is safe because that changes
564 the superior's static variables as if the superior had done alloca
565 and will be cleaned up in the usual way. */
567 register unsigned char *temp
;
570 i
= XSTRING (current_dir
)->size
;
571 temp
= (unsigned char *) alloca (i
+ 2);
572 bcopy (XSTRING (current_dir
)->data
, temp
, i
);
573 if (temp
[i
- 1] != '/') temp
[i
++] = '/';
576 /* We can't signal an Elisp error here; we're in a vfork. Since
577 the callers check the current directory before forking, this
578 should only return an error if the directory's permissions
579 are changed between the check and this chdir, but we should
581 if (chdir (temp
) < 0)
585 /* Set `env' to a vector of the strings in Vprocess_environment. */
587 register Lisp_Object tem
;
588 register char **new_env
;
589 register int new_length
;
592 for (tem
= Vprocess_environment
;
593 (XTYPE (tem
) == Lisp_Cons
594 && XTYPE (XCONS (tem
)->car
) == Lisp_String
);
595 tem
= XCONS (tem
)->cdr
)
598 /* new_length + 1 to include terminating 0. */
599 env
= new_env
= (char **) alloca ((new_length
+ 1) * sizeof (char *));
601 /* Copy the Vprocess_environment strings into new_env. */
602 for (tem
= Vprocess_environment
;
603 (XTYPE (tem
) == Lisp_Cons
604 && XTYPE (XCONS (tem
)->car
) == Lisp_String
);
605 tem
= XCONS (tem
)->cdr
)
608 char *string
= (char *) XSTRING (XCONS (tem
)->car
)->data
;
609 /* See if this string duplicates any string already in the env.
610 If so, don't put it in.
611 When an env var has multiple definitions,
612 we keep the definition that comes first in process-environment. */
613 for (; ep
!= new_env
; ep
++)
615 char *p
= *ep
, *q
= string
;
619 /* The string is malformed; might as well drop it. */
634 /* Make sure that in, out, and err are not actually already in
635 descriptors zero, one, or two; this could happen if Emacs is
636 started with its standard in, out, or error closed, as might
638 in
= relocate_fd (in
, 3);
639 out
= relocate_fd (out
, 3);
640 err
= relocate_fd (err
, 3);
654 #ifndef SETPGRP_RELEASES_CTTY
655 setpgrp (); /* No arguments but equivalent in this case */
660 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
661 EMACS_SET_TTY_PGRP (0, &pid
);
664 something missing here
;
667 /* execvp does not accept an environment arg so the only way
668 to pass this environment is to set environ. Our caller
669 is responsible for restoring the ambient value of environ. */
671 execvp (new_argv
[0], new_argv
);
673 write (1, "Couldn't exec the program ", 26);
674 write (1, new_argv
[0], strlen (new_argv
[0]));
676 #endif /* not MSDOS */
679 /* Move the file descriptor FD so that its number is not less than MIN.
680 If the file descriptor is moved at all, the original is freed. */
682 relocate_fd (fd
, min
)
692 char *message1
= "Error while setting up child: ";
693 char *errmessage
= strerror (errno
);
694 char *message2
= "\n";
695 write (2, message1
, strlen (message1
));
696 write (2, errmessage
, strlen (errmessage
));
697 write (2, message2
, strlen (message2
));
700 /* Note that we hold the original FD open while we recurse,
701 to guarantee we'll get a new FD if we need it. */
702 new = relocate_fd (new, min
);
709 getenv_internal (var
, varlen
, value
, valuelen
)
717 for (scan
= Vprocess_environment
; CONSP (scan
); scan
= XCONS (scan
)->cdr
)
719 Lisp_Object entry
= XCONS (scan
)->car
;
721 if (XTYPE (entry
) == Lisp_String
722 && XSTRING (entry
)->size
> varlen
723 && XSTRING (entry
)->data
[varlen
] == '='
724 && ! bcmp (XSTRING (entry
)->data
, var
, varlen
))
726 *value
= (char *) XSTRING (entry
)->data
+ (varlen
+ 1);
727 *valuelen
= XSTRING (entry
)->size
- (varlen
+ 1);
735 DEFUN ("getenv", Fgetenv
, Sgetenv
, 1, 1, 0,
736 "Return the value of environment variable VAR, as a string.\n\
737 VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
738 This function consults the variable ``process-environment'' for its value.")
745 CHECK_STRING (var
, 0);
746 if (getenv_internal (XSTRING (var
)->data
, XSTRING (var
)->size
,
748 return make_string (value
, valuelen
);
753 /* A version of getenv that consults process_environment, easily
762 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
))
770 /* This is run before init_cmdargs. */
774 char *data_dir
= egetenv ("EMACSDATA");
775 char *doc_dir
= egetenv ("EMACSDOC");
778 = Ffile_name_as_directory (build_string (data_dir
? data_dir
781 = Ffile_name_as_directory (build_string (doc_dir
? doc_dir
784 /* Check the EMACSPATH environment variable, defaulting to the
785 PATH_EXEC path from paths.h. */
786 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
787 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
788 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
791 /* This is run after init_cmdargs, so that Vinvocation_directory is valid. */
795 char *data_dir
= egetenv ("EMACSDATA");
800 if (initialized
&& !NILP (Vinstallation_directory
))
802 /* Add to the path the lib-src subdir of the installation dir. */
804 tem
= Fexpand_file_name (build_string ("lib-src"),
805 Vinstallation_directory
);
806 if (NILP (Fmember (tem
, Vexec_path
)))
808 Vexec_path
= nconc2 (Vexec_path
, Fcons (tem
, Qnil
));
809 Vexec_directory
= Ffile_name_as_directory (tem
);
811 /* If we use ../lib-src, maybe use ../etc as well.
812 Do so if ../etc exists and has our DOC-... file in it. */
815 tem
= Fexpand_file_name (build_string ("etc"),
816 Vinstallation_directory
);
817 Vdata_directory
= Ffile_name_as_directory (tem
);
822 tempdir
= Fdirectory_file_name (Vexec_directory
);
823 if (access (XSTRING (tempdir
)->data
, 0) < 0)
826 "Warning: arch-dependent data dir (%s) does not exist.\n",
827 XSTRING (Vexec_directory
)->data
);
831 tempdir
= Fdirectory_file_name (Vdata_directory
);
832 if (access (XSTRING (tempdir
)->data
, 0) < 0)
835 "Warning: arch-independent data dir (%s) does not exist.\n",
836 XSTRING (Vdata_directory
)->data
);
841 Vshell_file_name
= build_string ("*dcl*");
843 sh
= (char *) getenv ("SHELL");
844 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
848 set_process_environment ()
850 register char **envp
;
852 Vprocess_environment
= Qnil
;
856 for (envp
= environ
; *envp
; envp
++)
857 Vprocess_environment
= Fcons (build_string (*envp
),
858 Vprocess_environment
);
864 DEFVAR_LISP ("binary-process", &Vbinary_process
,
865 "*If non-nil then new subprocesses are assumed to produce binary output.");
866 Vbinary_process
= Qnil
;
869 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
870 "*File name to load inferior shells from.\n\
871 Initialized from the SHELL environment variable.");
873 DEFVAR_LISP ("exec-path", &Vexec_path
,
874 "*List of directories to search programs to run in subprocesses.\n\
875 Each element is a string (directory name) or nil (try default directory).");
877 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
878 "Directory of architecture-dependent files that come with GNU Emacs,\n\
879 especially executable programs intended for Emacs to invoke.");
881 DEFVAR_LISP ("data-directory", &Vdata_directory
,
882 "Directory of architecture-independent files that come with GNU Emacs,\n\
883 intended for Emacs to use.");
885 DEFVAR_LISP ("doc-directory", &Vdoc_directory
,
886 "Directory containing the DOC file that comes with GNU Emacs.\n\
887 This is usually the same as data-directory.");
889 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
890 "For internal use by the build procedure only.\n\
891 This is the name of the directory in which the build procedure installed\n\
892 Emacs's info files; the default value for Info-default-directory-list\n\
894 Vconfigure_info_directory
= build_string (PATH_INFO
);
896 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
897 "List of environment variables for subprocesses to inherit.\n\
898 Each element should be a string of the form ENVVARNAME=VALUE.\n\
899 The environment which Emacs inherits is placed in this variable\n\
900 when Emacs starts.");
903 defsubr (&Scall_process
);
906 defsubr (&Scall_process_region
);