1 /* Synchronous subprocess invocation for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993 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 1, 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 *sys_errlist
[];
31 /* Define SIGCHLD as an alias for SIGCLD. */
33 #if !defined (SIGCHLD) && defined (SIGCLD)
34 #define SIGCHLD SIGCLD
37 #include <sys/types.h>
57 #include "syssignal.h"
61 extern noshare
char **environ
;
63 extern char **environ
;
66 #define max(a, b) ((a) > (b) ? (a) : (b))
68 Lisp_Object Vexec_path
, Vexec_directory
, Vdata_directory
;
69 Lisp_Object Vconfigure_info_directory
;
71 Lisp_Object Vshell_file_name
;
73 Lisp_Object Vprocess_environment
;
75 /* True iff we are about to fork off a synchronous process or if we
76 are waiting for it. */
77 int synch_process_alive
;
79 /* Nonzero => this is a string explaining death of synchronous subprocess. */
80 char *synch_process_death
;
82 /* If synch_process_death is zero,
83 this is exit code of synchronous subprocess. */
84 int synch_process_retcode
;
86 extern Lisp_Object Vdoc_file_name
;
88 #ifndef VMS /* VMS version is in vmsproc.c. */
91 call_process_kill (fdpid
)
94 close (XFASTINT (Fcar (fdpid
)));
95 EMACS_KILLPG (XFASTINT (Fcdr (fdpid
)), SIGKILL
);
96 synch_process_alive
= 0;
101 call_process_cleanup (fdpid
)
104 register int pid
= XFASTINT (Fcdr (fdpid
));
106 if (EMACS_KILLPG (pid
, SIGINT
) == 0)
108 int count
= specpdl_ptr
- specpdl
;
109 record_unwind_protect (call_process_kill
, fdpid
);
110 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
113 wait_for_termination (pid
);
115 specpdl_ptr
= specpdl
+ count
; /* Discard the unwind protect. */
116 message1 ("Waiting for process to die...done");
118 synch_process_alive
= 0;
119 close (XFASTINT (Fcar (fdpid
)));
123 DEFUN ("call-process", Fcall_process
, Scall_process
, 1, MANY
, 0,
124 "Call PROGRAM synchronously in separate process.\n\
125 The program's input comes from file INFILE (nil means `/dev/null').\n\
126 Insert output in BUFFER before point; t means current buffer;\n\
127 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
128 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
129 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
130 If BUFFER is 0, returns immediately with value nil.\n\
131 Otherwise waits for PROGRAM to terminate\n\
132 and returns a numeric exit status or a signal description string.\n\
133 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
136 register Lisp_Object
*args
;
138 Lisp_Object infile
, buffer
, current_dir
, display
, path
;
143 int count
= specpdl_ptr
- specpdl
;
144 register unsigned char **new_argv
145 = (unsigned char **) alloca ((max (2, nargs
- 2)) * sizeof (char *));
146 struct buffer
*old
= current_buffer
;
150 CHECK_STRING (args
[0], 0);
152 if (nargs
>= 2 && ! NILP (args
[1]))
154 infile
= Fexpand_file_name (args
[1], current_buffer
->directory
);
155 CHECK_STRING (infile
, 1);
158 infile
= build_string (NULL_DEVICE
);
162 register Lisp_Object tem
;
164 buffer
= tem
= args
[2];
167 || XFASTINT (tem
) == 0))
169 buffer
= Fget_buffer (tem
);
170 CHECK_BUFFER (buffer
, 2);
176 /* Make sure that the child will be able to chdir to the current
177 buffer's current directory, or its unhandled equivalent. We
178 can't just have the child check for an error when it does the
179 chdir, since it's in a vfork.
181 We have to GCPRO around this because Fexpand_file_name,
182 Funhandled_file_name_directory, and Ffile_accessible_directory_p
183 might call a file name handling function. The argument list is
184 protected by the caller, so all we really have to worry about is
187 struct gcpro gcpro1
, gcpro2
, gcpro3
;
189 current_dir
= current_buffer
->directory
;
191 GCPRO3 (infile
, buffer
, current_dir
);
194 expand_and_dir_to_file
195 (Funhandled_file_name_directory (current_dir
), Qnil
);
196 if (NILP (Ffile_accessible_directory_p (current_dir
)))
197 report_file_error ("Setting current directory",
198 Fcons (current_buffer
->directory
, Qnil
));
203 display
= nargs
>= 4 ? args
[3] : Qnil
;
207 for (i
= 4; i
< nargs
; i
++)
209 CHECK_STRING (args
[i
], i
);
210 new_argv
[i
- 3] = XSTRING (args
[i
])->data
;
212 /* Program name is first command arg */
213 new_argv
[0] = XSTRING (args
[0])->data
;
217 filefd
= open (XSTRING (infile
)->data
, O_RDONLY
, 0);
220 report_file_error ("Opening process input file", Fcons (infile
, Qnil
));
222 /* Search for program; barf if not found. */
223 openp (Vexec_path
, args
[0], EXEC_SUFFIXES
, &path
, 1);
227 report_file_error ("Searching for program", Fcons (args
[0], Qnil
));
229 new_argv
[0] = XSTRING (path
)->data
;
231 if (XTYPE (buffer
) == Lisp_Int
)
232 fd
[1] = open (NULL_DEVICE
, O_WRONLY
), fd
[0] = -1;
237 /* Replaced by close_process_descs */
238 set_exclusive_use (fd
[0]);
243 /* child_setup must clobber environ in systems with true vfork.
244 Protect it from permanent change. */
245 register char **save_environ
= environ
;
246 register int fd1
= fd
[1];
248 #if 0 /* Some systems don't have sigblock. */
249 mask
= sigblock (sigmask (SIGCHLD
));
252 /* Record that we're about to create a synchronous process. */
253 synch_process_alive
= 1;
255 /* These vars record information from process termination.
256 Clear them now before process can possibly terminate,
257 to avoid timing error if process terminates soon. */
258 synch_process_death
= 0;
259 synch_process_retcode
= 0;
272 child_setup (filefd
, fd1
, fd1
, new_argv
, 0, current_dir
);
276 /* Tell SIGCHLD handler to look for this pid. */
277 synch_process_pid
= pid
;
278 /* Now let SIGCHLD come through. */
282 environ
= save_environ
;
291 report_file_error ("Doing vfork", Qnil
);
294 if (XTYPE (buffer
) == Lisp_Int
)
297 /* If Emacs has been built with asynchronous subprocess support,
298 we don't need to do this, I think because it will then have
299 the facilities for handling SIGCHLD. */
300 wait_without_blocking ();
301 #endif /* subprocesses */
305 record_unwind_protect (call_process_cleanup
,
306 Fcons (make_number (fd
[0]), make_number (pid
)));
309 if (XTYPE (buffer
) == Lisp_Buffer
)
310 Fset_buffer (buffer
);
319 while ((nread
= read (fd
[0], buf
, sizeof buf
)) > 0)
324 if (!NILP (display
) && INTERACTIVE
)
327 prepare_menu_bars ();
329 redisplay_preserve_echo_area ();
336 /* Wait for it to terminate, unless it already has. */
337 wait_for_termination (pid
);
341 set_buffer_internal (old
);
343 unbind_to (count
, Qnil
);
345 if (synch_process_death
)
346 return build_string (synch_process_death
);
347 return make_number (synch_process_retcode
);
352 delete_temp_file (name
)
355 unlink (XSTRING (name
)->data
);
358 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
360 "Send text from START to END to a synchronous process running PROGRAM.\n\
361 Delete the text if fourth arg DELETE is non-nil.\n\
362 Insert output in BUFFER before point; t means current buffer;\n\
363 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
364 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
365 Remaining args are passed to PROGRAM at startup as command args.\n\
366 If BUFFER is nil, returns immediately with value nil.\n\
367 Otherwise waits for PROGRAM to terminate\n\
368 and returns a numeric exit status or a signal description string.\n\
369 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
372 register Lisp_Object
*args
;
374 register Lisp_Object filename_string
, start
, end
;
376 int count
= specpdl_ptr
- specpdl
;
379 strcpy (tempfile
, "tmp:emacsXXXXXX.");
381 strcpy (tempfile
, "/tmp/emacsXXXXXX");
385 filename_string
= build_string (tempfile
);
388 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
);
389 record_unwind_protect (delete_temp_file
, filename_string
);
392 Fdelete_region (start
, end
);
394 args
[3] = filename_string
;
396 return unbind_to (count
, Fcall_process (nargs
- 2, args
+ 2));
399 #ifndef VMS /* VMS version is in vmsproc.c. */
401 /* This is the last thing run in a newly forked inferior
402 either synchronous or asynchronous.
403 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
404 Initialize inferior's priority, pgrp, connected dir and environment.
405 then exec another program based on new_argv.
407 This function may change environ for the superior process.
408 Therefore, the superior process must save and restore the value
409 of environ around the vfork and the call to this function.
411 ENV is the environment for the subprocess.
413 SET_PGRP is nonzero if we should put the subprocess into a separate
416 CURRENT_DIR is an elisp string giving the path of the current
417 directory the subprocess should have. Since we can't really signal
418 a decent error from within the child, this should be verified as an
419 executable directory by the parent. */
421 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
423 register char **new_argv
;
425 Lisp_Object current_dir
;
429 register int pid
= getpid();
432 extern int emacs_priority
;
434 nice (- emacs_priority
);
438 /* Close Emacs's descriptors that this process should not have. */
439 close_process_descs ();
442 /* Note that use of alloca is always safe here. It's obvious for systems
443 that do not have true vfork or that have true (stack) alloca.
444 If using vfork and C_ALLOCA it is safe because that changes
445 the superior's static variables as if the superior had done alloca
446 and will be cleaned up in the usual way. */
448 register unsigned char *temp
;
451 i
= XSTRING (current_dir
)->size
;
452 temp
= (unsigned char *) alloca (i
+ 2);
453 bcopy (XSTRING (current_dir
)->data
, temp
, i
);
454 if (temp
[i
- 1] != '/') temp
[i
++] = '/';
457 /* We can't signal an Elisp error here; we're in a vfork. Since
458 the callers check the current directory before forking, this
459 should only return an error if the directory's permissions
460 are changed between the check and this chdir, but we should
462 if (chdir (temp
) < 0)
466 /* Set `env' to a vector of the strings in Vprocess_environment. */
468 register Lisp_Object tem
;
469 register char **new_env
;
470 register int new_length
;
473 for (tem
= Vprocess_environment
;
474 (XTYPE (tem
) == Lisp_Cons
475 && XTYPE (XCONS (tem
)->car
) == Lisp_String
);
476 tem
= XCONS (tem
)->cdr
)
479 /* new_length + 1 to include terminating 0. */
480 env
= new_env
= (char **) alloca ((new_length
+ 1) * sizeof (char *));
482 /* Copy the Vprocess_environment strings into new_env. */
483 for (tem
= Vprocess_environment
;
484 (XTYPE (tem
) == Lisp_Cons
485 && XTYPE (XCONS (tem
)->car
) == Lisp_String
);
486 tem
= XCONS (tem
)->cdr
)
489 char *string
= (char *) XSTRING (XCONS (tem
)->car
)->data
;
490 /* See if this string duplicates any string already in the env.
491 If so, don't put it in.
492 When an env var has multiple definitions,
493 we keep the definition that comes first in process-environment. */
494 for (; ep
!= new_env
; ep
++)
496 char *p
= *ep
, *q
= string
;
500 /* The string is malformed; might as well drop it. */
515 /* Make sure that in, out, and err are not actually already in
516 descriptors zero, one, or two; this could happen if Emacs is
517 started with its standard in, our, or error closed, as might
519 in
= relocate_fd (in
, 3);
520 out
= relocate_fd (out
, 3);
521 err
= relocate_fd (err
, 3);
535 #ifndef SETPGRP_RELEASES_CTTY
536 setpgrp (); /* No arguments but equivalent in this case */
541 /* setpgrp_of_tty is incorrect here; it uses input_fd. */
542 EMACS_SET_TTY_PGRP (0, &pid
);
545 something missing here
;
548 /* execvp does not accept an environment arg so the only way
549 to pass this environment is to set environ. Our caller
550 is responsible for restoring the ambient value of environ. */
552 execvp (new_argv
[0], new_argv
);
554 write (1, "Couldn't exec the program ", 26);
555 write (1, new_argv
[0], strlen (new_argv
[0]));
559 /* Move the file descriptor FD so that its number is not less than MIN.
560 If the file descriptor is moved at all, the original is freed. */
562 relocate_fd (fd
, min
)
572 char *message1
= "Error while setting up child: ";
573 char *message2
= "\n";
574 write (2, message1
, strlen (message1
));
575 write (2, sys_errlist
[errno
], strlen (sys_errlist
[errno
]));
576 write (2, message2
, strlen (message2
));
579 /* Note that we hold the original FD open while we recurse,
580 to guarantee we'll get a new FD if we need it. */
581 new = relocate_fd (new, min
);
588 getenv_internal (var
, varlen
, value
, valuelen
)
596 for (scan
= Vprocess_environment
; CONSP (scan
); scan
= XCONS (scan
)->cdr
)
598 Lisp_Object entry
= XCONS (scan
)->car
;
600 if (XTYPE (entry
) == Lisp_String
601 && XSTRING (entry
)->size
> varlen
602 && XSTRING (entry
)->data
[varlen
] == '='
603 && ! bcmp (XSTRING (entry
)->data
, var
, varlen
))
605 *value
= (char *) XSTRING (entry
)->data
+ (varlen
+ 1);
606 *valuelen
= XSTRING (entry
)->size
- (varlen
+ 1);
614 DEFUN ("getenv", Fgetenv
, Sgetenv
, 1, 1, 0,
615 "Return the value of environment variable VAR, as a string.\n\
616 VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
617 This function consults the variable ``process-environment'' for its value.")
624 CHECK_STRING (var
, 0);
625 if (getenv_internal (XSTRING (var
)->data
, XSTRING (var
)->size
,
627 return make_string (value
, valuelen
);
632 /* A version of getenv that consults process_environment, easily
641 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
))
649 /* This is run before init_cmdargs. */
653 char *data_dir
= egetenv ("EMACSDATA");
656 = Ffile_name_as_directory (build_string (data_dir
? data_dir
659 /* Check the EMACSPATH environment variable, defaulting to the
660 PATH_EXEC path from paths.h. */
661 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
662 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
663 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
666 /* This is run after init_cmdargs, so that Vinvocation_directory is valid. */
670 char *data_dir
= egetenv ("EMACSDATA");
675 if (initialized
&& !NILP (Vinvocation_directory
))
677 /* Add to the path the ../lib-src dir of the Emacs executable,
678 if that dir exists. */
679 Lisp_Object tem
, tem1
;
680 tem
= Fexpand_file_name (build_string ("../lib-src"),
681 Vinvocation_directory
);
682 tem1
= Ffile_exists_p (tem
);
683 if (!NILP (tem1
) && NILP (Fmember (tem
, Vexec_path
)))
685 Vexec_path
= nconc2 (Vexec_path
, Fcons (tem
, Qnil
));
686 Vexec_directory
= Ffile_name_as_directory (tem
);
688 /* If we use ../lib-src, maybe use ../etc as well.
689 Do so if ../etc exists and has our DOC-... file in it. */
692 Lisp_Object tem
, tem2
, tem3
;
693 tem
= Fexpand_file_name (build_string ("../etc"),
694 Vinvocation_directory
);
695 tem2
= Fexpand_file_name (Vdoc_file_name
, tem
);
696 tem3
= Ffile_exists_p (tem2
);
698 Vdata_directory
= Ffile_name_as_directory (tem
);
703 tempdir
= Fdirectory_file_name (Vexec_directory
);
704 if (access (XSTRING (tempdir
)->data
, 0) < 0)
706 printf ("Warning: arch-dependent data dir (%s) does not exist.\n",
707 XSTRING (Vexec_directory
)->data
);
711 tempdir
= Fdirectory_file_name (Vdata_directory
);
712 if (access (XSTRING (tempdir
)->data
, 0) < 0)
714 printf ("Warning: arch-independent data dir (%s) does not exist.\n",
715 XSTRING (Vdata_directory
)->data
);
720 Vshell_file_name
= build_string ("*dcl*");
722 sh
= (char *) getenv ("SHELL");
723 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
727 set_process_environment ()
729 register char **envp
;
731 Vprocess_environment
= Qnil
;
735 for (envp
= environ
; *envp
; envp
++)
736 Vprocess_environment
= Fcons (build_string (*envp
),
737 Vprocess_environment
);
742 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
743 "*File name to load inferior shells from.\n\
744 Initialized from the SHELL environment variable.");
746 DEFVAR_LISP ("exec-path", &Vexec_path
,
747 "*List of directories to search programs to run in subprocesses.\n\
748 Each element is a string (directory name) or nil (try default directory).");
750 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
751 "Directory of architecture-dependent files that come with GNU Emacs,\n\
752 especially executable programs intended for Emacs to invoke.");
754 DEFVAR_LISP ("data-directory", &Vdata_directory
,
755 "Directory of architecture-independent files that come with GNU Emacs,\n\
756 intended for Emacs to use.");
758 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory
,
759 "For internal use by the build procedure only.\n\
760 This is the name of the directory in which the build procedure installed\n\
761 Emacs's info files; the default value for Info-default-directory-list\n\
763 Vconfigure_info_directory
= build_string (PATH_INFO
);
765 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
766 "List of environment variables for subprocesses to inherit.\n\
767 Each element should be a string of the form ENVVARNAME=VALUE.\n\
768 The environment which Emacs inherits is placed in this variable\n\
769 when Emacs starts.");
772 defsubr (&Scall_process
);
775 defsubr (&Scall_process_region
);