Mercurial > hg > xemacs-beta
comparison src/callproc.c @ 814:a634e3b7acc8
[xemacs-hg @ 2002-04-14 12:41:59 by ben]
latest changes
TODO.ben-mule-21-5: Update.
make-docfile.c: Add basic support for handling ISO 2022 doc strings -- we parse
the basic charset designation sequences so we know whether we're
in ASCII and have to pay attention to end quotes and such.
Reformat code according to coding standards.
abbrev.el: Add `global-abbrev-mode', which turns on or off abbrev-mode in all
buffers. Added `defining-abbrev-turns-on-abbrev-mode' -- if
non-nil, defining an abbrev through an interactive function will
automatically turn on abbrev-mode, either globally or locally
depending on the command. This is the "what you'd expect"
behavior.
indent.el: general function for indenting a balanced expression in a
mode-correct way. Works similar to indent-region in that a mode
can specify a specific command to do the whole operation; if not,
figure out the region using forward-sexp and indent each line
using indent-according-to-mode.
keydefs.el: Removed.
Modify M-C-backslash to do indent-region-or-balanced-expression.
Make S-Tab just insert a TAB char, like it's meant to do.
make-docfile.el: Now that we're using the call-process-in-lisp, we need to load
an extra file win32-native.el because we're running a bare temacs.
menubar-items.el: Totally redo the Cmds menu so that most used commands appear
directly on the menu and less used commands appear in submenus.
The old way may have been very pretty, but rather impractical.
process.el: Under Windows, don't ever use old-call-process-internal, even
in batch mode. We can do processes in batch mode.
subr.el: Someone recoded truncate-string-to-width, saying "the FSF version
is too complicated and does lots of hard-to-understand stuff" but
the resulting recoded version was *totally* wrong! it
misunderstood the basic point of this function, which is work in
*columns* not chars. i dumped ours and copied the version from
FSF 21.1. Also added truncate-string-with-continuation-dots,
since this idiom is used often.
config.inc.samp, xemacs.mak: Separate out debug and optimize flags.
Remove all vestiges of USE_MINIMAL_TAGBITS,
USE_INDEXED_LRECORD_IMPLEMENTATION, and GUNG_HO, since those
ifdefs have long been removed.
Make error-checking support actually work.
Some rearrangement of config.inc.samp to make it more logical.
Remove callproc.c and ntproc.c from xemacs.mak, no longer used.
Make pdump the default.
lisp.h: Add support for strong type-checking of Bytecount, Bytebpos,
Charcount, Charbpos, and others, by making them classes,
overloading the operators to provide integer-like operation and
carefully controlling what operations are allowed. Not currently
enabled in C++ builds because there are still a number of compile
errors, and it won't really work till we merge in my "8-bit-Mule"
workspace, in which I make use of the new types Charxpos,
Bytexpos, Memxpos, representing a "position" either in a buffer or
a string. (This is especially important in the extent code.)
abbrev.c, alloc.c, eval.c, buffer.c, buffer.h, editfns.c, fns.c, text.h: Warning fixes, some of them related to new C++ strict type
checking of Bytecount, Charbpos, etc.
dired.c: Caught an actual error due to strong type checking -- char len
being passed when should be byte len.
alloc.c, backtrace.h, bytecode.c, bytecode.h, eval.c, sysdep.c: Further optimize Ffuncall:
-- process arg list at compiled-function creation time, converting
into an array for extra-quick access at funcall time.
-- rewrite funcall_compiled_function to use it, and inline this
function.
-- change the order of check for magic stuff in
SPECBIND_FAST_UNSAFE to be faster.
-- move the check for need to garbage collect into the allocation
code, so only a single flag needs to be checked in funcall.
buffer.c, symbols.c: add debug funs to check on mule optimization info in buffers and
strings.
eval.c, emacs.c, text.c, regex.c, scrollbar-msw.c, search.c: Fix evil crashes due to eistrings not properly reinitialized under
pdump. Redo a bit some of the init routines; convert some
complex_vars_of() into simple vars_of(), because they didn't need
complex processing.
callproc.c, emacs.c, event-stream.c, nt.c, process.c, process.h, sysdep.c, sysdep.h, syssignal.h, syswindows.h, ntproc.c: Delete. Hallelujah, praise the Lord, there is no god
but Allah!!!
fix so that processes can be invoked in bare temacs -- thereby
eliminating any need for callproc.c. (currently only eliminated
under NT.) remove all crufty and unnecessary old process code in
ntproc.c and elsewhere. move non-callproc-specific stuff (mostly
environment) into process.c, so callproc.c can be left out under
NT.
console-tty.c, doc.c, file-coding.c, file-coding.h, lstream.c, lstream.h: fix doc string handling so it works with Japanese, etc docs.
change handling of "character mode" so callers don't have to
manually set it (quite error-prone).
event-msw.c: spacing fixes.
lread.c: eliminate unused crufty vintage-19 "FSF defun hack" code.
lrecord.h: improve pdump description docs.
buffer.c, ntheap.c, unexnt.c, win32.c, emacs.c: Mule-ize some unexec and startup code. It was pseudo-Mule-ized
before by simply always calling the ...A versions of functions,
but that won't cut it -- eventually we want to be able to run
properly even if XEmacs has been installed in a Japanese
directory. (The current problem is the timing of the loading of
the Unicode tables; this will eventually be fixed.) Go through and
fix various other places where the code was not Mule-clean.
Provide a function mswindows_get_module_file_name() to get our own
name without resort to PATH_MAX and such. Add a big comment in
main() about the problem with Unicode table load timing that I
just alluded to.
emacs.c: When error-checking is enabled (interpreted as "user is developing
XEmacs"), don't ask user to "pause to read messages" when a fatal
error has occurred, because it will wedge if we are in an inner
modal loop (typically when a menu is popped up) and make us unable
to get a useful stack trace in the debugger.
text.c: Correct update_entirely_ascii_p_flag to actually work.
lisp.h, symsinit.h: declarations for above changes.
author | ben |
---|---|
date | Sun, 14 Apr 2002 12:43:31 +0000 |
parents | a5954632b187 |
children | 0490271de7d8 |
comparison
equal
deleted
inserted
replaced
813:9541922fb765 | 814:a634e3b7acc8 |
---|---|
21 | 21 |
22 /* Synched up with: Mule 2.0, FSF 19.30. */ | 22 /* Synched up with: Mule 2.0, FSF 19.30. */ |
23 /* Partly sync'ed with 19.36.4 */ | 23 /* Partly sync'ed with 19.36.4 */ |
24 | 24 |
25 | 25 |
26 /* #### This ENTIRE file is only used in batch mode. (Well, almost; | 26 /* #### Everything in this file should go. As soon as I merge my |
27 certainly the main call-process stuff is only used in batch mode.) | 27 stderr-proc WS, it will. |
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 */ | 28 */ |
35 | 29 |
36 #include <config.h> | 30 #include <config.h> |
37 #include "lisp.h" | 31 #include "lisp.h" |
38 | 32 |
39 #include "buffer.h" | 33 #include "buffer.h" |
40 #include "commands.h" | 34 #include "commands.h" |
35 #include "file-coding.h" | |
41 #include "insdel.h" | 36 #include "insdel.h" |
42 #include "lstream.h" | 37 #include "lstream.h" |
43 #include "process.h" | 38 #include "process.h" |
44 #include "sysdep.h" | 39 #include "sysdep.h" |
45 #include "window.h" | 40 #include "window.h" |
46 #include "file-coding.h" | 41 |
47 | 42 #include "sysdir.h" |
43 #include "sysfile.h" | |
44 #include "sysproc.h" | |
45 #include "syssignal.h" | |
48 #include "systime.h" | 46 #include "systime.h" |
49 #include "sysproc.h" | |
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 */ | |
56 #include "systty.h" | 47 #include "systty.h" |
57 #include "sysdir.h" | |
58 | |
59 #ifdef WIN32_NATIVE | |
60 #include "syswindows.h" | |
61 #endif | |
62 | |
63 #ifdef WIN32_NATIVE | |
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; | |
70 #endif /* WIN32_NATIVE */ | |
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 | 48 |
79 /* True iff we are about to fork off a synchronous process or if we | 49 /* True iff we are about to fork off a synchronous process or if we |
80 are waiting for it. */ | 50 are waiting for it. */ |
81 volatile int synch_process_alive; | 51 volatile int synch_process_alive; |
82 | 52 |
92 On Unix, kill the process and any children on termination by signal. */ | 62 On Unix, kill the process and any children on termination by signal. */ |
93 | 63 |
94 /* Nonzero if this is termination due to exit. */ | 64 /* Nonzero if this is termination due to exit. */ |
95 static int call_process_exited; | 65 static int call_process_exited; |
96 | 66 |
97 /* Make sure egetenv() not called too soon */ | |
98 int env_initted; | |
99 | |
100 Lisp_Object Vlisp_EXEC_SUFFIXES; | |
101 | |
102 static Lisp_Object | 67 static Lisp_Object |
103 call_process_kill (Lisp_Object fdpid) | 68 call_process_kill (Lisp_Object fdpid) |
104 { | 69 { |
105 Lisp_Object fd = Fcar (fdpid); | 70 Lisp_Object fd = Fcar (fdpid); |
106 Lisp_Object pid = Fcdr (fdpid); | 71 Lisp_Object pid = Fcdr (fdpid); |
128 | 93 |
129 record_unwind_protect (call_process_kill, fdpid); | 94 record_unwind_protect (call_process_kill, fdpid); |
130 /* #### "c-G" -- need non-consing Single-key-description */ | 95 /* #### "c-G" -- need non-consing Single-key-description */ |
131 message ("Waiting for process to die...(type C-g again to kill it instantly)"); | 96 message ("Waiting for process to die...(type C-g again to kill it instantly)"); |
132 | 97 |
133 #ifdef WIN32_NATIVE | |
134 { | |
135 HANDLE pHandle = OpenProcess (PROCESS_ALL_ACCESS, 0, pid); | |
136 if (pHandle == NULL) | |
137 warn_when_safe (Qprocess, Qnotice, | |
138 "cannot open process (PID %d) for cleanup", pid); | |
139 else | |
140 wait_for_termination (pHandle); | |
141 } | |
142 #else | |
143 wait_for_termination (pid); | 98 wait_for_termination (pid); |
144 #endif | |
145 | 99 |
146 /* "Discard" the unwind protect. */ | 100 /* "Discard" the unwind protect. */ |
147 XCAR (fdpid) = Qnil; | 101 XCAR (fdpid) = Qnil; |
148 XCDR (fdpid) = Qnil; | 102 XCDR (fdpid) = Qnil; |
149 unbind_to (speccount); | 103 unbind_to (speccount); |
181 { | 135 { |
182 /* This function can GC */ | 136 /* This function can GC */ |
183 Lisp_Object infile, buffer, current_dir, display, path; | 137 Lisp_Object infile, buffer, current_dir, display, path; |
184 int fd[2]; | 138 int fd[2]; |
185 int filefd; | 139 int filefd; |
186 #ifdef WIN32_NATIVE | |
187 HANDLE pHandle; | |
188 #endif | |
189 int pid; | 140 int pid; |
190 char buf[16384]; | 141 char buf[16384]; |
191 char *bufptr = buf; | 142 char *bufptr = buf; |
192 int bufsize = 16384; | 143 int bufsize = 16384; |
193 int speccount = specpdl_depth (); | 144 int speccount = specpdl_depth (); |
324 fd[1] = qxe_open ((Intbyte *) NULL_DEVICE, O_WRONLY | OPEN_BINARY, 0); | 275 fd[1] = qxe_open ((Intbyte *) NULL_DEVICE, O_WRONLY | OPEN_BINARY, 0); |
325 fd[0] = -1; | 276 fd[0] = -1; |
326 } | 277 } |
327 else | 278 else |
328 { | 279 { |
329 #ifdef WIN32_NATIVE | |
330 pipe_will_die_soon (fd); | |
331 #else | |
332 pipe (fd); | 280 pipe (fd); |
333 #endif | |
334 #if 0 | 281 #if 0 |
335 /* Replaced by close_process_descs */ | 282 /* Replaced by close_process_descs */ |
336 set_exclusive_use (fd[0]); | 283 set_exclusive_use (fd[0]); |
337 #endif | 284 #endif |
338 } | 285 } |
353 if (NILP (error_file)) | 300 if (NILP (error_file)) |
354 fd_error = qxe_open ((Intbyte *) NULL_DEVICE, O_WRONLY | OPEN_BINARY); | 301 fd_error = qxe_open ((Intbyte *) NULL_DEVICE, O_WRONLY | OPEN_BINARY); |
355 else if (STRINGP (error_file)) | 302 else if (STRINGP (error_file)) |
356 { | 303 { |
357 fd_error = qxe_open (XSTRING_DATA (error_file), | 304 fd_error = qxe_open (XSTRING_DATA (error_file), |
358 #ifdef WIN32_NATIVE | |
359 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, | |
360 S_IREAD | S_IWRITE | |
361 #else /* not WIN32_NATIVE */ | |
362 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, | 305 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, |
363 CREAT_MODE | 306 CREAT_MODE); |
364 #endif /* not WIN32_NATIVE */ | |
365 ); | |
366 } | 307 } |
367 | 308 |
368 if (fd_error < 0) | 309 if (fd_error < 0) |
369 { | 310 { |
370 int save_errno = errno; | 311 int save_errno = errno; |
374 retry_close (fd1); | 315 retry_close (fd1); |
375 errno = save_errno; | 316 errno = save_errno; |
376 report_process_error ("Cannot open", Fcons (error_file, Qnil)); | 317 report_process_error ("Cannot open", Fcons (error_file, Qnil)); |
377 } | 318 } |
378 | 319 |
379 #ifdef WIN32_NATIVE | |
380 pid = child_setup (filefd, fd1, fd_error, new_argv, current_dir); | |
381 if (!INTP (buffer)) | |
382 { | |
383 /* OpenProcess() as soon after child_setup as possible. It's too | |
384 late once the process terminated. */ | |
385 pHandle = OpenProcess (PROCESS_ALL_ACCESS, 0, pid); | |
386 #if 0 | |
387 if (pHandle == NULL) | |
388 { | |
389 /* #### seems to cause crash in unbind_to_1(...) below. APA */ | |
390 warn_when_safe (Qprocess, Qnotice, | |
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) | |
397 retry_close (fd_error); | |
398 #else /* not WIN32_NATIVE */ | |
399 pid = fork (); | 320 pid = fork (); |
400 | 321 |
401 if (pid == 0) | 322 if (pid == 0) |
402 { | 323 { |
403 if (fd[0] >= 0) | 324 if (fd[0] >= 0) |
413 child_setup (filefd, fd1, fd_error, new_argv, current_dir); | 334 child_setup (filefd, fd1, fd_error, new_argv, current_dir); |
414 } | 335 } |
415 if (fd_error >= 0) | 336 if (fd_error >= 0) |
416 retry_close (fd_error); | 337 retry_close (fd_error); |
417 | 338 |
418 #endif /* not WIN32_NATIVE */ | |
419 | |
420 /* Close most of our fd's, but not fd[0] | 339 /* Close most of our fd's, but not fd[0] |
421 since we will use that to read input from. */ | 340 since we will use that to read input from. */ |
422 retry_close (filefd); | 341 retry_close (filefd); |
423 if (fd1 >= 0) | 342 if (fd1 >= 0) |
424 retry_close (fd1); | 343 retry_close (fd1); |
425 } | 344 } |
426 | 345 |
427 #ifndef WIN32_NATIVE | |
428 if (pid < 0) | 346 if (pid < 0) |
429 { | 347 { |
430 int save_errno = errno; | 348 int save_errno = errno; |
431 if (fd[0] >= 0) | 349 if (fd[0] >= 0) |
432 retry_close (fd[0]); | 350 retry_close (fd[0]); |
433 errno = save_errno; | 351 errno = save_errno; |
434 report_process_error ("Doing fork", Qunbound); | 352 report_process_error ("Doing fork", Qunbound); |
435 } | 353 } |
436 #endif | |
437 | 354 |
438 if (INTP (buffer)) | 355 if (INTP (buffer)) |
439 { | 356 { |
440 if (fd[0] >= 0) | 357 if (fd[0] >= 0) |
441 retry_close (fd[0]); | 358 retry_close (fd[0]); |
468 instream = | 385 instream = |
469 make_coding_input_stream | 386 make_coding_input_stream |
470 (XLSTREAM (instream), | 387 (XLSTREAM (instream), |
471 get_coding_system_for_text_file (Vcoding_system_for_read, 1), | 388 get_coding_system_for_text_file (Vcoding_system_for_read, 1), |
472 CODING_DECODE, 0); | 389 CODING_DECODE, 0); |
473 Lstream_set_character_mode (XLSTREAM (instream)); | |
474 NGCPRO1 (instream); | 390 NGCPRO1 (instream); |
475 while (1) | 391 while (1) |
476 { | 392 { |
477 QUIT; | 393 QUIT; |
478 /* Repeatedly read until we've filled as much as possible | 394 /* Repeatedly read until we've filled as much as possible |
528 Lstream_close (XLSTREAM (instream)); | 444 Lstream_close (XLSTREAM (instream)); |
529 NUNGCPRO; | 445 NUNGCPRO; |
530 | 446 |
531 QUIT; | 447 QUIT; |
532 /* Wait for it to terminate, unless it already has. */ | 448 /* Wait for it to terminate, unless it already has. */ |
533 #ifdef WIN32_NATIVE | |
534 wait_for_termination (pHandle); | |
535 #else | |
536 wait_for_termination (pid); | 449 wait_for_termination (pid); |
537 #endif | |
538 | 450 |
539 /* Don't kill any children that the subprocess may have left behind | 451 /* Don't kill any children that the subprocess may have left behind |
540 when exiting. */ | 452 when exiting. */ |
541 call_process_exited = 1; | 453 call_process_exited = 1; |
542 unbind_to (speccount); | 454 unbind_to (speccount); |
584 directory the subprocess should have. Since we can't really signal | 496 directory the subprocess should have. Since we can't really signal |
585 a decent error from within the child (not quite correct in | 497 a decent error from within the child (not quite correct in |
586 XEmacs?), this should be verified as an executable directory by the | 498 XEmacs?), this should be verified as an executable directory by the |
587 parent. */ | 499 parent. */ |
588 | 500 |
589 #ifdef WIN32_NATIVE | |
590 int | |
591 #else | |
592 void | 501 void |
593 #endif | |
594 child_setup (int in, int out, int err, Intbyte **new_argv, | 502 child_setup (int in, int out, int err, Intbyte **new_argv, |
595 Lisp_Object current_dir) | 503 Lisp_Object current_dir) |
596 { | 504 { |
597 Intbyte **env; | 505 Intbyte **env; |
598 Intbyte *pwd; | 506 Intbyte *pwd; |
599 #ifdef WIN32_NATIVE | |
600 int cpid; | |
601 HANDLE handles[4]; | |
602 #endif /* WIN32_NATIVE */ | |
603 | 507 |
604 #ifdef SET_EMACS_PRIORITY | 508 #ifdef SET_EMACS_PRIORITY |
605 if (emacs_priority != 0) | 509 if (emacs_priority != 0) |
606 nice (- emacs_priority); | 510 nice (- emacs_priority); |
607 #endif | 511 #endif |
619 entirely, using the Lisp definition in process.el. What's left | 523 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 | 524 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. | 525 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 | 526 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. */ | 527 way, the Lisp definition can be used non-interactively too. */ |
624 #if !defined (NO_SUBPROCESSES) && !defined (WIN32_NATIVE) | 528 #if !defined (NO_SUBPROCESSES) |
625 /* Close Emacs's descriptors that this process should not have. */ | 529 /* Close Emacs's descriptors that this process should not have. */ |
626 close_process_descs (); | 530 close_process_descs (); |
627 #endif /* not NO_SUBPROCESSES */ | 531 #endif /* not NO_SUBPROCESSES */ |
628 #ifndef WIN32_NATIVE | |
629 close_load_descs (); | 532 close_load_descs (); |
630 #endif | |
631 | 533 |
632 /* [[Note that use of alloca is always safe here. It's obvious for systems | 534 /* [[Note that use of alloca is always safe here. It's obvious for systems |
633 that do not have true vfork or that have true (stack) alloca. | 535 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 | 536 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 | 537 the superior's static variables as if the superior had done alloca |
718 } | 620 } |
719 | 621 |
720 *new_env = 0; | 622 *new_env = 0; |
721 } | 623 } |
722 | 624 |
723 #ifdef WIN32_NATIVE | |
724 prepare_standard_handles (in, out, err, handles); | |
725 /* #### junk! But all this win32 code will die soon. */ | |
726 set_process_dir ((char *) XSTRING_DATA (current_dir)); | |
727 #else /* not WIN32_NATIVE */ | |
728 /* Make sure that in, out, and err are not actually already in | 625 /* Make sure that in, out, and err are not actually already in |
729 descriptors zero, one, or two; this could happen if Emacs is | 626 descriptors zero, one, or two; this could happen if Emacs is |
730 started with its standard in, out, or error closed, as might | 627 started with its standard in, out, or error closed, as might |
731 happen under X. */ | 628 happen under X. */ |
732 in = relocate_fd (in, 3); | 629 in = relocate_fd (in, 3); |
753 { | 650 { |
754 int fd; | 651 int fd; |
755 for (fd=3; fd<=64; fd++) | 652 for (fd=3; fd<=64; fd++) |
756 retry_close (fd); | 653 retry_close (fd); |
757 } | 654 } |
758 #endif /* not WIN32_NATIVE */ | |
759 | 655 |
760 #ifdef vipc | 656 #ifdef vipc |
761 something missing here; | 657 something missing here; |
762 #endif /* vipc */ | 658 #endif /* vipc */ |
763 | 659 |
764 #ifdef WIN32_NATIVE | |
765 /* Spawn the child. (See ntproc.c:Spawnve). */ | |
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); | |
771 if (cpid == -1) | |
772 /* An error occurred while trying to spawn the process. */ | |
773 report_process_error ("Spawning child process", Qunbound); | |
774 reset_standard_handles (in, out, err, handles); | |
775 return cpid; | |
776 #else /* not WIN32_NATIVE */ | |
777 /* we've wrapped execve; it translates its arguments */ | 660 /* we've wrapped execve; it translates its arguments */ |
778 qxe_execve (new_argv[0], new_argv, env); | 661 qxe_execve (new_argv[0], new_argv, env); |
779 | 662 |
780 stdout_out ("Can't exec program %s\n", new_argv[0]); | 663 stdout_out ("Can't exec program %s\n", new_argv[0]); |
781 _exit (1); | 664 _exit (1); |
782 #endif /* not WIN32_NATIVE */ | |
783 } | |
784 | |
785 static int | |
786 getenv_internal (const Intbyte *var, | |
787 Bytecount varlen, | |
788 Intbyte **value, | |
789 Bytecount *valuelen) | |
790 { | |
791 Lisp_Object scan; | |
792 | |
793 assert (env_initted); | |
794 | |
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) == '=' | |
802 #ifdef WIN32_NATIVE | |
803 /* NT environment variables are case insensitive. */ | |
804 && ! memicmp (XSTRING_DATA (entry), var, varlen) | |
805 #else /* not WIN32_NATIVE */ | |
806 && ! memcmp (XSTRING_DATA (entry), var, varlen) | |
807 #endif /* not WIN32_NATIVE */ | |
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 | |
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 | |
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 { | |
885 Intbyte *value; | |
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 | |
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) | |
928 { | |
929 /* This cannot GC -- 7-28-00 ben */ | |
930 Intbyte *value; | |
931 Bytecount valuelen; | |
932 | |
933 if (getenv_internal ((const Intbyte *) var, strlen (var), &value, &valuelen)) | |
934 return value; | |
935 else | |
936 return 0; | |
937 } | |
938 | |
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 | |
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++) | |
958 Vprocess_environment = | |
959 Fcons (build_ext_string (*envp, Qnative), Vprocess_environment); | |
960 /* This gets set back to 0 in disksave_object_finalization() */ | |
961 env_initted = 1; | |
962 } | |
963 | |
964 { | |
965 /* Initialize shell-file-name from environment variables or best guess. */ | |
966 #ifdef WIN32_NATIVE | |
967 const Intbyte *shell = egetenv ("SHELL"); | |
968 if (!shell) shell = egetenv ("COMSPEC"); | |
969 /* Should never happen! */ | |
970 if (!shell) shell = | |
971 (Intbyte *) (GetVersion () & 0x80000000 ? "command" : "cmd"); | |
972 #else /* not WIN32_NATIVE */ | |
973 const Intbyte *shell = egetenv ("SHELL"); | |
974 if (!shell) shell = (Intbyte *) "/bin/sh"; | |
975 #endif | |
976 | |
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 { | |
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), | |
998 Vprocess_environment); | |
999 } | |
1000 #endif /* 0 */ | |
1001 | |
1002 Vshell_file_name = build_intstring (shell); | |
1003 } | |
1004 } | 665 } |
1005 | 666 |
1006 void | 667 void |
1007 syms_of_callproc (void) | 668 syms_of_callproc (void) |
1008 { | 669 { |
1009 DEFSUBR (Fold_call_process_internal); | 670 DEFSUBR (Fold_call_process_internal); |
1010 DEFSUBR (Fgetenv); | |
1011 } | 671 } |
1012 | |
1013 void | |
1014 vars_of_callproc (void) | |
1015 { | |
1016 /* This function can GC */ | |
1017 #ifdef WIN32_NATIVE | |
1018 /* Will die as soon as callproc.c dies */ | |
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; | |
1028 #endif /* WIN32_NATIVE */ | |
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 } |