|
0
|
1 /* Synchronous subprocess invocation for XEmacs.
|
|
|
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc.
|
|
|
3
|
|
|
4 This file is part of XEmacs.
|
|
|
5
|
|
|
6 XEmacs is free software; you can redistribute it and/or modify it
|
|
|
7 under the terms of the GNU General Public License as published by the
|
|
|
8 Free Software Foundation; either version 2, or (at your option) any
|
|
|
9 later version.
|
|
|
10
|
|
|
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
|
|
|
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
14 for more details.
|
|
|
15
|
|
|
16 You should have received a copy of the GNU General Public License
|
|
|
17 along with XEmacs; 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. */
|
|
|
20
|
|
|
21 /* Synched up with: Mule 2.0, FSF 19.30. */
|
|
|
22
|
|
|
23 #include <config.h>
|
|
|
24 #include "lisp.h"
|
|
|
25
|
|
|
26 #include "buffer.h"
|
|
|
27 #include "commands.h"
|
|
|
28 #include "insdel.h"
|
|
|
29 #include "lstream.h"
|
|
|
30 #include "paths.h"
|
|
|
31 #include "process.h"
|
|
|
32 #include "sysdep.h"
|
|
|
33 #include "window.h"
|
|
|
34
|
|
|
35 #include "sysfile.h"
|
|
|
36 #include "systime.h"
|
|
|
37 #include "sysproc.h"
|
|
|
38 #include "syssignal.h" /* Always include before systty.h */
|
|
|
39 #include "systty.h"
|
|
|
40
|
|
|
41
|
|
|
42 #ifdef DOS_NT
|
|
|
43 /* When we are starting external processes we need to know whether they
|
|
|
44 take binary input (no conversion) or text input (\n is converted to
|
|
|
45 \r\n). Similar for output: if newlines are written as \r\n then it's
|
|
|
46 text process output, otherwise it's binary. */
|
|
|
47 Lisp_Object Vbinary_process_input;
|
|
|
48 Lisp_Object Vbinary_process_output;
|
|
|
49 #endif /* DOS_NT */
|
|
|
50
|
|
|
51 Lisp_Object Vexec_path, Vexec_directory, Vdata_directory, Vdoc_directory;
|
|
|
52 Lisp_Object Vconfigure_info_directory;
|
|
|
53
|
|
|
54 /* The default base directory XEmacs is installed under. */
|
|
|
55 Lisp_Object Vprefix_directory;
|
|
|
56
|
|
|
57 Lisp_Object Vshell_file_name;
|
|
|
58
|
|
|
59 /* The environment to pass to all subprocesses when they are started.
|
|
|
60 This is in the semi-bogus format of ("VAR=VAL" "VAR2=VAL2" ... )
|
|
|
61 */
|
|
|
62 Lisp_Object Vprocess_environment;
|
|
|
63
|
|
|
64 /* True iff we are about to fork off a synchronous process or if we
|
|
|
65 are waiting for it. */
|
|
|
66 volatile int synch_process_alive;
|
|
|
67
|
|
|
68 /* Nonzero => this is a string explaining death of synchronous subprocess. */
|
|
|
69 CONST char *synch_process_death;
|
|
|
70
|
|
|
71 /* If synch_process_death is zero,
|
|
|
72 this is exit code of synchronous subprocess. */
|
|
|
73 int synch_process_retcode;
|
|
|
74
|
|
|
75 /* Clean up when exiting Fcall_process_internal.
|
|
|
76 On MSDOS, delete the temporary file on any kind of termination.
|
|
|
77 On Unix, kill the process and any children on termination by signal. */
|
|
|
78
|
|
|
79 /* Nonzero if this is termination due to exit. */
|
|
|
80 static int call_process_exited;
|
|
|
81
|
|
|
82 #ifndef VMS /* VMS version is in vmsproc.c. */
|
|
|
83
|
|
|
84 static Lisp_Object
|
|
|
85 call_process_kill (Lisp_Object fdpid)
|
|
|
86 {
|
|
|
87 Lisp_Object fd = Fcar (fdpid);
|
|
|
88 Lisp_Object pid = Fcdr (fdpid);
|
|
|
89
|
|
|
90 if (!NILP (fd))
|
|
|
91 close (XINT (fd));
|
|
|
92
|
|
|
93 if (!NILP (pid))
|
|
|
94 EMACS_KILLPG (XINT (pid), SIGKILL);
|
|
|
95
|
|
|
96 synch_process_alive = 0;
|
|
|
97 return Qnil;
|
|
|
98 }
|
|
|
99
|
|
|
100 static Lisp_Object
|
|
|
101 call_process_cleanup (Lisp_Object fdpid)
|
|
|
102 {
|
|
|
103 #ifdef MSDOS
|
|
|
104 /* for MSDOS fdpid is really (fd . tempfile) */
|
|
|
105 Lisp_Object file = Fcdr (fdpid);
|
|
|
106 close (XINT (Fcar (fdpid)));
|
|
|
107 if (strcmp (string_data (XSTRING (file)), NULL_DEVICE) != 0)
|
|
|
108 unlink (string_data (XSTRING (file)));
|
|
|
109 #else /* not MSDOS */
|
|
|
110 int fd = XINT (Fcar (fdpid));
|
|
|
111 int pid = XINT (Fcdr (fdpid));
|
|
|
112
|
|
|
113 if (!call_process_exited &&
|
|
|
114 EMACS_KILLPG (pid, SIGINT) == 0)
|
|
|
115 {
|
|
|
116 int speccount = specpdl_depth ();
|
|
|
117
|
|
|
118 record_unwind_protect (call_process_kill, fdpid);
|
|
|
119 /* #### "c-G" -- need non-consing Single-key-description */
|
|
|
120 message ("Waiting for process to die...(type C-g again to kill it instantly)");
|
|
|
121
|
|
|
122 /* "Discard" the unwind protect. */
|
|
|
123 XCAR (fdpid) = Qnil;
|
|
|
124 XCDR (fdpid) = Qnil;
|
|
|
125 unbind_to (speccount, Qnil);
|
|
|
126
|
|
|
127 message ("Waiting for process to die... done");
|
|
|
128 }
|
|
|
129 synch_process_alive = 0;
|
|
|
130 close (fd);
|
|
|
131 #endif /* not MSDOS */
|
|
|
132 return Qnil;
|
|
|
133 }
|
|
|
134
|
|
|
135 static Lisp_Object fork_error;
|
|
|
136 #if 0 /* UNUSED */
|
|
|
137 static void
|
|
|
138 report_fork_error (char *string, Lisp_Object data)
|
|
|
139 {
|
|
|
140 Lisp_Object errstring = build_string (strerror (errno));
|
|
|
141
|
|
|
142 /* System error messages are capitalized. Downcase the initial. */
|
|
|
143 set_string_char (XSTRING (errstring), 0,
|
|
|
144 DOWNCASE (current_buffer,
|
|
|
145 string_char (XSTRING (errstring), 0)));
|
|
|
146
|
|
|
147 fork_error = Fcons (build_string (string), Fcons (errstring, data));
|
|
|
148
|
|
|
149 /* terminate this branch of the fork, without closing stdin/out/etc. */
|
|
|
150 _exit (1);
|
|
|
151 }
|
|
|
152 #endif /* unused */
|
|
|
153
|
|
|
154 DEFUN ("call-process-internal", Fcall_process_internal,
|
|
|
155 Scall_process_internal, 1, MANY, 0 /*
|
|
|
156 Call PROGRAM synchronously in separate process, with coding-system specified.
|
|
|
157 Arguments are
|
|
|
158 (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS).
|
|
|
159 The program's input comes from file INFILE (nil means `/dev/null').
|
|
|
160 Insert output in BUFFER before point; t means current buffer;
|
|
|
161 nil for BUFFER means discard it; 0 means discard and don't wait.
|
|
|
162 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
|
|
|
163 REAL-BUFFER says what to do with standard output, as above,
|
|
|
164 while STDERR-FILE says what to do with standard error in the child.
|
|
|
165 STDERR-FILE may be nil (discard standard error output),
|
|
|
166 t (mix it with ordinary output), or a file name string.
|
|
|
167
|
|
|
168 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
|
|
|
169 Remaining arguments are strings passed as command arguments to PROGRAM.
|
|
|
170
|
|
|
171 If BUFFER is 0, `call-process' returns immediately with value nil.
|
|
|
172 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
|
|
|
173 or a signal description string.
|
|
|
174 If you quit, the process is killed with SIGINT, or SIGKILL if you
|
|
|
175 quit again.
|
|
|
176 */ )
|
|
|
177 (nargs, args)
|
|
|
178 int nargs;
|
|
|
179 Lisp_Object *args;
|
|
|
180 {
|
|
|
181 /* This function can GC */
|
|
|
182 Lisp_Object infile, buffer, current_dir, display, path;
|
|
|
183 int fd[2];
|
|
|
184 int filefd;
|
|
|
185 int pid;
|
|
|
186 char buf[16384];
|
|
|
187 char *bufptr = buf;
|
|
|
188 int bufsize = 16384;
|
|
|
189 int speccount = specpdl_depth ();
|
|
|
190 char **new_argv
|
|
|
191 = (char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
|
|
|
192
|
|
|
193 /* File to use for stderr in the child.
|
|
|
194 t means use same as standard output. */
|
|
|
195 Lisp_Object error_file;
|
|
|
196 #ifdef MSDOS
|
|
|
197 char *outf, *tempfile;
|
|
|
198 int outfilefd;
|
|
|
199 #endif
|
|
|
200
|
|
|
201 CHECK_STRING (args[0]);
|
|
|
202
|
|
|
203 error_file = Qt;
|
|
|
204
|
|
|
205 #if defined (NO_SUBPROCESSES)
|
|
|
206 /* Without asynchronous processes we cannot have BUFFER == 0. */
|
|
|
207 if (nargs >= 3 && !INTP (args[2]))
|
|
|
208 error ("Operating system cannot handle asynchronous subprocesses");
|
|
|
209 #endif
|
|
|
210
|
|
|
211 /* Do this before building new_argv because GC in Lisp code
|
|
|
212 * called by various filename-hacking routines might relocate strings */
|
|
|
213 locate_file (Vexec_path, args[0], EXEC_SUFFIXES, &path, X_OK);
|
|
|
214
|
|
|
215 /* Make sure that the child will be able to chdir to the current
|
|
|
216 buffer's current directory, or its unhandled equivalent. We
|
|
|
217 can't just have the child check for an error when it does the
|
|
|
218 chdir, since it's in a vfork. */
|
|
|
219 {
|
|
|
220 struct gcpro gcpro1, gcpro2;
|
|
|
221 /* Do this test before building new_argv because GC in Lisp code
|
|
|
222 * called by various filename-hacking routines might relocate strings */
|
|
|
223 /* Make sure that the child will be able to chdir to the current
|
|
|
224 buffer's current directory. We can't just have the child check
|
|
|
225 for an error when it does the chdir, since it's in a vfork. */
|
|
|
226
|
|
|
227 GCPRO2 (current_dir, path); /* Caller gcprotects args[] */
|
|
|
228 current_dir = current_buffer->directory;
|
|
|
229 current_dir = expand_and_dir_to_file
|
|
|
230 (Funhandled_file_name_directory (current_dir), Qnil);
|
|
|
231 #if 0
|
|
|
232 /* I don't know how RMS intends this crock of shit to work, but it
|
|
|
233 breaks everything in the presence of ange-ftp-visited files, so
|
|
|
234 fuck it. */
|
|
|
235 if (NILP (Ffile_accessible_directory_p (current_dir)))
|
|
|
236 report_file_error ("Setting current directory",
|
|
|
237 Fcons (current_buffer->directory, Qnil));
|
|
|
238 #endif /* 0 */
|
|
|
239 UNGCPRO;
|
|
|
240 }
|
|
|
241
|
|
|
242 if (nargs >= 2 && ! NILP (args[1]))
|
|
|
243 {
|
|
|
244 infile = Fexpand_file_name (args[1],
|
|
|
245 current_buffer->directory);
|
|
|
246 CHECK_STRING (infile);
|
|
|
247 }
|
|
|
248 else
|
|
|
249 infile = build_string (NULL_DEVICE);
|
|
|
250
|
|
|
251 if (nargs >= 3)
|
|
|
252 {
|
|
|
253 buffer = args[2];
|
|
|
254
|
|
|
255 /* If BUFFER is a list, its meaning is
|
|
|
256 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
|
|
|
257 if (CONSP (buffer))
|
|
|
258 {
|
|
|
259 if (CONSP (XCDR (buffer)))
|
|
|
260 {
|
|
|
261 Lisp_Object file_for_stderr = XCAR (XCDR (buffer));
|
|
|
262
|
|
|
263 if (NILP (file_for_stderr) || EQ (Qt, file_for_stderr))
|
|
|
264 error_file = file_for_stderr;
|
|
|
265 else
|
|
|
266 error_file = Fexpand_file_name (file_for_stderr, Qnil);
|
|
|
267 }
|
|
|
268
|
|
|
269 buffer = XCAR (buffer);
|
|
|
270 }
|
|
|
271
|
|
|
272 if (!(EQ (buffer, Qnil)
|
|
|
273 || EQ (buffer, Qt)
|
|
|
274 || ZEROP (buffer)))
|
|
|
275 {
|
|
|
276 Lisp_Object spec_buffer;
|
|
|
277 spec_buffer = buffer;
|
|
|
278 buffer = Fget_buffer (buffer);
|
|
|
279 /* Mention the buffer name for a better error message. */
|
|
|
280 if (NILP (buffer))
|
|
|
281 CHECK_BUFFER (spec_buffer);
|
|
|
282 CHECK_BUFFER (buffer);
|
|
|
283 }
|
|
|
284 }
|
|
|
285 else
|
|
|
286 buffer = Qnil;
|
|
|
287
|
|
|
288 display = ((nargs >= 4) ? args[3] : Qnil);
|
|
|
289
|
|
|
290 /* From here we assume we won't GC (unless an error is signalled). */
|
|
|
291 {
|
|
|
292 REGISTER int i;
|
|
|
293 for (i = 4; i < nargs; i++)
|
|
|
294 {
|
|
|
295 CHECK_STRING (args[i]);
|
|
|
296 new_argv[i - 3] = (char *) string_data (XSTRING (args[i]));
|
|
|
297 }
|
|
|
298 /* Program name is first command arg */
|
|
|
299 new_argv[0] = (char *) string_data (XSTRING (args[0]));
|
|
|
300 new_argv[i - 3] = 0;
|
|
|
301 }
|
|
|
302
|
|
|
303 filefd = open ((char *) string_data (XSTRING (infile)), O_RDONLY, 0);
|
|
|
304 if (filefd < 0)
|
|
|
305 {
|
|
|
306 report_file_error ("Opening process input file",
|
|
|
307 Fcons (infile, Qnil));
|
|
|
308 }
|
|
|
309
|
|
|
310 if (NILP (path))
|
|
|
311 {
|
|
|
312 close (filefd);
|
|
|
313 report_file_error ("Searching for program",
|
|
|
314 Fcons (args[0], Qnil));
|
|
|
315 }
|
|
|
316 new_argv[0] = (char *) string_data (XSTRING (path));
|
|
|
317
|
|
|
318 #ifdef MSDOS
|
|
|
319 /* These vars record information from process termination.
|
|
|
320 Clear them now before process can possibly terminate,
|
|
|
321 to avoid timing error if process terminates soon. */
|
|
|
322 synch_process_death = 0;
|
|
|
323 synch_process_retcode = 0;
|
|
|
324
|
|
|
325 if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP")))
|
|
|
326 strcpy (tempfile = alloca (strlen (outf) + 20), outf);
|
|
|
327 else
|
|
|
328 {
|
|
|
329 tempfile = alloca (20);
|
|
|
330 *tempfile = '\0';
|
|
|
331 }
|
|
|
332 dostounix_filename (tempfile);
|
|
|
333 if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
|
|
|
334 strcat (tempfile, "/");
|
|
|
335 strcat (tempfile, "detmp.XXX");
|
|
|
336 mktemp (tempfile);
|
|
|
337
|
|
|
338 outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
|
|
|
339 if (outfilefd < 0)
|
|
|
340 {
|
|
|
341 close (filefd);
|
|
|
342 report_file_error ("Opening process output file",
|
|
|
343 Fcons (tempfile, Qnil));
|
|
|
344 }
|
|
|
345 #endif
|
|
|
346
|
|
|
347 #ifndef MSDOS
|
|
|
348 if (INTP (buffer))
|
|
|
349 {
|
|
|
350 fd[1] = open (NULL_DEVICE, O_WRONLY, 0);
|
|
|
351 fd[0] = -1;
|
|
|
352 }
|
|
|
353 else
|
|
|
354 {
|
|
|
355 #ifdef WINDOWSNT
|
|
|
356 pipe_with_inherited_out (fd);
|
|
|
357 #else /* not WINDOWSNT */
|
|
|
358 pipe (fd);
|
|
|
359 #endif /* not WINDOWSNT */
|
|
|
360 #if 0
|
|
|
361 /* Replaced by close_process_descs */
|
|
|
362 set_exclusive_use (fd[0]);
|
|
|
363 #endif
|
|
|
364 }
|
|
|
365 #else /* MSDOS */
|
|
|
366 {
|
|
|
367 char *outf;
|
|
|
368
|
|
|
369 if (INTP (buffer))
|
|
|
370 outf = NULL_DEVICE;
|
|
|
371 else
|
|
|
372 {
|
|
|
373 /* DOS can't create pipe for interprocess communication,
|
|
|
374 so redirect child process's standard output to temporary file
|
|
|
375 and later read the file. */
|
|
|
376
|
|
|
377 if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP")))
|
|
|
378 {
|
|
|
379 strcpy (tempfile, outf);
|
|
|
380 dostounix_filename (tempfile);
|
|
|
381 }
|
|
|
382 else
|
|
|
383 *tempfile = '\0';
|
|
|
384 if (strlen (tempfile) == 0 || tempfile[strlen (tempfile) - 1] != '/')
|
|
|
385 strcat (tempfile, "/");
|
|
|
386 strcat (tempfile, "demacs.XXX");
|
|
|
387 mktemp (tempfile);
|
|
|
388 outf = tempfile;
|
|
|
389 }
|
|
|
390
|
|
|
391 if ((fd[1] = creat (outf, S_IREAD | S_IWRITE)) < 0)
|
|
|
392 report_file_error ("Can't open temporary file", Qnil);
|
|
|
393 fd[0] = -1;
|
|
|
394 }
|
|
|
395 #endif /* MSDOS */
|
|
|
396
|
|
|
397 {
|
|
|
398 /* child_setup must clobber environ in systems with true vfork.
|
|
|
399 Protect it from permanent change. */
|
|
|
400 REGISTER char **save_environ = environ;
|
|
|
401 REGISTER int fd1 = fd[1];
|
|
|
402 int fd_error = fd1;
|
|
|
403 char **env;
|
|
|
404
|
|
|
405 #ifdef EMACS_BTL
|
|
|
406 /* when performance monitoring is on, turn it off before the vfork(),
|
|
|
407 as the child has no handler for the signal -- when back in the
|
|
|
408 parent process, turn it back on if it was really on when you "turned
|
|
|
409 it off" */
|
|
|
410 int logging_on = cadillac_stop_logging ();
|
|
|
411 #endif
|
|
|
412
|
|
|
413 env = environ;
|
|
|
414
|
|
|
415 /* Record that we're about to create a synchronous process. */
|
|
|
416 synch_process_alive = 1;
|
|
|
417
|
|
|
418 /* These vars record information from process termination.
|
|
|
419 Clear them now before process can possibly terminate,
|
|
|
420 to avoid timing error if process terminates soon. */
|
|
|
421 synch_process_death = 0;
|
|
|
422 synch_process_retcode = 0;
|
|
|
423
|
|
|
424 #ifdef MSDOS
|
|
|
425 /* ??? Someone who knows MSDOG needs to check whether this properly
|
|
|
426 closes all descriptors that it opens. */
|
|
|
427 pid = run_msdos_command (new_argv, current_dir, filefd, outfilefd);
|
|
|
428 close (outfilefd);
|
|
|
429 fd1 = -1; /* No harm in closing that one! */
|
|
|
430 fd[0] = open (tempfile, NILP (Vbinary_process_output) ? O_TEXT :
|
|
|
431 O_BINARY);
|
|
|
432 if (fd[0] < 0)
|
|
|
433 {
|
|
|
434 unlink (tempfile);
|
|
|
435 close (filefd);
|
|
|
436 report_file_error ("Cannot re-open temporary file", Qnil);
|
|
|
437 }
|
|
|
438 #else /* not MSDOS */
|
|
|
439 if (NILP (error_file))
|
|
|
440 fd_error = open (NULL_DEVICE, O_WRONLY);
|
|
|
441 else if (STRINGP (error_file))
|
|
|
442 {
|
|
|
443 #ifdef DOS_NT
|
|
|
444 fd_error = open (string_data (XSTRING (error_file)),
|
|
|
445 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
|
|
|
446 S_IREAD | S_IWRITE);
|
|
|
447 #else /* not DOS_NT */
|
|
|
448 fd_error =
|
|
|
449 creat ((CONST char *) string_data (XSTRING (error_file)), 0666);
|
|
|
450 #endif /* not DOS_NT */
|
|
|
451 }
|
|
|
452
|
|
|
453 if (fd_error < 0)
|
|
|
454 {
|
|
|
455 close (filefd);
|
|
|
456 close (fd[0]);
|
|
|
457 if (fd1 >= 0)
|
|
|
458 close (fd1);
|
|
|
459 report_file_error ("Cannot open", error_file);
|
|
|
460 }
|
|
|
461
|
|
|
462 fork_error = Qnil;
|
|
|
463 #ifdef WINDOWSNT
|
|
|
464 pid = child_setup (filefd, fd1, fd_error, new_argv, current_dir);
|
|
|
465 #else /* not WINDOWSNT */
|
|
|
466 pid = vfork ();
|
|
|
467
|
|
|
468 if (pid == 0)
|
|
|
469 {
|
|
|
470 if (fd[0] >= 0)
|
|
|
471 close (fd[0]);
|
|
|
472 /* This is necessary because some shells may attempt to
|
|
|
473 access the current controlling terminal and will hang
|
|
|
474 if they are run in the background, as will be the case
|
|
|
475 when XEmacs is started in the background. Martin
|
|
|
476 Buchholz observed this problem running a subprocess
|
|
|
477 that used zsh to call gzip to uncompress an info
|
|
|
478 file. */
|
|
|
479 disconnect_controlling_terminal ();
|
|
|
480 child_setup (filefd, fd1, fd_error, new_argv,
|
|
|
481 (char *) string_data (XSTRING (current_dir)));
|
|
|
482 }
|
|
|
483 #ifdef EMACS_BTL
|
|
|
484 else if (logging_on)
|
|
|
485 cadillac_start_logging ();
|
|
|
486 #endif
|
|
|
487
|
|
|
488 #endif /* not MSDOS */
|
|
|
489 #endif /* not WINDOWSNT */
|
|
|
490
|
|
|
491 environ = save_environ;
|
|
|
492
|
|
|
493 /* Close most of our fd's, but not fd[0]
|
|
|
494 since we will use that to read input from. */
|
|
|
495 close (filefd);
|
|
|
496 if (fd1 >= 0)
|
|
|
497 close (fd1);
|
|
|
498 }
|
|
|
499
|
|
|
500 if (!NILP (fork_error))
|
|
|
501 signal_error (Qfile_error, fork_error);
|
|
|
502
|
|
|
503 if (pid < 0)
|
|
|
504 {
|
|
|
505 if (fd[0] >= 0)
|
|
|
506 close (fd[0]);
|
|
|
507 report_file_error ("Doing vfork", Qnil);
|
|
|
508 }
|
|
|
509
|
|
|
510 if (INTP (buffer))
|
|
|
511 {
|
|
|
512 if (fd[0] >= 0)
|
|
|
513 close (fd[0]);
|
|
|
514 #if defined (NO_SUBPROCESSES)
|
|
|
515 /* If Emacs has been built with asynchronous subprocess support,
|
|
|
516 we don't need to do this, I think because it will then have
|
|
|
517 the facilities for handling SIGCHLD. */
|
|
|
518 wait_without_blocking ();
|
|
|
519 #endif
|
|
|
520 return Qnil;
|
|
|
521 }
|
|
|
522
|
|
|
523 {
|
|
|
524 int nread;
|
|
|
525 int first = 1;
|
|
|
526 int total_read = 0;
|
|
|
527 Lisp_Object instream;
|
|
|
528 struct gcpro gcpro1;
|
|
|
529
|
|
|
530 /* Enable sending signal if user quits below. */
|
|
|
531 call_process_exited = 0;
|
|
|
532
|
|
|
533 #ifdef MSDOS
|
|
|
534 /* MSDOS needs different cleanup information. */
|
|
|
535 record_unwind_protect (call_process_cleanup,
|
|
|
536 Fcons (make_int (fd[0]),
|
|
|
537 build_string (tempfile)));
|
|
|
538 #else
|
|
|
539 record_unwind_protect (call_process_cleanup,
|
|
|
540 Fcons (make_int (fd[0]), make_int (pid)));
|
|
|
541 #endif /* not MSDOS */
|
|
|
542
|
|
|
543 /* FSFmacs calls Fset_buffer() here. We don't have to because
|
|
|
544 we can insert into buffers other than the current one. */
|
|
|
545 if (EQ (buffer, Qt))
|
|
|
546 XSETBUFFER (buffer, current_buffer);
|
|
|
547 instream = make_filedesc_input_stream (fd[0], 0, -1, LSTR_ALLOW_QUIT);
|
|
|
548 GCPRO1 (instream);
|
|
|
549 while (1)
|
|
|
550 {
|
|
|
551 QUIT;
|
|
|
552 /* Repeatedly read until we've filled as much as possible
|
|
|
553 of the buffer size we have. But don't read
|
|
|
554 less than 1024--save that for the next bufferfull. */
|
|
|
555
|
|
|
556 nread = 0;
|
|
|
557 while (nread < bufsize - 1024)
|
|
|
558 {
|
|
|
559 int this_read
|
|
|
560 = Lstream_read (XLSTREAM (instream), bufptr + nread,
|
|
|
561 bufsize - nread);
|
|
|
562
|
|
|
563 if (this_read < 0)
|
|
|
564 goto give_up;
|
|
|
565
|
|
|
566 if (this_read == 0)
|
|
|
567 goto give_up_1;
|
|
|
568
|
|
|
569 nread += this_read;
|
|
|
570 }
|
|
|
571
|
|
|
572 give_up_1:
|
|
|
573
|
|
|
574 /* Now NREAD is the total amount of data in the buffer. */
|
|
|
575 if (nread == 0)
|
|
|
576 break;
|
|
|
577
|
|
|
578 total_read += nread;
|
|
|
579
|
|
|
580 if (!NILP (buffer))
|
|
|
581 buffer_insert_raw_string (XBUFFER (buffer), (Bufbyte *) bufptr,
|
|
|
582 nread);
|
|
|
583
|
|
|
584 /* Make the buffer bigger as we continue to read more data,
|
|
|
585 but not past 64k. */
|
|
|
586 if (bufsize < 64 * 1024 && total_read > 32 * bufsize)
|
|
|
587 {
|
|
|
588 bufsize *= 2;
|
|
|
589 bufptr = (char *) alloca (bufsize);
|
|
|
590 }
|
|
|
591
|
|
|
592 if (!NILP (display) && INTERACTIVE)
|
|
|
593 {
|
|
|
594 first = 0;
|
|
|
595 redisplay ();
|
|
|
596 }
|
|
|
597 }
|
|
|
598 give_up:
|
|
|
599 Lstream_close (XLSTREAM (instream));
|
|
|
600 UNGCPRO;
|
|
|
601
|
|
|
602 QUIT;
|
|
|
603 #ifndef MSDOS
|
|
|
604 /* Wait for it to terminate, unless it already has. */
|
|
|
605 wait_for_termination (pid);
|
|
|
606 #endif
|
|
|
607
|
|
|
608 /* Don't kill any children that the subprocess may have left behind
|
|
|
609 when exiting. */
|
|
|
610 call_process_exited = 1;
|
|
|
611 unbind_to (speccount, Qnil);
|
|
|
612
|
|
|
613 if (synch_process_death)
|
|
|
614 return build_string (synch_process_death);
|
|
|
615 return make_int (synch_process_retcode);
|
|
|
616 }
|
|
|
617 }
|
|
|
618
|
|
|
619 #endif /* VMS */
|
|
|
620
|
|
|
621 #ifndef VMS /* VMS version is in vmsproc.c. */
|
|
|
622
|
|
|
623 /* This is the last thing run in a newly forked inferior
|
|
|
624 either synchronous or asynchronous.
|
|
|
625 Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
|
|
|
626 Initialize inferior's priority, pgrp, connected dir and environment.
|
|
|
627 then exec another program based on new_argv.
|
|
|
628
|
|
|
629 This function may change environ for the superior process.
|
|
|
630 Therefore, the superior process must save and restore the value
|
|
|
631 of environ around the vfork and the call to this function.
|
|
|
632
|
|
|
633 ENV is the environment for the subprocess.
|
|
|
634
|
|
|
635 XEmacs: We've removed the SET_PGRP argument because it's already
|
|
|
636 done by the callers of child_setup.
|
|
|
637
|
|
|
638 CURRENT_DIR is an elisp string giving the path of the current
|
|
|
639 directory the subprocess should have. Since we can't really signal
|
|
|
640 a decent error from within the child, this should be verified as an
|
|
|
641 executable directory by the parent. */
|
|
|
642
|
|
|
643 static int relocate_fd (int fd, int min);
|
|
|
644
|
|
|
645 void
|
|
|
646 child_setup (int in, int out, int err, char **new_argv,
|
|
|
647 CONST char *current_dir)
|
|
|
648 {
|
|
|
649 #ifdef MSDOS
|
|
|
650 /* The MSDOS port of gcc cannot fork, vfork, ... so we must call system
|
|
|
651 instead. */
|
|
|
652 #else /* not MSDOS */
|
|
|
653 char **env;
|
|
|
654 char *pwd;
|
|
|
655 #ifdef WINDOWSNT
|
|
|
656 int cpid;
|
|
|
657 HANDLE handles[4];
|
|
|
658 #endif /* WINDOWSNT */
|
|
|
659
|
|
|
660 #ifdef SET_EMACS_PRIORITY
|
|
|
661 if (emacs_priority != 0)
|
|
|
662 nice (- emacs_priority);
|
|
|
663 #endif
|
|
|
664
|
|
|
665 #if !defined (NO_SUBPROCESSES)
|
|
|
666 /* Close Emacs's descriptors that this process should not have. */
|
|
|
667 close_process_descs ();
|
|
|
668 #endif
|
|
|
669 close_load_descs ();
|
|
|
670
|
|
|
671 /* Note that use of alloca is always safe here. It's obvious for systems
|
|
|
672 that do not have true vfork or that have true (stack) alloca.
|
|
|
673 If using vfork and C_ALLOCA it is safe because that changes
|
|
|
674 the superior's static variables as if the superior had done alloca
|
|
|
675 and will be cleaned up in the usual way. */
|
|
|
676 {
|
|
|
677 REGISTER int i;
|
|
|
678
|
|
|
679 i = strlen (current_dir);
|
|
|
680 pwd = (char *) alloca (i + 6);
|
|
|
681 memcpy (pwd, "PWD=", 4);
|
|
|
682 memcpy (pwd + 4, current_dir, i);
|
|
|
683 i += 4;
|
|
|
684 if (!IS_DIRECTORY_SEP (pwd[i - 1]))
|
|
|
685 pwd[i++] = DIRECTORY_SEP;
|
|
|
686 pwd[i] = 0;
|
|
|
687
|
|
|
688 /* We can't signal an Elisp error here; we're in a vfork. Since
|
|
|
689 the callers check the current directory before forking, this
|
|
|
690 should only return an error if the directory's permissions
|
|
|
691 are changed between the check and this chdir, but we should
|
|
|
692 at least check. */
|
|
|
693 if (chdir (pwd + 4) < 0)
|
|
|
694 {
|
|
|
695 /* Don't report the chdir error, or ange-ftp.el doesn't work. */
|
|
|
696 /* (FSFmacs does _exit (errno) here.) */
|
|
|
697 pwd = 0;
|
|
|
698 }
|
|
|
699 else
|
|
|
700 {
|
|
|
701 /* Strip trailing "/". Cretinous *[]&@$#^%@#$% Un*x */
|
|
|
702 /* leave "//" (from FSF) */
|
|
|
703 while (i > 6 && IS_DIRECTORY_SEP (pwd[i - 1]))
|
|
|
704 pwd[--i] = 0;
|
|
|
705 }
|
|
|
706 }
|
|
|
707
|
|
|
708 /* Set `env' to a vector of the strings in Vprocess_environment. */
|
|
|
709 {
|
|
|
710 REGISTER Lisp_Object tem;
|
|
|
711 REGISTER char **new_env;
|
|
|
712 REGISTER int new_length;
|
|
|
713
|
|
|
714 new_length = 0;
|
|
|
715 for (tem = Vprocess_environment;
|
|
|
716 (CONSP (tem)
|
|
|
717 && STRINGP (XCAR (tem)));
|
|
|
718 tem = XCDR (tem))
|
|
|
719 new_length++;
|
|
|
720
|
|
|
721 /* new_length + 2 to include PWD and terminating 0. */
|
|
|
722 env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *));
|
|
|
723
|
|
|
724 /* If we have a PWD envvar and we know the real current directory,
|
|
|
725 pass one down, but with corrected value. */
|
|
|
726 if (pwd && getenv ("PWD"))
|
|
|
727 *new_env++ = pwd;
|
|
|
728
|
|
|
729 /* Copy the Vprocess_environment strings into new_env. */
|
|
|
730 for (tem = Vprocess_environment;
|
|
|
731 (CONSP (tem)
|
|
|
732 && STRINGP (XCAR (tem)));
|
|
|
733 tem = XCDR (tem))
|
|
|
734 {
|
|
|
735 char **ep = env;
|
|
|
736 char *string = (char *) string_data (XSTRING (XCAR (tem)));
|
|
|
737 /* See if this string duplicates any string already in the env.
|
|
|
738 If so, don't put it in.
|
|
|
739 When an env var has multiple definitions,
|
|
|
740 we keep the definition that comes first in process-environment. */
|
|
|
741 for (; ep != new_env; ep++)
|
|
|
742 {
|
|
|
743 char *p = *ep, *q = string;
|
|
|
744 while (1)
|
|
|
745 {
|
|
|
746 if (*q == 0)
|
|
|
747 /* The string is malformed; might as well drop it. */
|
|
|
748 goto duplicate;
|
|
|
749 if (*q != *p)
|
|
|
750 break;
|
|
|
751 if (*q == '=')
|
|
|
752 goto duplicate;
|
|
|
753 p++, q++;
|
|
|
754 }
|
|
|
755 }
|
|
|
756 if (pwd && !strncmp ("PWD=", string, 4))
|
|
|
757 {
|
|
|
758 *new_env++ = pwd;
|
|
|
759 pwd = 0;
|
|
|
760 }
|
|
|
761 else
|
|
|
762 *new_env++ = string;
|
|
|
763 duplicate: ;
|
|
|
764 }
|
|
|
765 *new_env = 0;
|
|
|
766 }
|
|
|
767 #ifdef WINDOWSNT
|
|
|
768 prepare_standard_handles (in, out, err, handles);
|
|
|
769 #else /* not WINDOWSNT */
|
|
|
770 /* Make sure that in, out, and err are not actually already in
|
|
|
771 descriptors zero, one, or two; this could happen if Emacs is
|
|
|
772 started with its standard in, out, or error closed, as might
|
|
|
773 happen under X. */
|
|
|
774 {
|
|
|
775 int oin = in, oout = out;
|
|
|
776
|
|
|
777 /* We have to avoid relocating the same descriptor twice! */
|
|
|
778
|
|
|
779 in = relocate_fd (in, 3);
|
|
|
780
|
|
|
781 if (out == oin) out = in;
|
|
|
782 else out = relocate_fd (out, 3);
|
|
|
783
|
|
|
784 if (err == oin) err = in;
|
|
|
785 else if (err == oout) err = out;
|
|
|
786 else err = relocate_fd (err, 3);
|
|
|
787 }
|
|
|
788
|
|
|
789 close (0);
|
|
|
790 close (1);
|
|
|
791 close (2);
|
|
|
792
|
|
|
793 dup2 (in, 0);
|
|
|
794 dup2 (out, 1);
|
|
|
795 dup2 (err, 2);
|
|
|
796
|
|
|
797 close (in);
|
|
|
798 close (out);
|
|
|
799 close (err);
|
|
|
800
|
|
|
801 /* I can't think of any reason why child processes need any more
|
|
|
802 than the standard 3 file descriptors. It would be cleaner to
|
|
|
803 close just the ones that need to be, but the following brute
|
|
|
804 force approach is certainly effective, and not too slow. */
|
|
|
805 {
|
|
|
806 int fd;
|
|
|
807 for (fd=3; fd<=64; fd++)
|
|
|
808 {
|
|
|
809 close(fd);
|
|
|
810 }
|
|
|
811 }
|
|
|
812 #endif /* not WINDOWSNT */
|
|
|
813
|
|
|
814 #ifdef vipc
|
|
|
815 something missing here;
|
|
|
816 #endif /* vipc */
|
|
|
817
|
|
|
818 #ifdef WINDOWSNT
|
|
|
819 /* Spawn the child. (See ntproc.c:Spawnve). */
|
|
|
820 cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
|
|
|
821 if (cpid == -1)
|
|
|
822 /* An error occurred while trying to spawn the process. */
|
|
|
823 report_file_error ("Spawning child process", Qnil);
|
|
|
824 reset_standard_handles (in, out, err, handles);
|
|
|
825 return cpid;
|
|
|
826 #else /* not WINDOWSNT */
|
|
|
827 /* execvp does not accept an environment arg so the only way
|
|
|
828 to pass this environment is to set environ. Our caller
|
|
|
829 is responsible for restoring the ambient value of environ. */
|
|
|
830 environ = env;
|
|
|
831 execvp (new_argv[0], new_argv);
|
|
|
832
|
|
|
833 stdout_out ("Cant't exec program %s\n", new_argv[0]);
|
|
|
834 _exit (1);
|
|
|
835 #endif /* not WINDOWSNT */
|
|
|
836 #endif /* not MSDOS */
|
|
|
837 }
|
|
|
838
|
|
|
839 /* Move the file descriptor FD so that its number is not less than MIN.
|
|
|
840 If the file descriptor is moved at all, the original is freed. */
|
|
|
841 static int
|
|
|
842 relocate_fd (int fd, int min)
|
|
|
843 {
|
|
|
844 if (fd >= min)
|
|
|
845 return fd;
|
|
|
846 else
|
|
|
847 {
|
|
|
848 int new = dup (fd);
|
|
|
849 if (new == -1)
|
|
|
850 {
|
|
|
851 stderr_out ("Error while setting up child: %s\n",
|
|
|
852 strerror (errno));
|
|
|
853 _exit (1);
|
|
|
854 }
|
|
|
855 /* Note that we hold the original FD open while we recurse,
|
|
|
856 to guarantee we'll get a new FD if we need it. */
|
|
|
857 new = relocate_fd (new, min);
|
|
|
858 close (fd);
|
|
|
859 return new;
|
|
|
860 }
|
|
|
861 }
|
|
|
862
|
|
|
863 static int
|
|
|
864 getenv_internal (CONST Bufbyte *var,
|
|
|
865 Bytecount varlen,
|
|
|
866 Bufbyte **value,
|
|
|
867 Bytecount *valuelen)
|
|
|
868 {
|
|
|
869 Lisp_Object scan;
|
|
|
870
|
|
|
871 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
|
|
|
872 {
|
|
|
873 Lisp_Object entry = XCAR (scan);
|
|
|
874
|
|
|
875 if (STRINGP (entry)
|
|
|
876 && string_length (XSTRING (entry)) > varlen
|
|
|
877 && string_byte (XSTRING (entry), varlen) == '='
|
|
|
878 #ifdef WINDOWSNT
|
|
|
879 /* NT environment variables are case insensitive. */
|
|
|
880 && ! memicmp (string_data (XSTRING (entry)), var, varlen)
|
|
|
881 #else /* not WINDOWSNT */
|
|
|
882 && ! memcmp (string_data (XSTRING (entry)), var, varlen)
|
|
|
883 #endif /* not WINDOWSNT */
|
|
|
884 )
|
|
|
885 {
|
|
|
886 *value = string_data (XSTRING (entry)) + (varlen + 1);
|
|
|
887 *valuelen = string_length (XSTRING (entry)) - (varlen + 1);
|
|
|
888 return 1;
|
|
|
889 }
|
|
|
890 }
|
|
|
891
|
|
|
892 return 0;
|
|
|
893 }
|
|
|
894
|
|
|
895 DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, "sEnvironment variable: \np" /*
|
|
|
896 Return the value of environment variable VAR, as a string.
|
|
|
897 VAR is a string, the name of the variable.
|
|
|
898 When invoked interactively, prints the value in the echo area.
|
|
|
899 */ )
|
|
|
900 (var, interactivep)
|
|
|
901 Lisp_Object var, interactivep;
|
|
|
902 {
|
|
|
903 Bufbyte *value;
|
|
|
904 Bytecount valuelen;
|
|
|
905 Lisp_Object v = Qnil;
|
|
|
906 struct gcpro gcpro1;
|
|
|
907
|
|
|
908 CHECK_STRING (var);
|
|
|
909 GCPRO1 (v);
|
|
|
910 if (getenv_internal (string_data (XSTRING (var)),
|
|
|
911 string_length (XSTRING (var)),
|
|
|
912 &value, &valuelen))
|
|
|
913 v = make_string (value, valuelen);
|
|
|
914 if (!NILP (interactivep))
|
|
|
915 {
|
|
|
916 if (NILP (v))
|
|
|
917 message ("%s not defined in environment",
|
|
|
918 string_data (XSTRING (var)));
|
|
|
919 else
|
|
|
920 message ("\"%s\"", value);
|
|
|
921 }
|
|
|
922 RETURN_UNGCPRO (v);
|
|
|
923 }
|
|
|
924
|
|
|
925 /* A version of getenv that consults process_environment, easily
|
|
|
926 callable from C. */
|
|
|
927 char *
|
|
|
928 egetenv (CONST char *var)
|
|
|
929 {
|
|
|
930 Bufbyte *value;
|
|
|
931 Bytecount valuelen;
|
|
|
932
|
|
|
933 if (getenv_internal ((CONST Bufbyte *) var, strlen (var), &value, &valuelen))
|
|
|
934 return (char *) value;
|
|
|
935 else
|
|
|
936 return 0;
|
|
|
937 }
|
|
|
938 #endif /* not VMS */
|
|
|
939
|
|
|
940
|
|
|
941 void
|
|
|
942 init_callproc (void)
|
|
|
943 {
|
|
|
944 /* This function can GC */
|
|
|
945 REGISTER char *sh;
|
|
|
946 Lisp_Object tempdir;
|
|
|
947
|
|
|
948 Vprocess_environment = Qnil;
|
|
|
949 /* jwz: always initialize Vprocess_environment, so that egetenv() works
|
|
|
950 in temacs. */
|
|
|
951 {
|
|
|
952 char **envp;
|
|
|
953 for (envp = environ; envp && *envp; envp++)
|
|
|
954 Vprocess_environment = Fcons (build_ext_string (*envp, FORMAT_OS),
|
|
|
955 Vprocess_environment);
|
|
|
956 }
|
|
|
957
|
|
|
958 /* jwz: don't do these things when in temacs (this used to be the case by
|
|
|
959 virtue of egetenv() always returning 0, but that has been changed).
|
|
|
960 */
|
|
|
961 #ifndef CANNOT_DUMP
|
|
|
962 if (!initialized)
|
|
|
963 {
|
|
|
964 Vdata_directory = Qnil;
|
|
|
965 Vdoc_directory = Qnil;
|
|
|
966 Vexec_path = Qnil;
|
|
|
967 }
|
|
|
968 else
|
|
|
969 #endif
|
|
|
970 {
|
|
|
971 char *data_dir = egetenv ("EMACSDATA");
|
|
|
972 char *doc_dir = egetenv ("EMACSDOC");
|
|
|
973
|
|
|
974 #ifdef PATH_DATA
|
|
|
975 if (!data_dir)
|
|
|
976 data_dir = (char *) PATH_DATA;
|
|
|
977 #endif
|
|
|
978 #ifdef PATH_DOC
|
|
|
979 if (!doc_dir)
|
|
|
980 doc_dir = (char *) PATH_DOC;
|
|
|
981 #endif
|
|
|
982
|
|
|
983 if (data_dir)
|
|
|
984 Vdata_directory = Ffile_name_as_directory
|
|
|
985 (build_string (data_dir));
|
|
|
986 else
|
|
|
987 Vdata_directory = Qnil;
|
|
|
988 if (doc_dir)
|
|
|
989 Vdoc_directory = Ffile_name_as_directory
|
|
|
990 (build_string (doc_dir));
|
|
|
991 else
|
|
|
992 Vdoc_directory = Qnil;
|
|
|
993
|
|
|
994 /* Check the EMACSPATH environment variable, defaulting to the
|
|
|
995 PATH_EXEC path from paths.h. */
|
|
|
996 Vexec_path = decode_env_path ("EMACSPATH",
|
|
|
997 #ifdef PATH_EXEC
|
|
|
998 PATH_EXEC
|
|
|
999 #else
|
|
|
1000 0
|
|
|
1001 #endif
|
|
|
1002 );
|
|
|
1003 }
|
|
|
1004
|
|
|
1005 if (NILP (Vexec_path))
|
|
|
1006 Vexec_directory = Qnil;
|
|
|
1007 else
|
|
|
1008 Vexec_directory = Ffile_name_as_directory
|
|
|
1009 (Fcar (Vexec_path));
|
|
|
1010
|
|
|
1011 if (initialized)
|
|
|
1012 Vexec_path = nconc2 (decode_env_path ("PATH", 0),
|
|
|
1013 Vexec_path);
|
|
|
1014
|
|
|
1015 if (!NILP (Vexec_directory))
|
|
|
1016 {
|
|
|
1017 tempdir = Fdirectory_file_name (Vexec_directory);
|
|
|
1018 if (access ((char *) string_data (XSTRING (tempdir)), 0) < 0)
|
|
|
1019 {
|
|
|
1020 /* If the hard-coded path is bogus, fail silently.
|
|
|
1021 This will allow the normal heuristics to make an attempt. */
|
|
|
1022 #if 0
|
|
|
1023 warn_when_safe
|
|
|
1024 (Qpath, Qwarning,
|
|
|
1025 "Warning: machine-dependent data dir (%s) does not exist.\n",
|
|
|
1026 string_data (XSTRING (Vexec_directory)));
|
|
|
1027 #else
|
|
|
1028 Vexec_directory = Qnil;
|
|
|
1029 #endif
|
|
|
1030 }
|
|
|
1031 }
|
|
|
1032
|
|
|
1033 if (!NILP (Vdata_directory))
|
|
|
1034 {
|
|
|
1035 tempdir = Fdirectory_file_name (Vdata_directory);
|
|
|
1036 if (access ((char *) string_data (XSTRING (tempdir)), 0) < 0)
|
|
|
1037 {
|
|
|
1038 /* If the hard-coded path is bogus, fail silently.
|
|
|
1039 This will allow the normal heuristics to make an attempt. */
|
|
|
1040 #if 0
|
|
|
1041 warn_when_safe
|
|
|
1042 (Qpath, Qwarning,
|
|
|
1043 "Warning: machine-independent data dir (%s) does not exist.\n",
|
|
|
1044 string_data (XSTRING (Vdata_directory)));
|
|
|
1045 #else
|
|
|
1046 Vdata_directory = Qnil;
|
|
|
1047 #endif
|
|
|
1048 }
|
|
|
1049 }
|
|
|
1050
|
|
|
1051 #ifdef PATH_PREFIX
|
|
|
1052 Vprefix_directory = build_string ((char *) PATH_PREFIX);
|
|
|
1053 #else
|
|
|
1054 Vprefix_directory = Qnil;
|
|
|
1055 #endif
|
|
|
1056
|
|
|
1057 #ifdef VMS
|
|
|
1058 Vshell_file_name = build_string ("*dcl*");
|
|
|
1059 #else /* not VMS */
|
|
|
1060 sh = (char *) egetenv ("SHELL");
|
|
|
1061 #ifdef DOS_NT
|
|
|
1062 if (!sh) sh = egetenv ("COMSPEC");
|
|
|
1063 {
|
|
|
1064 char *tem;
|
|
|
1065 if (sh)
|
|
|
1066 {
|
|
|
1067 tem = (char *) alloca (strlen (sh) + 1);
|
|
|
1068 sh = dostounix_filename (strcpy (tem, sh));
|
|
|
1069 }
|
|
|
1070 }
|
|
|
1071 Vshell_file_name = build_string (sh ? sh : "/command.com");
|
|
|
1072 #else /* not DOS_NT */
|
|
|
1073 Vshell_file_name = build_string (sh ? sh : "/bin/sh");
|
|
|
1074 #endif /* not DOS_NT */
|
|
|
1075 #endif /* not VMS */
|
|
|
1076 }
|
|
|
1077
|
|
|
1078 #if 0
|
|
|
1079 void
|
|
|
1080 set_process_environment (void)
|
|
|
1081 {
|
|
|
1082 REGISTER char **envp;
|
|
|
1083
|
|
|
1084 Vprocess_environment = Qnil;
|
|
|
1085 #ifndef CANNOT_DUMP
|
|
|
1086 if (initialized)
|
|
|
1087 #endif
|
|
|
1088 for (envp = environ; *envp; envp++)
|
|
|
1089 Vprocess_environment = Fcons (build_string (*envp),
|
|
|
1090 Vprocess_environment);
|
|
|
1091 }
|
|
|
1092 #endif /* unused */
|
|
|
1093
|
|
|
1094 void
|
|
|
1095 syms_of_callproc (void)
|
|
|
1096 {
|
|
|
1097 #ifndef VMS
|
|
|
1098 defsubr (&Scall_process_internal);
|
|
|
1099 defsubr (&Sgetenv);
|
|
|
1100 #endif
|
|
|
1101 }
|
|
|
1102
|
|
|
1103 void
|
|
|
1104 vars_of_callproc (void)
|
|
|
1105 {
|
|
|
1106 /* This function can GC */
|
|
|
1107 #ifdef DOS_NT
|
|
|
1108 DEFVAR_LISP ("binary-process-input", &Vbinary_process_input /*
|
|
|
1109 *If non-nil then new subprocesses are assumed to take binary input.
|
|
|
1110 */ );
|
|
|
1111 Vbinary_process_input = Qnil;
|
|
|
1112
|
|
|
1113 DEFVAR_LISP ("binary-process-output", &Vbinary_process_output /*
|
|
|
1114 *If non-nil then new subprocesses are assumed to produce binary output.
|
|
|
1115 */ );
|
|
|
1116 Vbinary_process_output = Qnil;
|
|
|
1117 #endif /* DOS_NT */
|
|
|
1118
|
|
|
1119 DEFVAR_LISP ("shell-file-name", &Vshell_file_name /*
|
|
|
1120 *File name to load inferior shells from.
|
|
|
1121 Initialized from the SHELL environment variable.
|
|
|
1122 */ );
|
|
|
1123
|
|
|
1124 DEFVAR_LISP ("exec-path", &Vexec_path /*
|
|
|
1125 *List of directories to search programs to run in subprocesses.
|
|
|
1126 Each element is a string (directory name) or nil (try default directory).
|
|
|
1127 */ );
|
|
|
1128
|
|
|
1129 DEFVAR_LISP ("exec-directory", &Vexec_directory /*
|
|
|
1130 Directory of architecture-dependent files that come with XEmacs,
|
|
|
1131 especially executable programs intended for Emacs to invoke.
|
|
|
1132 */ );
|
|
|
1133
|
|
|
1134 DEFVAR_LISP ("data-directory", &Vdata_directory /*
|
|
|
1135 Directory of architecture-independent files that come with XEmacs,
|
|
|
1136 intended for Emacs to use.
|
|
|
1137 */ );
|
|
|
1138
|
|
|
1139 /* FSF puts the DOC file into data-directory. They do a bunch of
|
|
|
1140 contortions to attempt to put everything into the DOC file
|
|
|
1141 whether the support is there or not. */
|
|
|
1142 DEFVAR_LISP ("doc-directory", &Vdoc_directory /*
|
|
|
1143 Directory containing the DOC file that comes with XEmacs.
|
|
|
1144 This is usually the same as exec-directory.
|
|
|
1145 */ );
|
|
|
1146
|
|
|
1147 DEFVAR_LISP ("prefix-directory", &Vprefix_directory /*
|
|
|
1148 The default directory under which XEmacs is installed.
|
|
|
1149 */ );
|
|
|
1150
|
|
|
1151 DEFVAR_LISP ("process-environment", &Vprocess_environment /*
|
|
|
1152 List of environment variables for subprocesses to inherit.
|
|
|
1153 Each element should be a string of the form ENVVARNAME=VALUE.
|
|
|
1154 The environment which Emacs inherits is placed in this variable
|
|
|
1155 when Emacs starts.
|
|
|
1156 */ );
|
|
|
1157 }
|
|
|
1158
|
|
|
1159 void
|
|
|
1160 complex_vars_of_callproc (void)
|
|
|
1161 {
|
|
|
1162 DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory /*
|
|
|
1163 For internal use by the build procedure only.
|
|
|
1164 This is the name of the directory in which the build procedure installed
|
|
|
1165 Emacs's info files; the default value for Info-default-directory-list
|
|
|
1166 includes this.
|
|
|
1167 */ );
|
|
|
1168 #ifdef PATH_INFO
|
|
|
1169 Vconfigure_info_directory =
|
|
|
1170 Ffile_name_as_directory (build_string (PATH_INFO));
|
|
|
1171 #else
|
|
|
1172 Vconfigure_info_directory = Qnil;
|
|
|
1173 #endif
|
|
|
1174 }
|
