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 }