|
611
|
1 /* Old synchronous subprocess invocation for XEmacs.
|
|
428
|
2 Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc.
|
|
793
|
3 Copyright (C) 2000, 2001, 2002 Ben Wing.
|
|
428
|
4
|
|
|
5 This file is part of XEmacs.
|
|
|
6
|
|
|
7 XEmacs is free software; you can redistribute it and/or modify it
|
|
|
8 under the terms of the GNU General Public License as published by the
|
|
|
9 Free Software Foundation; either version 2, or (at your option) any
|
|
|
10 later version.
|
|
|
11
|
|
|
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
|
|
|
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
15 for more details.
|
|
|
16
|
|
|
17 You should have received a copy of the GNU General Public License
|
|
|
18 along with XEmacs; see the file COPYING. If not, write to
|
|
|
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
20 Boston, MA 02111-1307, USA. */
|
|
|
21
|
|
|
22 /* Synched up with: Mule 2.0, FSF 19.30. */
|
|
|
23 /* Partly sync'ed with 19.36.4 */
|
|
|
24
|
|
611
|
25
|
|
771
|
26 /* #### This ENTIRE file is only used in batch mode. (Well, almost;
|
|
|
27 certainly the main call-process stuff is only used in batch mode.)
|
|
611
|
28
|
|
|
29 We only need two things to get rid of both this and ntproc.c:
|
|
|
30
|
|
|
31 -- my `stderr-proc' ws, which adds support for a separate stderr
|
|
|
32 in asynch. subprocesses. (it's a feature in `old-call-process-internal'.)
|
|
|
33 -- a noninteractive event loop that supports processes.
|
|
|
34 */
|
|
|
35
|
|
428
|
36 #include <config.h>
|
|
|
37 #include "lisp.h"
|
|
|
38
|
|
|
39 #include "buffer.h"
|
|
|
40 #include "commands.h"
|
|
|
41 #include "insdel.h"
|
|
|
42 #include "lstream.h"
|
|
|
43 #include "process.h"
|
|
|
44 #include "sysdep.h"
|
|
|
45 #include "window.h"
|
|
|
46 #include "file-coding.h"
|
|
|
47
|
|
|
48 #include "systime.h"
|
|
|
49 #include "sysproc.h"
|
|
771
|
50 #include "sysfile.h" /* Always include after sysproc.h #### Why? This
|
|
|
51 rule is not followed elsewhere in XEmacs, without
|
|
|
52 apparent problems */
|
|
|
53 #include "syssignal.h" /* Always include before systty.h #### Why? This
|
|
|
54 rule is not followed elsewhere in XEmacs, without
|
|
|
55 apparent problems */
|
|
428
|
56 #include "systty.h"
|
|
771
|
57 #include "sysdir.h"
|
|
428
|
58
|
|
442
|
59 #ifdef WIN32_NATIVE
|
|
771
|
60 #include "syswindows.h"
|
|
428
|
61 #endif
|
|
|
62
|
|
442
|
63 #ifdef WIN32_NATIVE
|
|
428
|
64 /* When we are starting external processes we need to know whether they
|
|
|
65 take binary input (no conversion) or text input (\n is converted to
|
|
|
66 \r\n). Similarly for output: if newlines are written as \r\n then it's
|
|
|
67 text process output, otherwise it's binary. */
|
|
|
68 Lisp_Object Vbinary_process_input;
|
|
|
69 Lisp_Object Vbinary_process_output;
|
|
442
|
70 #endif /* WIN32_NATIVE */
|
|
428
|
71
|
|
|
72 Lisp_Object Vshell_file_name;
|
|
|
73
|
|
|
74 /* The environment to pass to all subprocesses when they are started.
|
|
|
75 This is in the semi-bogus format of ("VAR=VAL" "VAR2=VAL2" ... )
|
|
|
76 */
|
|
|
77 Lisp_Object Vprocess_environment;
|
|
|
78
|
|
|
79 /* True iff we are about to fork off a synchronous process or if we
|
|
|
80 are waiting for it. */
|
|
|
81 volatile int synch_process_alive;
|
|
|
82
|
|
|
83 /* Nonzero => this is a string explaining death of synchronous subprocess. */
|
|
442
|
84 const char *synch_process_death;
|
|
428
|
85
|
|
|
86 /* If synch_process_death is zero,
|
|
|
87 this is exit code of synchronous subprocess. */
|
|
|
88 int synch_process_retcode;
|
|
|
89
|
|
|
90 /* Clean up when exiting Fcall_process_internal.
|
|
442
|
91 On Windows, delete the temporary file on any kind of termination.
|
|
428
|
92 On Unix, kill the process and any children on termination by signal. */
|
|
|
93
|
|
|
94 /* Nonzero if this is termination due to exit. */
|
|
|
95 static int call_process_exited;
|
|
|
96
|
|
771
|
97 /* Make sure egetenv() not called too soon */
|
|
|
98 int env_initted;
|
|
|
99
|
|
428
|
100 Lisp_Object Vlisp_EXEC_SUFFIXES;
|
|
|
101
|
|
|
102 static Lisp_Object
|
|
|
103 call_process_kill (Lisp_Object fdpid)
|
|
|
104 {
|
|
|
105 Lisp_Object fd = Fcar (fdpid);
|
|
|
106 Lisp_Object pid = Fcdr (fdpid);
|
|
|
107
|
|
|
108 if (!NILP (fd))
|
|
771
|
109 retry_close (XINT (fd));
|
|
428
|
110
|
|
|
111 if (!NILP (pid))
|
|
|
112 EMACS_KILLPG (XINT (pid), SIGKILL);
|
|
|
113
|
|
|
114 synch_process_alive = 0;
|
|
|
115 return Qnil;
|
|
|
116 }
|
|
|
117
|
|
|
118 static Lisp_Object
|
|
|
119 call_process_cleanup (Lisp_Object fdpid)
|
|
|
120 {
|
|
440
|
121 int fd = XINT (Fcar (fdpid));
|
|
428
|
122 int pid = XINT (Fcdr (fdpid));
|
|
|
123
|
|
|
124 if (!call_process_exited &&
|
|
|
125 EMACS_KILLPG (pid, SIGINT) == 0)
|
|
|
126 {
|
|
|
127 int speccount = specpdl_depth ();
|
|
|
128
|
|
|
129 record_unwind_protect (call_process_kill, fdpid);
|
|
|
130 /* #### "c-G" -- need non-consing Single-key-description */
|
|
|
131 message ("Waiting for process to die...(type C-g again to kill it instantly)");
|
|
|
132
|
|
442
|
133 #ifdef WIN32_NATIVE
|
|
440
|
134 {
|
|
|
135 HANDLE pHandle = OpenProcess (PROCESS_ALL_ACCESS, 0, pid);
|
|
|
136 if (pHandle == NULL)
|
|
793
|
137 warn_when_safe (Qprocess, Qnotice,
|
|
432
|
138 "cannot open process (PID %d) for cleanup", pid);
|
|
440
|
139 else
|
|
|
140 wait_for_termination (pHandle);
|
|
|
141 }
|
|
432
|
142 #else
|
|
428
|
143 wait_for_termination (pid);
|
|
432
|
144 #endif
|
|
428
|
145
|
|
|
146 /* "Discard" the unwind protect. */
|
|
|
147 XCAR (fdpid) = Qnil;
|
|
|
148 XCDR (fdpid) = Qnil;
|
|
771
|
149 unbind_to (speccount);
|
|
428
|
150
|
|
|
151 message ("Waiting for process to die... done");
|
|
|
152 }
|
|
|
153 synch_process_alive = 0;
|
|
771
|
154 retry_close (fd);
|
|
428
|
155 return Qnil;
|
|
|
156 }
|
|
|
157
|
|
442
|
158 DEFUN ("old-call-process-internal", Fold_call_process_internal, 1, MANY, 0, /*
|
|
428
|
159 Call PROGRAM synchronously in separate process, with coding-system specified.
|
|
|
160 Arguments are
|
|
|
161 (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS).
|
|
|
162 The program's input comes from file INFILE (nil means `/dev/null').
|
|
|
163 Insert output in BUFFER before point; t means current buffer;
|
|
|
164 nil for BUFFER means discard it; 0 means discard and don't wait.
|
|
|
165 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
|
|
|
166 REAL-BUFFER says what to do with standard output, as above,
|
|
|
167 while STDERR-FILE says what to do with standard error in the child.
|
|
|
168 STDERR-FILE may be nil (discard standard error output),
|
|
|
169 t (mix it with ordinary output), or a file name string.
|
|
|
170
|
|
|
171 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
|
|
|
172 Remaining arguments are strings passed as command arguments to PROGRAM.
|
|
|
173
|
|
|
174 If BUFFER is 0, `call-process' returns immediately with value nil.
|
|
|
175 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
|
|
|
176 or a signal description string.
|
|
|
177 If you quit, the process is killed with SIGINT, or SIGKILL if you
|
|
|
178 quit again.
|
|
|
179 */
|
|
|
180 (int nargs, Lisp_Object *args))
|
|
|
181 {
|
|
|
182 /* This function can GC */
|
|
|
183 Lisp_Object infile, buffer, current_dir, display, path;
|
|
|
184 int fd[2];
|
|
|
185 int filefd;
|
|
442
|
186 #ifdef WIN32_NATIVE
|
|
432
|
187 HANDLE pHandle;
|
|
|
188 #endif
|
|
428
|
189 int pid;
|
|
|
190 char buf[16384];
|
|
|
191 char *bufptr = buf;
|
|
|
192 int bufsize = 16384;
|
|
|
193 int speccount = specpdl_depth ();
|
|
442
|
194 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
771
|
195 Intbyte **new_argv = alloca_array (Intbyte *, max (2, nargs - 2));
|
|
428
|
196
|
|
|
197 /* File to use for stderr in the child.
|
|
|
198 t means use same as standard output. */
|
|
|
199 Lisp_Object error_file;
|
|
|
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]))
|
|
563
|
208 signal_error (Qunimplemented, "Operating system cannot handle asynchronous subprocesses", Qunbound);
|
|
428
|
209 #endif /* NO_SUBPROCESSES */
|
|
|
210
|
|
502
|
211 /* Do all filename munging before building new_argv because GC in
|
|
|
212 * Lisp code called by various filename-hacking routines might
|
|
|
213 * relocate strings */
|
|
428
|
214 locate_file (Vexec_path, args[0], Vlisp_EXEC_SUFFIXES, &path, X_OK);
|
|
|
215
|
|
|
216 /* Make sure that the child will be able to chdir to the current
|
|
502
|
217 buffer's current directory, or its unhandled equivalent. [[ We
|
|
428
|
218 can't just have the child check for an error when it does the
|
|
502
|
219 chdir, since it's in a vfork. ]] -- not any more, we don't use
|
|
|
220 vfork. -ben
|
|
|
221
|
|
|
222 Note: These calls are spread out to insure that the return values
|
|
|
223 of the calls (which may be newly-created strings) are properly
|
|
|
224 GC-protected. */
|
|
428
|
225 {
|
|
|
226 struct gcpro ngcpro1, ngcpro2;
|
|
502
|
227 NGCPRO2 (current_dir, path); /* Caller gcprotects args[] */
|
|
446
|
228 current_dir = current_buffer->directory;
|
|
502
|
229 /* If the current dir has no terminating slash, we'll get undesirable
|
|
|
230 results, so put the slash back. */
|
|
|
231 current_dir = Ffile_name_as_directory (current_dir);
|
|
428
|
232 current_dir = Funhandled_file_name_directory (current_dir);
|
|
|
233 current_dir = expand_and_dir_to_file (current_dir, Qnil);
|
|
502
|
234
|
|
428
|
235 #if 0
|
|
|
236 /* This is in FSF, but it breaks everything in the presence of
|
|
|
237 ange-ftp-visited files, so away with it. */
|
|
|
238 if (NILP (Ffile_accessible_directory_p (current_dir)))
|
|
563
|
239 signal_error (Qprocess_error, "Setting current directory",
|
|
|
240 current_buffer->directory);
|
|
428
|
241 #endif /* 0 */
|
|
|
242 NUNGCPRO;
|
|
|
243 }
|
|
|
244
|
|
442
|
245 GCPRO2 (current_dir, path);
|
|
428
|
246
|
|
|
247 if (nargs >= 2 && ! NILP (args[1]))
|
|
|
248 {
|
|
|
249 struct gcpro ngcpro1;
|
|
|
250 NGCPRO1 (current_buffer->directory);
|
|
|
251 infile = Fexpand_file_name (args[1], current_buffer->directory);
|
|
|
252 NUNGCPRO;
|
|
|
253 CHECK_STRING (infile);
|
|
|
254 }
|
|
|
255 else
|
|
|
256 infile = build_string (NULL_DEVICE);
|
|
|
257
|
|
|
258 UNGCPRO;
|
|
|
259
|
|
442
|
260 GCPRO3 (infile, current_dir, path); /* Fexpand_file_name might trash it */
|
|
428
|
261
|
|
|
262 if (nargs >= 3)
|
|
|
263 {
|
|
|
264 buffer = args[2];
|
|
|
265
|
|
|
266 /* If BUFFER is a list, its meaning is
|
|
|
267 (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */
|
|
|
268 if (CONSP (buffer))
|
|
|
269 {
|
|
|
270 if (CONSP (XCDR (buffer)))
|
|
|
271 {
|
|
|
272 Lisp_Object file_for_stderr = XCAR (XCDR (buffer));
|
|
|
273
|
|
|
274 if (NILP (file_for_stderr) || EQ (Qt, file_for_stderr))
|
|
|
275 error_file = file_for_stderr;
|
|
|
276 else
|
|
|
277 error_file = Fexpand_file_name (file_for_stderr, Qnil);
|
|
|
278 }
|
|
|
279
|
|
|
280 buffer = XCAR (buffer);
|
|
|
281 }
|
|
|
282
|
|
|
283 if (!(EQ (buffer, Qnil)
|
|
|
284 || EQ (buffer, Qt)
|
|
|
285 || ZEROP (buffer)))
|
|
|
286 {
|
|
|
287 Lisp_Object spec_buffer = buffer;
|
|
|
288 buffer = Fget_buffer (buffer);
|
|
|
289 /* Mention the buffer name for a better error message. */
|
|
|
290 if (NILP (buffer))
|
|
|
291 CHECK_BUFFER (spec_buffer);
|
|
|
292 CHECK_BUFFER (buffer);
|
|
|
293 }
|
|
|
294 }
|
|
|
295 else
|
|
|
296 buffer = Qnil;
|
|
|
297
|
|
|
298 UNGCPRO;
|
|
|
299
|
|
|
300 display = ((nargs >= 4) ? args[3] : Qnil);
|
|
|
301
|
|
|
302 /* From here we assume we won't GC (unless an error is signaled). */
|
|
|
303 {
|
|
|
304 REGISTER int i;
|
|
|
305 for (i = 4; i < nargs; i++)
|
|
|
306 {
|
|
|
307 CHECK_STRING (args[i]);
|
|
771
|
308 new_argv[i - 3] = XSTRING_DATA (args[i]);
|
|
428
|
309 }
|
|
|
310 }
|
|
430
|
311 new_argv[max(nargs - 3,1)] = 0;
|
|
428
|
312
|
|
|
313 if (NILP (path))
|
|
771
|
314 signal_error (Qprocess_error, "Searching for program",
|
|
|
315 Fcons (args[0], Qnil));
|
|
|
316 new_argv[0] = XSTRING_DATA (path);
|
|
428
|
317
|
|
771
|
318 filefd = qxe_open (XSTRING_DATA (infile), O_RDONLY | OPEN_BINARY, 0);
|
|
428
|
319 if (filefd < 0)
|
|
563
|
320 report_process_error ("Opening process input file", infile);
|
|
428
|
321
|
|
|
322 if (INTP (buffer))
|
|
|
323 {
|
|
771
|
324 fd[1] = qxe_open ((Intbyte *) NULL_DEVICE, O_WRONLY | OPEN_BINARY, 0);
|
|
428
|
325 fd[0] = -1;
|
|
|
326 }
|
|
|
327 else
|
|
|
328 {
|
|
771
|
329 #ifdef WIN32_NATIVE
|
|
|
330 pipe_will_die_soon (fd);
|
|
|
331 #else
|
|
428
|
332 pipe (fd);
|
|
771
|
333 #endif
|
|
428
|
334 #if 0
|
|
|
335 /* Replaced by close_process_descs */
|
|
|
336 set_exclusive_use (fd[0]);
|
|
|
337 #endif
|
|
|
338 }
|
|
|
339
|
|
|
340 {
|
|
|
341 REGISTER int fd1 = fd[1];
|
|
|
342 int fd_error = fd1;
|
|
|
343
|
|
|
344 /* Record that we're about to create a synchronous process. */
|
|
|
345 synch_process_alive = 1;
|
|
|
346
|
|
|
347 /* These vars record information from process termination.
|
|
|
348 Clear them now before process can possibly terminate,
|
|
|
349 to avoid timing error if process terminates soon. */
|
|
|
350 synch_process_death = 0;
|
|
|
351 synch_process_retcode = 0;
|
|
|
352
|
|
|
353 if (NILP (error_file))
|
|
771
|
354 fd_error = qxe_open ((Intbyte *) NULL_DEVICE, O_WRONLY | OPEN_BINARY);
|
|
428
|
355 else if (STRINGP (error_file))
|
|
|
356 {
|
|
771
|
357 fd_error = qxe_open (XSTRING_DATA (error_file),
|
|
442
|
358 #ifdef WIN32_NATIVE
|
|
771
|
359 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
|
|
|
360 S_IREAD | S_IWRITE
|
|
442
|
361 #else /* not WIN32_NATIVE */
|
|
771
|
362 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
|
|
|
363 CREAT_MODE
|
|
442
|
364 #endif /* not WIN32_NATIVE */
|
|
771
|
365 );
|
|
428
|
366 }
|
|
|
367
|
|
|
368 if (fd_error < 0)
|
|
|
369 {
|
|
442
|
370 int save_errno = errno;
|
|
771
|
371 retry_close (filefd);
|
|
|
372 retry_close (fd[0]);
|
|
428
|
373 if (fd1 >= 0)
|
|
771
|
374 retry_close (fd1);
|
|
442
|
375 errno = save_errno;
|
|
771
|
376 report_process_error ("Cannot open", Fcons (error_file, Qnil));
|
|
428
|
377 }
|
|
|
378
|
|
442
|
379 #ifdef WIN32_NATIVE
|
|
771
|
380 pid = child_setup (filefd, fd1, fd_error, new_argv, current_dir);
|
|
432
|
381 if (!INTP (buffer))
|
|
|
382 {
|
|
|
383 /* OpenProcess() as soon after child_setup as possible. It's too
|
|
|
384 late once the process terminated. */
|
|
771
|
385 pHandle = OpenProcess (PROCESS_ALL_ACCESS, 0, pid);
|
|
432
|
386 #if 0
|
|
|
387 if (pHandle == NULL)
|
|
|
388 {
|
|
771
|
389 /* #### seems to cause crash in unbind_to_1(...) below. APA */
|
|
793
|
390 warn_when_safe (Qprocess, Qnotice,
|
|
432
|
391 "cannot open process to wait for");
|
|
|
392 }
|
|
|
393 #endif
|
|
|
394 }
|
|
|
395 /* Close STDERR into the parent process. We no longer need it. */
|
|
|
396 if (fd_error >= 0)
|
|
771
|
397 retry_close (fd_error);
|
|
442
|
398 #else /* not WIN32_NATIVE */
|
|
428
|
399 pid = fork ();
|
|
|
400
|
|
|
401 if (pid == 0)
|
|
|
402 {
|
|
|
403 if (fd[0] >= 0)
|
|
771
|
404 retry_close (fd[0]);
|
|
428
|
405 /* This is necessary because some shells may attempt to
|
|
|
406 access the current controlling terminal and will hang
|
|
|
407 if they are run in the background, as will be the case
|
|
|
408 when XEmacs is started in the background. Martin
|
|
|
409 Buchholz observed this problem running a subprocess
|
|
|
410 that used zsh to call gzip to uncompress an info
|
|
|
411 file. */
|
|
|
412 disconnect_controlling_terminal ();
|
|
771
|
413 child_setup (filefd, fd1, fd_error, new_argv, current_dir);
|
|
428
|
414 }
|
|
|
415 if (fd_error >= 0)
|
|
771
|
416 retry_close (fd_error);
|
|
428
|
417
|
|
442
|
418 #endif /* not WIN32_NATIVE */
|
|
428
|
419
|
|
|
420 /* Close most of our fd's, but not fd[0]
|
|
|
421 since we will use that to read input from. */
|
|
771
|
422 retry_close (filefd);
|
|
428
|
423 if (fd1 >= 0)
|
|
771
|
424 retry_close (fd1);
|
|
428
|
425 }
|
|
|
426
|
|
442
|
427 #ifndef WIN32_NATIVE
|
|
428
|
428 if (pid < 0)
|
|
|
429 {
|
|
442
|
430 int save_errno = errno;
|
|
428
|
431 if (fd[0] >= 0)
|
|
771
|
432 retry_close (fd[0]);
|
|
442
|
433 errno = save_errno;
|
|
563
|
434 report_process_error ("Doing fork", Qunbound);
|
|
428
|
435 }
|
|
432
|
436 #endif
|
|
428
|
437
|
|
|
438 if (INTP (buffer))
|
|
|
439 {
|
|
|
440 if (fd[0] >= 0)
|
|
771
|
441 retry_close (fd[0]);
|
|
428
|
442 #if defined (NO_SUBPROCESSES)
|
|
|
443 /* If Emacs has been built with asynchronous subprocess support,
|
|
|
444 we don't need to do this, I think because it will then have
|
|
|
445 the facilities for handling SIGCHLD. */
|
|
|
446 wait_without_blocking ();
|
|
|
447 #endif /* NO_SUBPROCESSES */
|
|
|
448 return Qnil;
|
|
|
449 }
|
|
|
450
|
|
|
451 {
|
|
|
452 int nread;
|
|
|
453 int total_read = 0;
|
|
|
454 Lisp_Object instream;
|
|
|
455 struct gcpro ngcpro1;
|
|
|
456
|
|
|
457 /* Enable sending signal if user quits below. */
|
|
|
458 call_process_exited = 0;
|
|
|
459
|
|
|
460 record_unwind_protect (call_process_cleanup,
|
|
|
461 Fcons (make_int (fd[0]), make_int (pid)));
|
|
|
462
|
|
|
463 /* FSFmacs calls Fset_buffer() here. We don't have to because
|
|
|
464 we can insert into buffers other than the current one. */
|
|
|
465 if (EQ (buffer, Qt))
|
|
793
|
466 buffer = wrap_buffer (current_buffer);
|
|
428
|
467 instream = make_filedesc_input_stream (fd[0], 0, -1, LSTR_ALLOW_QUIT);
|
|
|
468 instream =
|
|
771
|
469 make_coding_input_stream
|
|
428
|
470 (XLSTREAM (instream),
|
|
771
|
471 get_coding_system_for_text_file (Vcoding_system_for_read, 1),
|
|
|
472 CODING_DECODE);
|
|
428
|
473 Lstream_set_character_mode (XLSTREAM (instream));
|
|
|
474 NGCPRO1 (instream);
|
|
|
475 while (1)
|
|
|
476 {
|
|
|
477 QUIT;
|
|
|
478 /* Repeatedly read until we've filled as much as possible
|
|
|
479 of the buffer size we have. But don't read
|
|
|
480 less than 1024--save that for the next bufferfull. */
|
|
|
481
|
|
|
482 nread = 0;
|
|
|
483 while (nread < bufsize - 1024)
|
|
|
484 {
|
|
665
|
485 Bytecount this_read
|
|
428
|
486 = Lstream_read (XLSTREAM (instream), bufptr + nread,
|
|
|
487 bufsize - nread);
|
|
|
488
|
|
|
489 if (this_read < 0)
|
|
|
490 goto give_up;
|
|
|
491
|
|
|
492 if (this_read == 0)
|
|
|
493 goto give_up_1;
|
|
|
494
|
|
|
495 nread += this_read;
|
|
|
496 }
|
|
|
497
|
|
|
498 give_up_1:
|
|
|
499
|
|
|
500 /* Now NREAD is the total amount of data in the buffer. */
|
|
|
501 if (nread == 0)
|
|
|
502 break;
|
|
|
503
|
|
440
|
504 #if 0
|
|
771
|
505 /* [[check Vbinary_process_output]] */
|
|
440
|
506 #endif
|
|
428
|
507
|
|
|
508 total_read += nread;
|
|
|
509
|
|
|
510 if (!NILP (buffer))
|
|
665
|
511 buffer_insert_raw_string (XBUFFER (buffer), (Intbyte *) bufptr,
|
|
428
|
512 nread);
|
|
|
513
|
|
|
514 /* Make the buffer bigger as we continue to read more data,
|
|
|
515 but not past 64k. */
|
|
|
516 if (bufsize < 64 * 1024 && total_read > 32 * bufsize)
|
|
|
517 {
|
|
|
518 bufsize *= 2;
|
|
|
519 bufptr = (char *) alloca (bufsize);
|
|
|
520 }
|
|
|
521
|
|
|
522 if (!NILP (display) && INTERACTIVE)
|
|
|
523 {
|
|
|
524 redisplay ();
|
|
|
525 }
|
|
|
526 }
|
|
|
527 give_up:
|
|
|
528 Lstream_close (XLSTREAM (instream));
|
|
|
529 NUNGCPRO;
|
|
|
530
|
|
|
531 QUIT;
|
|
|
532 /* Wait for it to terminate, unless it already has. */
|
|
442
|
533 #ifdef WIN32_NATIVE
|
|
432
|
534 wait_for_termination (pHandle);
|
|
|
535 #else
|
|
428
|
536 wait_for_termination (pid);
|
|
432
|
537 #endif
|
|
428
|
538
|
|
|
539 /* Don't kill any children that the subprocess may have left behind
|
|
|
540 when exiting. */
|
|
|
541 call_process_exited = 1;
|
|
771
|
542 unbind_to (speccount);
|
|
428
|
543
|
|
|
544 if (synch_process_death)
|
|
771
|
545 return build_msg_string (synch_process_death);
|
|
428
|
546 return make_int (synch_process_retcode);
|
|
|
547 }
|
|
|
548 }
|
|
|
549
|
|
|
550
|
|
|
551
|
|
|
552 /* Move the file descriptor FD so that its number is not less than MIN. *
|
|
|
553 The original file descriptor remains open. */
|
|
|
554 static int
|
|
|
555 relocate_fd (int fd, int min)
|
|
|
556 {
|
|
|
557 if (fd >= min)
|
|
|
558 return fd;
|
|
|
559 else
|
|
|
560 {
|
|
|
561 int newfd = dup (fd);
|
|
|
562 if (newfd == -1)
|
|
|
563 {
|
|
771
|
564 Intbyte *errmess;
|
|
|
565 GET_STRERROR (errmess, errno);
|
|
|
566 stderr_out ("Error while setting up child: %s\n", errmess);
|
|
428
|
567 _exit (1);
|
|
|
568 }
|
|
|
569 return relocate_fd (newfd, min);
|
|
|
570 }
|
|
|
571 }
|
|
|
572
|
|
|
573 /* This is the last thing run in a newly forked inferior
|
|
|
574 either synchronous or asynchronous.
|
|
|
575 Copy descriptors IN, OUT and ERR
|
|
|
576 as descriptors STDIN_FILENO, STDOUT_FILENO, and STDERR_FILENO.
|
|
|
577 Initialize inferior's priority, pgrp, connected dir and environment.
|
|
|
578 then exec another program based on new_argv.
|
|
|
579
|
|
|
580 XEmacs: We've removed the SET_PGRP argument because it's already
|
|
|
581 done by the callers of child_setup.
|
|
|
582
|
|
|
583 CURRENT_DIR is an elisp string giving the path of the current
|
|
|
584 directory the subprocess should have. Since we can't really signal
|
|
771
|
585 a decent error from within the child (not quite correct in
|
|
|
586 XEmacs?), this should be verified as an executable directory by the
|
|
|
587 parent. */
|
|
428
|
588
|
|
442
|
589 #ifdef WIN32_NATIVE
|
|
428
|
590 int
|
|
|
591 #else
|
|
|
592 void
|
|
|
593 #endif
|
|
771
|
594 child_setup (int in, int out, int err, Intbyte **new_argv,
|
|
|
595 Lisp_Object current_dir)
|
|
428
|
596 {
|
|
771
|
597 Intbyte **env;
|
|
|
598 Intbyte *pwd;
|
|
442
|
599 #ifdef WIN32_NATIVE
|
|
428
|
600 int cpid;
|
|
|
601 HANDLE handles[4];
|
|
442
|
602 #endif /* WIN32_NATIVE */
|
|
428
|
603
|
|
|
604 #ifdef SET_EMACS_PRIORITY
|
|
|
605 if (emacs_priority != 0)
|
|
|
606 nice (- emacs_priority);
|
|
|
607 #endif
|
|
|
608
|
|
442
|
609 /* Under Windows, we are not in a child process at all, so we should
|
|
|
610 not close handles inherited from the parent -- we are the parent
|
|
|
611 and doing so will screw up all manner of things! Similarly, most
|
|
|
612 of the rest of the cleanup done in this function is not done
|
|
|
613 under Windows.
|
|
|
614
|
|
|
615 #### This entire child_setup() function is an utter and complete
|
|
|
616 piece of shit. I would rewrite it, at the very least splitting
|
|
|
617 out the Windows and non-Windows stuff into two completely
|
|
|
618 different functions; but instead I'm trying to make it go away
|
|
|
619 entirely, using the Lisp definition in process.el. What's left
|
|
|
620 is to fix up the routines in event-msw.c (and in event-Xt.c and
|
|
|
621 event-tty.c) to allow for stream devices to be handled correctly.
|
|
|
622 There isn't much to do, in fact, and I'll fix it shortly. That
|
|
|
623 way, the Lisp definition can be used non-interactively too. */
|
|
|
624 #if !defined (NO_SUBPROCESSES) && !defined (WIN32_NATIVE)
|
|
428
|
625 /* Close Emacs's descriptors that this process should not have. */
|
|
|
626 close_process_descs ();
|
|
|
627 #endif /* not NO_SUBPROCESSES */
|
|
442
|
628 #ifndef WIN32_NATIVE
|
|
428
|
629 close_load_descs ();
|
|
442
|
630 #endif
|
|
428
|
631
|
|
771
|
632 /* [[Note that use of alloca is always safe here. It's obvious for systems
|
|
428
|
633 that do not have true vfork or that have true (stack) alloca.
|
|
|
634 If using vfork and C_ALLOCA it is safe because that changes
|
|
|
635 the superior's static variables as if the superior had done alloca
|
|
771
|
636 and will be cleaned up in the usual way.]] -- irrelevant because
|
|
|
637 XEmacs does not use vfork. */
|
|
428
|
638 {
|
|
771
|
639 REGISTER Bytecount i;
|
|
428
|
640
|
|
771
|
641 i = XSTRING_LENGTH (current_dir);
|
|
|
642 pwd = alloca_array (Intbyte, i + 6);
|
|
428
|
643 memcpy (pwd, "PWD=", 4);
|
|
771
|
644 memcpy (pwd + 4, XSTRING_DATA (current_dir), i);
|
|
428
|
645 i += 4;
|
|
|
646 if (!IS_DIRECTORY_SEP (pwd[i - 1]))
|
|
|
647 pwd[i++] = DIRECTORY_SEP;
|
|
|
648 pwd[i] = 0;
|
|
|
649
|
|
771
|
650 /* [[We can't signal an Elisp error here; we're in a vfork. Since
|
|
428
|
651 the callers check the current directory before forking, this
|
|
|
652 should only return an error if the directory's permissions
|
|
|
653 are changed between the check and this chdir, but we should
|
|
771
|
654 at least check.]] -- irrelevant because XEmacs does not use vfork. */
|
|
|
655 if (qxe_chdir (pwd + 4) < 0)
|
|
428
|
656 {
|
|
|
657 /* Don't report the chdir error, or ange-ftp.el doesn't work. */
|
|
|
658 /* (FSFmacs does _exit (errno) here.) */
|
|
|
659 pwd = 0;
|
|
|
660 }
|
|
|
661 else
|
|
|
662 {
|
|
|
663 /* Strip trailing "/". Cretinous *[]&@$#^%@#$% Un*x */
|
|
|
664 /* leave "//" (from FSF) */
|
|
|
665 while (i > 6 && IS_DIRECTORY_SEP (pwd[i - 1]))
|
|
|
666 pwd[--i] = 0;
|
|
|
667 }
|
|
|
668 }
|
|
|
669
|
|
|
670 /* Set `env' to a vector of the strings in Vprocess_environment. */
|
|
|
671 /* + 2 to include PWD and terminating 0. */
|
|
771
|
672 env = alloca_array (Intbyte *, XINT (Flength (Vprocess_environment)) + 2);
|
|
428
|
673 {
|
|
|
674 REGISTER Lisp_Object tail;
|
|
771
|
675 Intbyte **new_env = env;
|
|
428
|
676
|
|
|
677 /* If we have a PWD envvar and we know the real current directory,
|
|
|
678 pass one down, but with corrected value. */
|
|
771
|
679 if (pwd && egetenv ("PWD"))
|
|
428
|
680 *new_env++ = pwd;
|
|
|
681
|
|
|
682 /* Copy the Vprocess_environment strings into new_env. */
|
|
|
683 for (tail = Vprocess_environment;
|
|
|
684 CONSP (tail) && STRINGP (XCAR (tail));
|
|
|
685 tail = XCDR (tail))
|
|
771
|
686 {
|
|
|
687 Intbyte **ep = env;
|
|
|
688 Intbyte *envvar = XSTRING_DATA (XCAR (tail));
|
|
428
|
689
|
|
771
|
690 /* See if envvar duplicates any string already in the env.
|
|
428
|
691 If so, don't put it in.
|
|
|
692 When an env var has multiple definitions,
|
|
|
693 we keep the definition that comes first in process-environment. */
|
|
|
694 for (; ep != new_env; ep++)
|
|
|
695 {
|
|
771
|
696 Intbyte *p = *ep, *q = envvar;
|
|
428
|
697 while (1)
|
|
|
698 {
|
|
|
699 if (*q == 0)
|
|
|
700 /* The string is malformed; might as well drop it. */
|
|
|
701 goto duplicate;
|
|
|
702 if (*q != *p)
|
|
|
703 break;
|
|
|
704 if (*q == '=')
|
|
|
705 goto duplicate;
|
|
|
706 p++, q++;
|
|
|
707 }
|
|
|
708 }
|
|
771
|
709 if (pwd && !qxestrncmp ((Intbyte *) "PWD=", envvar, 4))
|
|
428
|
710 {
|
|
|
711 *new_env++ = pwd;
|
|
|
712 pwd = 0;
|
|
|
713 }
|
|
|
714 else
|
|
771
|
715 *new_env++ = envvar;
|
|
428
|
716
|
|
|
717 duplicate: ;
|
|
|
718 }
|
|
771
|
719
|
|
428
|
720 *new_env = 0;
|
|
|
721 }
|
|
|
722
|
|
442
|
723 #ifdef WIN32_NATIVE
|
|
428
|
724 prepare_standard_handles (in, out, err, handles);
|
|
771
|
725 /* #### junk! But all this win32 code will die soon. */
|
|
|
726 set_process_dir ((char *) XSTRING_DATA (current_dir));
|
|
442
|
727 #else /* not WIN32_NATIVE */
|
|
428
|
728 /* Make sure that in, out, and err are not actually already in
|
|
|
729 descriptors zero, one, or two; this could happen if Emacs is
|
|
|
730 started with its standard in, out, or error closed, as might
|
|
|
731 happen under X. */
|
|
|
732 in = relocate_fd (in, 3);
|
|
|
733 out = relocate_fd (out, 3);
|
|
|
734 err = relocate_fd (err, 3);
|
|
|
735
|
|
|
736 /* Set the standard input/output channels of the new process. */
|
|
771
|
737 retry_close (STDIN_FILENO);
|
|
|
738 retry_close (STDOUT_FILENO);
|
|
|
739 retry_close (STDERR_FILENO);
|
|
428
|
740
|
|
|
741 dup2 (in, STDIN_FILENO);
|
|
|
742 dup2 (out, STDOUT_FILENO);
|
|
|
743 dup2 (err, STDERR_FILENO);
|
|
|
744
|
|
771
|
745 retry_close (in);
|
|
|
746 retry_close (out);
|
|
|
747 retry_close (err);
|
|
428
|
748
|
|
|
749 /* I can't think of any reason why child processes need any more
|
|
|
750 than the standard 3 file descriptors. It would be cleaner to
|
|
|
751 close just the ones that need to be, but the following brute
|
|
|
752 force approach is certainly effective, and not too slow. */
|
|
|
753 {
|
|
|
754 int fd;
|
|
|
755 for (fd=3; fd<=64; fd++)
|
|
771
|
756 retry_close (fd);
|
|
428
|
757 }
|
|
442
|
758 #endif /* not WIN32_NATIVE */
|
|
428
|
759
|
|
|
760 #ifdef vipc
|
|
|
761 something missing here;
|
|
|
762 #endif /* vipc */
|
|
|
763
|
|
442
|
764 #ifdef WIN32_NATIVE
|
|
428
|
765 /* Spawn the child. (See ntproc.c:Spawnve). */
|
|
771
|
766 /* #### junk! arguments not converted. But all this win32 code
|
|
|
767 will die soon. */
|
|
|
768 cpid = spawnve_will_die_soon (_P_NOWAIT, new_argv[0],
|
|
|
769 (const char* const*)new_argv,
|
|
|
770 (const char* const*)env);
|
|
428
|
771 if (cpid == -1)
|
|
|
772 /* An error occurred while trying to spawn the process. */
|
|
563
|
773 report_process_error ("Spawning child process", Qunbound);
|
|
428
|
774 reset_standard_handles (in, out, err, handles);
|
|
|
775 return cpid;
|
|
442
|
776 #else /* not WIN32_NATIVE */
|
|
771
|
777 /* we've wrapped execve; it translates its arguments */
|
|
|
778 qxe_execve (new_argv[0], new_argv, env);
|
|
428
|
779
|
|
|
780 stdout_out ("Can't exec program %s\n", new_argv[0]);
|
|
|
781 _exit (1);
|
|
442
|
782 #endif /* not WIN32_NATIVE */
|
|
428
|
783 }
|
|
|
784
|
|
|
785 static int
|
|
665
|
786 getenv_internal (const Intbyte *var,
|
|
428
|
787 Bytecount varlen,
|
|
665
|
788 Intbyte **value,
|
|
428
|
789 Bytecount *valuelen)
|
|
|
790 {
|
|
|
791 Lisp_Object scan;
|
|
|
792
|
|
771
|
793 assert (env_initted);
|
|
|
794
|
|
428
|
795 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
|
|
|
796 {
|
|
|
797 Lisp_Object entry = XCAR (scan);
|
|
|
798
|
|
|
799 if (STRINGP (entry)
|
|
|
800 && XSTRING_LENGTH (entry) > varlen
|
|
|
801 && XSTRING_BYTE (entry, varlen) == '='
|
|
442
|
802 #ifdef WIN32_NATIVE
|
|
428
|
803 /* NT environment variables are case insensitive. */
|
|
|
804 && ! memicmp (XSTRING_DATA (entry), var, varlen)
|
|
442
|
805 #else /* not WIN32_NATIVE */
|
|
428
|
806 && ! memcmp (XSTRING_DATA (entry), var, varlen)
|
|
442
|
807 #endif /* not WIN32_NATIVE */
|
|
428
|
808 )
|
|
|
809 {
|
|
|
810 *value = XSTRING_DATA (entry) + (varlen + 1);
|
|
|
811 *valuelen = XSTRING_LENGTH (entry) - (varlen + 1);
|
|
|
812 return 1;
|
|
|
813 }
|
|
|
814 }
|
|
|
815
|
|
|
816 return 0;
|
|
|
817 }
|
|
|
818
|
|
771
|
819 static void
|
|
|
820 putenv_internal (const Intbyte *var,
|
|
|
821 Bytecount varlen,
|
|
|
822 const Intbyte *value,
|
|
|
823 Bytecount valuelen)
|
|
|
824 {
|
|
|
825 Lisp_Object scan;
|
|
|
826
|
|
|
827 assert (env_initted);
|
|
|
828
|
|
|
829 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
|
|
|
830 {
|
|
|
831 Lisp_Object entry = XCAR (scan);
|
|
|
832
|
|
|
833 if (STRINGP (entry)
|
|
|
834 && XSTRING_LENGTH (entry) > varlen
|
|
|
835 && XSTRING_BYTE (entry, varlen) == '='
|
|
|
836 #ifdef WIN32_NATIVE
|
|
|
837 /* NT environment variables are case insensitive. */
|
|
|
838 && ! memicmp (XSTRING_DATA (entry), var, varlen)
|
|
|
839 #else /* not WIN32_NATIVE */
|
|
|
840 && ! memcmp (XSTRING_DATA (entry), var, varlen)
|
|
|
841 #endif /* not WIN32_NATIVE */
|
|
|
842 )
|
|
|
843 {
|
|
|
844 XCAR (scan) = concat3 (make_string (var, varlen),
|
|
|
845 build_string ("="),
|
|
|
846 make_string (value, valuelen));
|
|
|
847 return;
|
|
|
848 }
|
|
|
849 }
|
|
|
850
|
|
|
851 Vprocess_environment = Fcons (concat3 (make_string (var, varlen),
|
|
|
852 build_string ("="),
|
|
|
853 make_string (value, valuelen)),
|
|
|
854 Vprocess_environment);
|
|
|
855 }
|
|
|
856
|
|
|
857 /* NOTE:
|
|
|
858
|
|
|
859 FSF has this as a Lisp function, as follows. Generally moving things
|
|
|
860 out of C and into Lisp is a good idea, but in this case the Lisp
|
|
|
861 function is used so early in the startup sequence that it would be ugly
|
|
|
862 to rearrange the early dumped code to accommodate this.
|
|
|
863
|
|
|
864 (defun getenv (variable)
|
|
|
865 "Get the value of environment variable VARIABLE.
|
|
|
866 VARIABLE should be a string. Value is nil if VARIABLE is undefined in
|
|
|
867 the environment. Otherwise, value is a string.
|
|
|
868
|
|
|
869 This function consults the variable `process-environment'
|
|
|
870 for its value."
|
|
|
871 (interactive (list (read-envvar-name "Get environment variable: " t)))
|
|
|
872 (let ((value (getenv-internal variable)))
|
|
|
873 (when (interactive-p)
|
|
|
874 (message "%s" (if value value "Not set")))
|
|
|
875 value))
|
|
|
876 */
|
|
|
877
|
|
428
|
878 DEFUN ("getenv", Fgetenv, 1, 2, "sEnvironment variable: \np", /*
|
|
|
879 Return the value of environment variable VAR, as a string.
|
|
|
880 VAR is a string, the name of the variable.
|
|
|
881 When invoked interactively, prints the value in the echo area.
|
|
|
882 */
|
|
|
883 (var, interactivep))
|
|
|
884 {
|
|
665
|
885 Intbyte *value;
|
|
428
|
886 Bytecount valuelen;
|
|
|
887 Lisp_Object v = Qnil;
|
|
|
888 struct gcpro gcpro1;
|
|
|
889
|
|
|
890 CHECK_STRING (var);
|
|
|
891 GCPRO1 (v);
|
|
|
892 if (getenv_internal (XSTRING_DATA (var), XSTRING_LENGTH (var),
|
|
|
893 &value, &valuelen))
|
|
|
894 v = make_string (value, valuelen);
|
|
|
895 if (!NILP (interactivep))
|
|
|
896 {
|
|
|
897 if (NILP (v))
|
|
|
898 message ("%s not defined in environment", XSTRING_DATA (var));
|
|
|
899 else
|
|
|
900 /* #### Should use Fprin1_to_string or Fprin1 to handle string
|
|
|
901 containing quotes correctly. */
|
|
|
902 message ("\"%s\"", value);
|
|
|
903 }
|
|
|
904 RETURN_UNGCPRO (v);
|
|
|
905 }
|
|
|
906
|
|
771
|
907 /* A version of getenv that consults Vprocess_environment, easily
|
|
|
908 callable from C.
|
|
|
909
|
|
|
910 (At init time, Vprocess_environment is initialized from the
|
|
|
911 environment, stored in the global variable environ. [Note that
|
|
|
912 at startup time, `environ' should be the same as the envp parameter
|
|
|
913 passed to main(); however, later calls to putenv() may change
|
|
|
914 `environ', making the envp parameter inaccurate.] Calls to getenv()
|
|
|
915 and putenv() consult and modify `environ'. However, once
|
|
|
916 Vprocess_environment is initted, XEmacs C code should *NEVER* call
|
|
|
917 getenv() or putenv() directly, because (1) Lisp code that modifies
|
|
|
918 the environment only modifies Vprocess_environment, not `environ';
|
|
|
919 and (2) Vprocess_environment is in internal format but `environ'
|
|
|
920 is in some external format, and getenv()/putenv() are not Mule-
|
|
|
921 encapsulated.
|
|
|
922
|
|
|
923 WARNING: This value points into Lisp string data and thus will become
|
|
|
924 invalid after a GC. */
|
|
|
925
|
|
|
926 Intbyte *
|
|
|
927 egetenv (const CIntbyte *var)
|
|
428
|
928 {
|
|
442
|
929 /* This cannot GC -- 7-28-00 ben */
|
|
665
|
930 Intbyte *value;
|
|
428
|
931 Bytecount valuelen;
|
|
|
932
|
|
665
|
933 if (getenv_internal ((const Intbyte *) var, strlen (var), &value, &valuelen))
|
|
771
|
934 return value;
|
|
428
|
935 else
|
|
|
936 return 0;
|
|
|
937 }
|
|
|
938
|
|
771
|
939 void
|
|
|
940 eputenv (const CIntbyte *var, const CIntbyte *value)
|
|
|
941 {
|
|
|
942 putenv_internal ((Intbyte *) var, strlen (var), (Intbyte *) value,
|
|
|
943 strlen (value));
|
|
|
944 }
|
|
|
945
|
|
428
|
946
|
|
|
947 void
|
|
|
948 init_callproc (void)
|
|
|
949 {
|
|
|
950 /* This function can GC */
|
|
|
951
|
|
|
952 {
|
|
|
953 /* jwz: always initialize Vprocess_environment, so that egetenv()
|
|
|
954 works in temacs. */
|
|
|
955 char **envp;
|
|
|
956 Vprocess_environment = Qnil;
|
|
|
957 for (envp = environ; envp && *envp; envp++)
|
|
440
|
958 Vprocess_environment =
|
|
771
|
959 Fcons (build_ext_string (*envp, Qnative), Vprocess_environment);
|
|
|
960 /* This gets set back to 0 in disksave_object_finalization() */
|
|
|
961 env_initted = 1;
|
|
428
|
962 }
|
|
|
963
|
|
|
964 {
|
|
|
965 /* Initialize shell-file-name from environment variables or best guess. */
|
|
442
|
966 #ifdef WIN32_NATIVE
|
|
771
|
967 const Intbyte *shell = egetenv ("SHELL");
|
|
611
|
968 if (!shell) shell = egetenv ("COMSPEC");
|
|
|
969 /* Should never happen! */
|
|
771
|
970 if (!shell) shell =
|
|
|
971 (Intbyte *) (GetVersion () & 0x80000000 ? "command" : "cmd");
|
|
442
|
972 #else /* not WIN32_NATIVE */
|
|
771
|
973 const Intbyte *shell = egetenv ("SHELL");
|
|
|
974 if (!shell) shell = (Intbyte *) "/bin/sh";
|
|
428
|
975 #endif
|
|
|
976
|
|
611
|
977 #if 0 /* defined (WIN32_NATIVE) */
|
|
|
978 /* BAD BAD BAD. We do not wanting to be passing an XEmacs-created
|
|
|
979 SHELL var down to some inferior Cygwin process, which might get
|
|
|
980 screwed up.
|
|
|
981
|
|
|
982 There are a few broken apps (eterm/term.el, eterm/tshell.el,
|
|
|
983 os-utils/terminal.el, texinfo/tex-mode.el) where this will
|
|
|
984 cause problems. Those broken apps don't look at
|
|
|
985 shell-file-name, instead just at explicit-shell-file-name,
|
|
|
986 ESHELL and SHELL. They are apparently attempting to borrow
|
|
|
987 what `M-x shell' uses, but that latter also looks at
|
|
|
988 shell-file-name. What we want is for all of these apps to look
|
|
|
989 at shell-file-name, so that the user can change the value of
|
|
|
990 shell-file-name and everything will work out hunky-dorey.
|
|
|
991 */
|
|
|
992
|
|
|
993 if (!egetenv ("SHELL"))
|
|
|
994 {
|
|
771
|
995 Intbyte *faux_var = alloca_array (Intbyte, 7 + qxestrlen (shell));
|
|
|
996 qxesprintf (faux_var, "SHELL=%s", shell);
|
|
|
997 Vprocess_environment = Fcons (build_intstring (faux_var),
|
|
611
|
998 Vprocess_environment);
|
|
|
999 }
|
|
|
1000 #endif /* 0 */
|
|
|
1001
|
|
771
|
1002 Vshell_file_name = build_intstring (shell);
|
|
428
|
1003 }
|
|
|
1004 }
|
|
|
1005
|
|
|
1006 void
|
|
|
1007 syms_of_callproc (void)
|
|
|
1008 {
|
|
442
|
1009 DEFSUBR (Fold_call_process_internal);
|
|
428
|
1010 DEFSUBR (Fgetenv);
|
|
|
1011 }
|
|
|
1012
|
|
|
1013 void
|
|
|
1014 vars_of_callproc (void)
|
|
|
1015 {
|
|
|
1016 /* This function can GC */
|
|
442
|
1017 #ifdef WIN32_NATIVE
|
|
771
|
1018 /* Will die as soon as callproc.c dies */
|
|
428
|
1019 DEFVAR_LISP ("binary-process-input", &Vbinary_process_input /*
|
|
|
1020 *If non-nil then new subprocesses are assumed to take binary input.
|
|
|
1021 */ );
|
|
|
1022 Vbinary_process_input = Qnil;
|
|
|
1023
|
|
|
1024 DEFVAR_LISP ("binary-process-output", &Vbinary_process_output /*
|
|
|
1025 *If non-nil then new subprocesses are assumed to produce binary output.
|
|
|
1026 */ );
|
|
|
1027 Vbinary_process_output = Qnil;
|
|
442
|
1028 #endif /* WIN32_NATIVE */
|
|
428
|
1029
|
|
|
1030 DEFVAR_LISP ("shell-file-name", &Vshell_file_name /*
|
|
|
1031 *File name to load inferior shells from.
|
|
|
1032 Initialized from the SHELL environment variable.
|
|
|
1033 */ );
|
|
|
1034
|
|
|
1035 DEFVAR_LISP ("process-environment", &Vprocess_environment /*
|
|
|
1036 List of environment variables for subprocesses to inherit.
|
|
|
1037 Each element should be a string of the form ENVVARNAME=VALUE.
|
|
|
1038 The environment which Emacs inherits is placed in this variable
|
|
|
1039 when Emacs starts.
|
|
|
1040 */ );
|
|
|
1041
|
|
|
1042 Vlisp_EXEC_SUFFIXES = build_string (EXEC_SUFFIXES);
|
|
|
1043 staticpro (&Vlisp_EXEC_SUFFIXES);
|
|
|
1044 }
|
