1 /* Synchronous subprocess invocation for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1992 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. */
26 /* Define SIGCHLD as an alias for SIGCLD. */
28 #if !defined (SIGCHLD) && defined (SIGCLD)
29 #define SIGCHLD SIGCLD
32 #include <sys/types.h>
33 #define PRIO_PROCESS 0
54 extern noshare
char **environ
;
56 extern char **environ
;
59 #define max(a, b) ((a) > (b) ? (a) : (b))
61 Lisp_Object Vexec_path
, Vexec_directory
, Vdata_directory
;
63 Lisp_Object Vshell_file_name
;
65 Lisp_Object Vprocess_environment
;
67 /* True iff we are about to fork off a synchronous process or if we
68 are waiting for it. */
69 int synch_process_alive
;
71 /* Nonzero => this is a string explaining death of synchronous subprocess. */
72 char *synch_process_death
;
74 /* If synch_process_death is zero,
75 this is exit code of synchronous subprocess. */
76 int synch_process_retcode
;
78 #ifndef VMS /* VMS version is in vmsproc.c. */
81 call_process_cleanup (fdpid
)
84 register Lisp_Object fd
, pid
;
87 close (XFASTINT (fd
));
88 kill (XFASTINT (pid
), SIGKILL
);
89 synch_process_alive
= 0;
93 DEFUN ("call-process", Fcall_process
, Scall_process
, 1, MANY
, 0,
94 "Call PROGRAM synchronously in separate process.\n\
95 The program's input comes from file INFILE (nil means `/dev/null').\n\
96 Insert output in BUFFER before point; t means current buffer;\n\
97 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
98 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
99 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
100 If BUFFER is nil or 0, returns immediately with value nil.\n\
101 Otherwise waits for PROGRAM to terminate\n\
102 and returns a numeric exit status or a signal name as a string.\n\
103 If you quit, the process is killed with SIGKILL.")
106 register Lisp_Object
*args
;
108 Lisp_Object display
, infile
, buffer
, path
, current_dir
;
113 int count
= specpdl_ptr
- specpdl
;
114 register unsigned char **new_argv
115 = (unsigned char **) alloca ((max (2, nargs
- 2)) * sizeof (char *));
116 struct buffer
*old
= current_buffer
;
120 CHECK_STRING (args
[0], 0);
122 if (nargs
>= 2 && ! NILP (args
[1]))
124 infile
= Fexpand_file_name (args
[1], current_buffer
->directory
);
125 CHECK_STRING (infile
, 1);
128 infile
= build_string ("/dev/null");
131 register Lisp_Object tem
;
136 buffer
= tem
= args
[2];
137 if (!(EQ (tem
, Qnil
) || EQ (tem
, Qt
)
138 || XFASTINT (tem
) == 0))
140 buffer
= Fget_buffer (tem
);
141 CHECK_BUFFER (buffer
, 2);
146 display
= nargs
>= 3 ? args
[3] : Qnil
;
150 for (i
= 4; i
< nargs
; i
++)
152 CHECK_STRING (args
[i
], i
);
153 new_argv
[i
- 3] = XSTRING (args
[i
])->data
;
155 /* Program name is first command arg */
156 new_argv
[0] = XSTRING (args
[0])->data
;
160 filefd
= open (XSTRING (infile
)->data
, O_RDONLY
, 0);
163 report_file_error ("Opening process input file", Fcons (infile
, Qnil
));
165 /* Search for program; barf if not found. */
166 openp (Vexec_path
, args
[0], "", &path
, 1);
170 report_file_error ("Searching for program", Fcons (args
[0], Qnil
));
172 new_argv
[0] = XSTRING (path
)->data
;
174 if (XTYPE (buffer
) == Lisp_Int
)
175 fd
[1] = open ("/dev/null", O_WRONLY
), fd
[0] = -1;
180 /* Replaced by close_process_descs */
181 set_exclusive_use (fd
[0]);
185 /* Make sure that the child will be able to chdir to the current
186 buffer's current directory. We can't just have the child check
187 for an error when it does the chdir, since it's in a vfork. */
188 current_dir
= expand_and_dir_to_file (current_buffer
->directory
, Qnil
);
189 if (NILP (Ffile_accessible_directory_p (current_dir
)))
190 report_file_error ("Setting current directory",
191 Fcons (current_buffer
->directory
, Qnil
));
194 /* child_setup must clobber environ in systems with true vfork.
195 Protect it from permanent change. */
196 register char **save_environ
= environ
;
197 register int fd1
= fd
[1];
199 #if 0 /* Some systems don't have sigblock. */
200 mask
= sigblock (sigmask (SIGCHLD
));
203 /* Record that we're about to create a synchronous process. */
204 synch_process_alive
= 1;
217 child_setup (filefd
, fd1
, fd1
, new_argv
, 0, current_dir
);
221 /* Tell SIGCHLD handler to look for this pid. */
222 synch_process_pid
= pid
;
223 /* Now let SIGCHLD come through. */
227 environ
= save_environ
;
236 report_file_error ("Doing vfork", Qnil
);
239 if (XTYPE (buffer
) == Lisp_Int
)
242 /* If Emacs has been built with asynchronous subprocess support,
243 we don't need to do this, I think because it will then have
244 the facilities for handling SIGCHLD. */
245 wait_without_blocking ();
246 #endif /* subprocesses */
250 synch_process_death
= 0;
251 synch_process_retcode
= 0;
253 record_unwind_protect (call_process_cleanup
,
254 Fcons (make_number (fd
[0]), make_number (pid
)));
257 if (XTYPE (buffer
) == Lisp_Buffer
)
258 Fset_buffer (buffer
);
266 while ((nread
= read (fd
[0], buf
, sizeof buf
)) > 0)
271 if (!NILP (display
) && INTERACTIVE
)
272 redisplay_preserve_echo_area ();
278 /* Wait for it to terminate, unless it already has. */
279 wait_for_termination (pid
);
283 set_buffer_internal (old
);
285 unbind_to (count
, Qnil
);
287 if (synch_process_death
)
288 return build_string (synch_process_death
);
289 return make_number (synch_process_retcode
);
294 delete_temp_file (name
)
297 unlink (XSTRING (name
)->data
);
300 DEFUN ("call-process-region", Fcall_process_region
, Scall_process_region
,
302 "Send text from START to END to a synchronous process running PROGRAM.\n\
303 Delete the text if fourth arg DELETE is non-nil.\n\
304 Insert output in BUFFER before point; t means current buffer;\n\
305 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
306 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
307 Remaining args are passed to PROGRAM at startup as command args.\n\
308 If BUFFER is nil, returns immediately with value nil.\n\
309 Otherwise waits for PROGRAM to terminate\n\
310 and returns a numeric exit status or a signal name as a string.\n\
311 If you quit, the process is killed with SIGKILL.")
314 register Lisp_Object
*args
;
316 register Lisp_Object filename_string
, start
, end
;
318 int count
= specpdl_ptr
- specpdl
;
321 strcpy (tempfile
, "tmp:emacsXXXXXX.");
323 strcpy (tempfile
, "/tmp/emacsXXXXXX");
327 filename_string
= build_string (tempfile
);
330 Fwrite_region (start
, end
, filename_string
, Qnil
, Qlambda
);
331 record_unwind_protect (delete_temp_file
, filename_string
);
334 Fdelete_region (start
, end
);
336 args
[3] = filename_string
;
337 Fcall_process (nargs
- 2, args
+ 2);
339 return unbind_to (count
, Qnil
);
342 #ifndef VMS /* VMS version is in vmsproc.c. */
344 /* This is the last thing run in a newly forked inferior
345 either synchronous or asynchronous.
346 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
347 Initialize inferior's priority, pgrp, connected dir and environment.
348 then exec another program based on new_argv.
350 This function may change environ for the superior process.
351 Therefore, the superior process must save and restore the value
352 of environ around the vfork and the call to this function.
354 ENV is the environment for the subprocess.
356 SET_PGRP is nonzero if we should put the subprocess into a separate
359 CURRENT_DIR is an elisp string giving the path of the current
360 directory the subprocess should have. Since we can't really signal
361 a decent error from within the child, this should be verified as an
362 executable directory by the parent. */
364 child_setup (in
, out
, err
, new_argv
, set_pgrp
, current_dir
)
366 register char **new_argv
;
368 Lisp_Object current_dir
;
372 register int pid
= getpid();
374 setpriority (PRIO_PROCESS
, pid
, 0);
377 /* Close Emacs's descriptors that this process should not have. */
378 close_process_descs ();
381 /* Note that use of alloca is always safe here. It's obvious for systems
382 that do not have true vfork or that have true (stack) alloca.
383 If using vfork and C_ALLOCA it is safe because that changes
384 the superior's static variables as if the superior had done alloca
385 and will be cleaned up in the usual way. */
387 register unsigned char *temp
;
390 i
= XSTRING (current_dir
)->size
;
391 temp
= (unsigned char *) alloca (i
+ 2);
392 bcopy (XSTRING (current_dir
)->data
, temp
, i
);
393 if (temp
[i
- 1] != '/') temp
[i
++] = '/';
396 /* We can't signal an Elisp error here; we're in a vfork. Since
397 the callers check the current directory before forking, this
398 should only return an error if the directory's permissions
399 are changed between the check and this chdir, but we should
401 if (chdir (temp
) < 0)
405 /* Set `env' to a vector of the strings in Vprocess_environment. */
407 register Lisp_Object tem
;
408 register char **new_env
;
409 register int new_length
;
412 for (tem
= Vprocess_environment
;
413 (XTYPE (tem
) == Lisp_Cons
414 && XTYPE (XCONS (tem
)->car
) == Lisp_String
);
415 tem
= XCONS (tem
)->cdr
)
418 /* new_length + 1 to include terminating 0 */
419 env
= new_env
= (char **) alloca ((new_length
+ 1) * sizeof (char *));
421 /* Copy the Vprocess_alist strings into new_env. */
422 for (tem
= Vprocess_environment
;
423 (XTYPE (tem
) == Lisp_Cons
424 && XTYPE (XCONS (tem
)->car
) == Lisp_String
);
425 tem
= XCONS (tem
)->cdr
)
426 *new_env
++ = (char *) XSTRING (XCONS (tem
)->car
)->data
;
442 setpgrp (); /* No arguments but equivalent in this case */
446 setpgrp_of_tty (pid
);
449 something missing here
;
452 /* execvp does not accept an environment arg so the only way
453 to pass this environment is to set environ. Our caller
454 is responsible for restoring the ambient value of environ. */
456 execvp (new_argv
[0], new_argv
);
458 write (1, "Couldn't exec the program ", 26);
459 write (1, new_argv
[0], strlen (new_argv
[0]));
464 getenv_internal (var
, varlen
, value
, valuelen
)
472 for (scan
= Vprocess_environment
; CONSP (scan
); scan
= XCONS (scan
)->cdr
)
474 Lisp_Object entry
= XCONS (scan
)->car
;
476 if (XTYPE (entry
) == Lisp_String
477 && XSTRING (entry
)->size
> varlen
478 && XSTRING (entry
)->data
[varlen
] == '='
479 && ! bcmp (XSTRING (entry
)->data
, var
, varlen
))
481 *value
= (char *) XSTRING (entry
)->data
+ (varlen
+ 1);
482 *valuelen
= XSTRING (entry
)->size
- (varlen
+ 1);
490 DEFUN ("getenv", Fgetenv
, Sgetenv
, 1, 2, 0,
491 "Return the value of environment variable VAR, as a string.\n\
492 VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
493 This function consults the variable ``process-environment'' for its value.")
500 CHECK_STRING (var
, 0);
501 if (getenv_internal (XSTRING (var
)->data
, XSTRING (var
)->size
,
503 return make_string (value
, valuelen
);
508 /* A version of getenv that consults process_environment, easily
517 if (getenv_internal (var
, strlen (var
), &value
, &valuelen
))
528 register char **envp
;
532 char *data_dir
= egetenv ("EMACSDATA");
535 Ffile_name_as_directory
536 (build_string (data_dir
? data_dir
: PATH_DATA
));
539 /* Check the EMACSPATH environment variable, defaulting to the
540 PATH_EXEC path from paths.h. */
541 Vexec_path
= decode_env_path ("EMACSPATH", PATH_EXEC
);
542 Vexec_directory
= Ffile_name_as_directory (Fcar (Vexec_path
));
543 Vexec_path
= nconc2 (decode_env_path ("PATH", ""), Vexec_path
);
545 tempdir
= Fdirectory_file_name (Vexec_directory
);
546 if (access (XSTRING (tempdir
)->data
, 0) < 0)
548 printf ("Warning: arch-dependent data dir (%s) does not exist.\n",
549 XSTRING (Vexec_directory
)->data
);
553 tempdir
= Fdirectory_file_name (Vdata_directory
);
554 if (access (XSTRING (tempdir
)->data
, 0) < 0)
556 printf ("Warning: arch-independent data dir (%s) does not exist.\n",
557 XSTRING (Vdata_directory
)->data
);
562 Vshell_file_name
= build_string ("*dcl*");
564 sh
= (char *) getenv ("SHELL");
565 Vshell_file_name
= build_string (sh
? sh
: "/bin/sh");
568 Vprocess_environment
= Qnil
;
572 for (envp
= environ
; *envp
; envp
++)
573 Vprocess_environment
= Fcons (build_string (*envp
),
574 Vprocess_environment
);
579 DEFVAR_LISP ("shell-file-name", &Vshell_file_name
,
580 "*File name to load inferior shells from.\n\
581 Initialized from the SHELL environment variable.");
583 DEFVAR_LISP ("exec-path", &Vexec_path
,
584 "*List of directories to search programs to run in subprocesses.\n\
585 Each element is a string (directory name) or nil (try default directory).");
587 DEFVAR_LISP ("exec-directory", &Vexec_directory
,
588 "Directory of architecture-dependent files that come with GNU Emacs,\n\
589 especially executable programs intended for Emacs to invoke.");
591 DEFVAR_LISP ("data-directory", &Vdata_directory
,
592 "Directory of architecture-independent files that come with GNU Emacs,\n\
593 intended for Emacs to use.");
595 DEFVAR_LISP ("process-environment", &Vprocess_environment
,
596 "List of environment variables for subprocesses to inherit.\n\
597 Each element should be a string of the form ENVVARNAME=VALUE.\n\
598 The environment which Emacs inherits is placed in this variable\n\
599 when Emacs starts.");
602 defsubr (&Scall_process
);
605 defsubr (&Scall_process_region
);