comparison src/callproc.c @ 412:697ef44129c6 r21-2-14

Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents de805c49cfc1
children
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
39 #include "sysproc.h" 39 #include "sysproc.h"
40 #include "sysfile.h" /* Always include after sysproc.h */ 40 #include "sysfile.h" /* Always include after sysproc.h */
41 #include "syssignal.h" /* Always include before systty.h */ 41 #include "syssignal.h" /* Always include before systty.h */
42 #include "systty.h" 42 #include "systty.h"
43 43
44 #ifdef WIN32_NATIVE 44 #ifdef WINDOWSNT
45 #define _P_NOWAIT 1 /* from process.h */ 45 #define _P_NOWAIT 1 /* from process.h */
46 #include <windows.h>
46 #include "nt.h" 47 #include "nt.h"
47 #endif 48 #endif
48 49
49 #ifdef WIN32_NATIVE 50 #ifdef DOS_NT
50 /* When we are starting external processes we need to know whether they 51 /* When we are starting external processes we need to know whether they
51 take binary input (no conversion) or text input (\n is converted to 52 take binary input (no conversion) or text input (\n is converted to
52 \r\n). Similarly for output: if newlines are written as \r\n then it's 53 \r\n). Similarly for output: if newlines are written as \r\n then it's
53 text process output, otherwise it's binary. */ 54 text process output, otherwise it's binary. */
54 Lisp_Object Vbinary_process_input; 55 Lisp_Object Vbinary_process_input;
55 Lisp_Object Vbinary_process_output; 56 Lisp_Object Vbinary_process_output;
56 #endif /* WIN32_NATIVE */ 57 #endif /* DOS_NT */
57 58
58 Lisp_Object Vshell_file_name; 59 Lisp_Object Vshell_file_name;
59 60
60 /* The environment to pass to all subprocesses when they are started. 61 /* The environment to pass to all subprocesses when they are started.
61 This is in the semi-bogus format of ("VAR=VAL" "VAR2=VAL2" ... ) 62 This is in the semi-bogus format of ("VAR=VAL" "VAR2=VAL2" ... )
65 /* True iff we are about to fork off a synchronous process or if we 66 /* True iff we are about to fork off a synchronous process or if we
66 are waiting for it. */ 67 are waiting for it. */
67 volatile int synch_process_alive; 68 volatile int synch_process_alive;
68 69
69 /* Nonzero => this is a string explaining death of synchronous subprocess. */ 70 /* Nonzero => this is a string explaining death of synchronous subprocess. */
70 const char *synch_process_death; 71 CONST char *synch_process_death;
71 72
72 /* If synch_process_death is zero, 73 /* If synch_process_death is zero,
73 this is exit code of synchronous subprocess. */ 74 this is exit code of synchronous subprocess. */
74 int synch_process_retcode; 75 int synch_process_retcode;
75 76
76 /* Clean up when exiting Fcall_process_internal. 77 /* Clean up when exiting Fcall_process_internal.
77 On Windows, delete the temporary file on any kind of termination. 78 On MSDOS, delete the temporary file on any kind of termination.
78 On Unix, kill the process and any children on termination by signal. */ 79 On Unix, kill the process and any children on termination by signal. */
79 80
80 /* Nonzero if this is termination due to exit. */ 81 /* Nonzero if this is termination due to exit. */
81 static int call_process_exited; 82 static int call_process_exited;
82 83
99 } 100 }
100 101
101 static Lisp_Object 102 static Lisp_Object
102 call_process_cleanup (Lisp_Object fdpid) 103 call_process_cleanup (Lisp_Object fdpid)
103 { 104 {
104 int fd = XINT (Fcar (fdpid)); 105 int fd = XINT (Fcar (fdpid));
105 int pid = XINT (Fcdr (fdpid)); 106 int pid = XINT (Fcdr (fdpid));
106 107
107 if (!call_process_exited && 108 if (!call_process_exited &&
108 EMACS_KILLPG (pid, SIGINT) == 0) 109 EMACS_KILLPG (pid, SIGINT) == 0)
109 { 110 {
111 112
112 record_unwind_protect (call_process_kill, fdpid); 113 record_unwind_protect (call_process_kill, fdpid);
113 /* #### "c-G" -- need non-consing Single-key-description */ 114 /* #### "c-G" -- need non-consing Single-key-description */
114 message ("Waiting for process to die...(type C-g again to kill it instantly)"); 115 message ("Waiting for process to die...(type C-g again to kill it instantly)");
115 116
116 #ifdef WIN32_NATIVE
117 {
118 HANDLE pHandle = OpenProcess (PROCESS_ALL_ACCESS, 0, pid);
119 if (pHandle == NULL)
120 warn_when_safe (Qprocess, Qwarning,
121 "cannot open process (PID %d) for cleanup", pid);
122 else
123 wait_for_termination (pHandle);
124 }
125 #else
126 wait_for_termination (pid); 117 wait_for_termination (pid);
127 #endif
128 118
129 /* "Discard" the unwind protect. */ 119 /* "Discard" the unwind protect. */
130 XCAR (fdpid) = Qnil; 120 XCAR (fdpid) = Qnil;
131 XCDR (fdpid) = Qnil; 121 XCDR (fdpid) = Qnil;
132 unbind_to (speccount, Qnil); 122 unbind_to (speccount, Qnil);
150 /* terminate this branch of the fork, without closing stdin/out/etc. */ 140 /* terminate this branch of the fork, without closing stdin/out/etc. */
151 _exit (1); 141 _exit (1);
152 } 142 }
153 #endif /* unused */ 143 #endif /* unused */
154 144
155 DEFUN ("old-call-process-internal", Fold_call_process_internal, 1, MANY, 0, /* 145 DEFUN ("call-process-internal", Fcall_process_internal, 1, MANY, 0, /*
156 Call PROGRAM synchronously in separate process, with coding-system specified. 146 Call PROGRAM synchronously in separate process, with coding-system specified.
157 Arguments are 147 Arguments are
158 (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS). 148 (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS).
159 The program's input comes from file INFILE (nil means `/dev/null'). 149 The program's input comes from file INFILE (nil means `/dev/null').
160 Insert output in BUFFER before point; t means current buffer; 150 Insert output in BUFFER before point; t means current buffer;
178 { 168 {
179 /* This function can GC */ 169 /* This function can GC */
180 Lisp_Object infile, buffer, current_dir, display, path; 170 Lisp_Object infile, buffer, current_dir, display, path;
181 int fd[2]; 171 int fd[2];
182 int filefd; 172 int filefd;
183 #ifdef WIN32_NATIVE
184 HANDLE pHandle;
185 #endif
186 int pid; 173 int pid;
187 char buf[16384]; 174 char buf[16384];
188 char *bufptr = buf; 175 char *bufptr = buf;
189 int bufsize = 16384; 176 int bufsize = 16384;
190 int speccount = specpdl_depth (); 177 int speccount = specpdl_depth ();
191 struct gcpro gcpro1, gcpro2, gcpro3; 178 struct gcpro gcpro1, gcpro2;
192 char **new_argv = alloca_array (char *, max (2, nargs - 2)); 179 char **new_argv = alloca_array (char *, max (2, nargs - 2));
193 180
194 /* File to use for stderr in the child. 181 /* File to use for stderr in the child.
195 t means use same as standard output. */ 182 t means use same as standard output. */
196 Lisp_Object error_file; 183 Lisp_Object error_file;
233 Fcons (current_buffer->directory, Qnil)); 220 Fcons (current_buffer->directory, Qnil));
234 #endif /* 0 */ 221 #endif /* 0 */
235 NUNGCPRO; 222 NUNGCPRO;
236 } 223 }
237 224
238 GCPRO2 (current_dir, path); 225 GCPRO1 (current_dir);
239 226
240 if (nargs >= 2 && ! NILP (args[1])) 227 if (nargs >= 2 && ! NILP (args[1]))
241 { 228 {
242 struct gcpro ngcpro1; 229 struct gcpro ngcpro1;
243 NGCPRO1 (current_buffer->directory); 230 NGCPRO1 (current_buffer->directory);
248 else 235 else
249 infile = build_string (NULL_DEVICE); 236 infile = build_string (NULL_DEVICE);
250 237
251 UNGCPRO; 238 UNGCPRO;
252 239
253 GCPRO3 (infile, current_dir, path); /* Fexpand_file_name might trash it */ 240 GCPRO2 (infile, current_dir); /* Fexpand_file_name might trash it */
254 241
255 if (nargs >= 3) 242 if (nargs >= 3)
256 { 243 {
257 buffer = args[2]; 244 buffer = args[2];
258 245
298 for (i = 4; i < nargs; i++) 285 for (i = 4; i < nargs; i++)
299 { 286 {
300 CHECK_STRING (args[i]); 287 CHECK_STRING (args[i]);
301 new_argv[i - 3] = (char *) XSTRING_DATA (args[i]); 288 new_argv[i - 3] = (char *) XSTRING_DATA (args[i]);
302 } 289 }
290 new_argv[nargs - 3] = 0;
303 } 291 }
304 new_argv[max(nargs - 3,1)] = 0;
305 292
306 if (NILP (path)) 293 if (NILP (path))
307 report_file_error ("Searching for program", Fcons (args[0], Qnil)); 294 report_file_error ("Searching for program", Fcons (args[0], Qnil));
308 new_argv[0] = (char *) XSTRING_DATA (path); 295 new_argv[0] = (char *) XSTRING_DATA (path);
309 296
346 333
347 if (NILP (error_file)) 334 if (NILP (error_file))
348 fd_error = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY); 335 fd_error = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY);
349 else if (STRINGP (error_file)) 336 else if (STRINGP (error_file))
350 { 337 {
351 fd_error = open ((const char *) XSTRING_DATA (error_file), 338 fd_error = open ((CONST char *) XSTRING_DATA (error_file),
352 #ifdef WIN32_NATIVE 339 #ifdef DOS_NT
353 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, 340 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
354 S_IREAD | S_IWRITE 341 S_IREAD | S_IWRITE
355 #else /* not WIN32_NATIVE */ 342 #else /* not DOS_NT */
356 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, 343 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
357 CREAT_MODE 344 CREAT_MODE
358 #endif /* not WIN32_NATIVE */ 345 #endif /* not DOS_NT */
359 ); 346 );
360 } 347 }
361 348
362 if (fd_error < 0) 349 if (fd_error < 0)
363 { 350 {
367 close (fd1); 354 close (fd1);
368 report_file_error ("Cannot open", Fcons(error_file, Qnil)); 355 report_file_error ("Cannot open", Fcons(error_file, Qnil));
369 } 356 }
370 357
371 fork_error = Qnil; 358 fork_error = Qnil;
372 #ifdef WIN32_NATIVE 359 #ifdef WINDOWSNT
373 pid = child_setup (filefd, fd1, fd_error, new_argv, 360 pid = child_setup (filefd, fd1, fd_error, new_argv,
374 (char *) XSTRING_DATA (current_dir)); 361 (char *) XSTRING_DATA (current_dir));
375 if (!INTP (buffer)) 362 #else /* not WINDOWSNT */
376 {
377 /* OpenProcess() as soon after child_setup as possible. It's too
378 late once the process terminated. */
379 pHandle = OpenProcess(PROCESS_ALL_ACCESS, 0, pid);
380 #if 0
381 if (pHandle == NULL)
382 {
383 /* #### seems to cause crash in unbind_to(...) below. APA */
384 warn_when_safe (Qprocess, Qwarning,
385 "cannot open process to wait for");
386 }
387 #endif
388 }
389 /* Close STDERR into the parent process. We no longer need it. */
390 if (fd_error >= 0)
391 close (fd_error);
392 #else /* not WIN32_NATIVE */
393 pid = fork (); 363 pid = fork ();
394 364
395 if (pid == 0) 365 if (pid == 0)
396 { 366 {
397 if (fd[0] >= 0) 367 if (fd[0] >= 0)
408 (char *) XSTRING_DATA (current_dir)); 378 (char *) XSTRING_DATA (current_dir));
409 } 379 }
410 if (fd_error >= 0) 380 if (fd_error >= 0)
411 close (fd_error); 381 close (fd_error);
412 382
413 #endif /* not WIN32_NATIVE */ 383 #endif /* not WINDOWSNT */
414 384
415 environ = save_environ; 385 environ = save_environ;
416 386
417 /* Close most of our fd's, but not fd[0] 387 /* Close most of our fd's, but not fd[0]
418 since we will use that to read input from. */ 388 since we will use that to read input from. */
422 } 392 }
423 393
424 if (!NILP (fork_error)) 394 if (!NILP (fork_error))
425 signal_error (Qfile_error, fork_error); 395 signal_error (Qfile_error, fork_error);
426 396
427 #ifndef WIN32_NATIVE
428 if (pid < 0) 397 if (pid < 0)
429 { 398 {
430 if (fd[0] >= 0) 399 if (fd[0] >= 0)
431 close (fd[0]); 400 close (fd[0]);
432 report_file_error ("Doing fork", Qnil); 401 report_file_error ("Doing fork", Qnil);
433 } 402 }
434 #endif
435 403
436 if (INTP (buffer)) 404 if (INTP (buffer))
437 { 405 {
438 if (fd[0] >= 0) 406 if (fd[0] >= 0)
439 close (fd[0]); 407 close (fd[0]);
480 less than 1024--save that for the next bufferfull. */ 448 less than 1024--save that for the next bufferfull. */
481 449
482 nread = 0; 450 nread = 0;
483 while (nread < bufsize - 1024) 451 while (nread < bufsize - 1024)
484 { 452 {
485 ssize_t this_read 453 int this_read
486 = Lstream_read (XLSTREAM (instream), bufptr + nread, 454 = Lstream_read (XLSTREAM (instream), bufptr + nread,
487 bufsize - nread); 455 bufsize - nread);
488 456
489 if (this_read < 0) 457 if (this_read < 0)
490 goto give_up; 458 goto give_up;
499 467
500 /* Now NREAD is the total amount of data in the buffer. */ 468 /* Now NREAD is the total amount of data in the buffer. */
501 if (nread == 0) 469 if (nread == 0)
502 break; 470 break;
503 471
504 #if 0 472 #ifdef DOS_NT
505 #ifdef WIN32_NATIVE
506 /* Until we pull out of MULE things like 473 /* Until we pull out of MULE things like
507 make_decoding_input_stream(), we do the following which is 474 make_decoding_input_stream(), we do the following which is
508 less elegant. --marcpa */ 475 less elegant. --marcpa */
509 /* We did. -- kkm */
510 { 476 {
511 int lf_count = 0; 477 int lf_count = 0;
512 if (NILP (Vbinary_process_output)) { 478 if (NILP (Vbinary_process_output)) {
513 nread = crlf_to_lf(nread, bufptr, &lf_count); 479 nread = crlf_to_lf(nread, bufptr, &lf_count);
514 } 480 }
515 } 481 }
516 #endif
517 #endif 482 #endif
518 483
519 total_read += nread; 484 total_read += nread;
520 485
521 if (!NILP (buffer)) 486 if (!NILP (buffer))
540 Lstream_close (XLSTREAM (instream)); 505 Lstream_close (XLSTREAM (instream));
541 NUNGCPRO; 506 NUNGCPRO;
542 507
543 QUIT; 508 QUIT;
544 /* Wait for it to terminate, unless it already has. */ 509 /* Wait for it to terminate, unless it already has. */
545 #ifdef WIN32_NATIVE
546 wait_for_termination (pHandle);
547 #else
548 wait_for_termination (pid); 510 wait_for_termination (pid);
549 #endif
550 511
551 /* Don't kill any children that the subprocess may have left behind 512 /* Don't kill any children that the subprocess may have left behind
552 when exiting. */ 513 when exiting. */
553 call_process_exited = 1; 514 call_process_exited = 1;
554 unbind_to (speccount, Qnil); 515 unbind_to (speccount, Qnil);
600 CURRENT_DIR is an elisp string giving the path of the current 561 CURRENT_DIR is an elisp string giving the path of the current
601 directory the subprocess should have. Since we can't really signal 562 directory the subprocess should have. Since we can't really signal
602 a decent error from within the child, this should be verified as an 563 a decent error from within the child, this should be verified as an
603 executable directory by the parent. */ 564 executable directory by the parent. */
604 565
605 #ifdef WIN32_NATIVE 566 #ifdef WINDOWSNT
606 int 567 int
607 #else 568 #else
608 void 569 void
609 #endif 570 #endif
610 child_setup (int in, int out, int err, char **new_argv, 571 child_setup (int in, int out, int err, char **new_argv,
611 const char *current_dir) 572 CONST char *current_dir)
612 { 573 {
613 char **env; 574 char **env;
614 char *pwd; 575 char *pwd;
615 #ifdef WIN32_NATIVE 576 #ifdef WINDOWSNT
616 int cpid; 577 int cpid;
617 HANDLE handles[4]; 578 HANDLE handles[4];
618 #endif /* WIN32_NATIVE */ 579 #endif /* WINDOWSNT */
619 580
620 #ifdef SET_EMACS_PRIORITY 581 #ifdef SET_EMACS_PRIORITY
621 if (emacs_priority != 0) 582 if (emacs_priority != 0)
622 nice (- emacs_priority); 583 nice (- emacs_priority);
623 #endif 584 #endif
624 585
625 /* Under Windows, we are not in a child process at all, so we should 586 #if !defined (NO_SUBPROCESSES) && !defined (WINDOWSNT)
626 not close handles inherited from the parent -- we are the parent
627 and doing so will screw up all manner of things! Similarly, most
628 of the rest of the cleanup done in this function is not done
629 under Windows.
630
631 #### This entire child_setup() function is an utter and complete
632 piece of shit. I would rewrite it, at the very least splitting
633 out the Windows and non-Windows stuff into two completely
634 different functions; but instead I'm trying to make it go away
635 entirely, using the Lisp definition in process.el. What's left
636 is to fix up the routines in event-msw.c (and in event-Xt.c and
637 event-tty.c) to allow for stream devices to be handled correctly.
638 There isn't much to do, in fact, and I'll fix it shortly. That
639 way, the Lisp definition can be used non-interactively too. */
640 #if !defined (NO_SUBPROCESSES) && !defined (WIN32_NATIVE)
641 /* Close Emacs's descriptors that this process should not have. */ 587 /* Close Emacs's descriptors that this process should not have. */
642 close_process_descs (); 588 close_process_descs ();
643 #endif /* not NO_SUBPROCESSES */ 589 #endif /* not NO_SUBPROCESSES */
644 #ifndef WIN32_NATIVE
645 close_load_descs (); 590 close_load_descs ();
646 #endif
647 591
648 /* Note that use of alloca is always safe here. It's obvious for systems 592 /* Note that use of alloca is always safe here. It's obvious for systems
649 that do not have true vfork or that have true (stack) alloca. 593 that do not have true vfork or that have true (stack) alloca.
650 If using vfork and C_ALLOCA it is safe because that changes 594 If using vfork and C_ALLOCA it is safe because that changes
651 the superior's static variables as if the superior had done alloca 595 the superior's static variables as if the superior had done alloca
699 CONSP (tail) && STRINGP (XCAR (tail)); 643 CONSP (tail) && STRINGP (XCAR (tail));
700 tail = XCDR (tail)) 644 tail = XCDR (tail))
701 { 645 {
702 char **ep = env; 646 char **ep = env;
703 char *envvar_external; 647 char *envvar_external;
704 648 Bufbyte *envvar_internal = XSTRING_DATA (XCAR (tail));
705 TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (tail), 649
706 C_STRING_ALLOCA, envvar_external, 650 GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (envvar_internal, envvar_external);
707 Qfile_name);
708 651
709 /* See if envvar_external duplicates any string already in the env. 652 /* See if envvar_external duplicates any string already in the env.
710 If so, don't put it in. 653 If so, don't put it in.
711 When an env var has multiple definitions, 654 When an env var has multiple definitions,
712 we keep the definition that comes first in process-environment. */ 655 we keep the definition that comes first in process-environment. */
736 duplicate: ; 679 duplicate: ;
737 } 680 }
738 *new_env = 0; 681 *new_env = 0;
739 } 682 }
740 683
741 #ifdef WIN32_NATIVE 684 #ifdef WINDOWSNT
742 prepare_standard_handles (in, out, err, handles); 685 prepare_standard_handles (in, out, err, handles);
743 set_process_dir (current_dir); 686 set_process_dir (current_dir);
744 #else /* not WIN32_NATIVE */ 687 #else /* not WINDOWSNT */
745 /* Make sure that in, out, and err are not actually already in 688 /* Make sure that in, out, and err are not actually already in
746 descriptors zero, one, or two; this could happen if Emacs is 689 descriptors zero, one, or two; this could happen if Emacs is
747 started with its standard in, out, or error closed, as might 690 started with its standard in, out, or error closed, as might
748 happen under X. */ 691 happen under X. */
749 in = relocate_fd (in, 3); 692 in = relocate_fd (in, 3);
770 { 713 {
771 int fd; 714 int fd;
772 for (fd=3; fd<=64; fd++) 715 for (fd=3; fd<=64; fd++)
773 close (fd); 716 close (fd);
774 } 717 }
775 #endif /* not WIN32_NATIVE */ 718 #endif /* not WINDOWSNT */
776 719
777 #ifdef vipc 720 #ifdef vipc
778 something missing here; 721 something missing here;
779 #endif /* vipc */ 722 #endif /* vipc */
780 723
781 #ifdef WIN32_NATIVE 724 #ifdef WINDOWSNT
782 /* Spawn the child. (See ntproc.c:Spawnve). */ 725 /* Spawn the child. (See ntproc.c:Spawnve). */
783 cpid = spawnve (_P_NOWAIT, new_argv[0], (const char* const*)new_argv, 726 cpid = spawnve (_P_NOWAIT, new_argv[0], (CONST char* CONST*)new_argv,
784 (const char* const*)env); 727 (CONST char* CONST*)env);
785 if (cpid == -1) 728 if (cpid == -1)
786 /* An error occurred while trying to spawn the process. */ 729 /* An error occurred while trying to spawn the process. */
787 report_file_error ("Spawning child process", Qnil); 730 report_file_error ("Spawning child process", Qnil);
788 reset_standard_handles (in, out, err, handles); 731 reset_standard_handles (in, out, err, handles);
789 return cpid; 732 return cpid;
790 #else /* not WIN32_NATIVE */ 733 #else /* not WINDOWSNT */
791 /* execvp does not accept an environment arg so the only way 734 /* execvp does not accept an environment arg so the only way
792 to pass this environment is to set environ. Our caller 735 to pass this environment is to set environ. Our caller
793 is responsible for restoring the ambient value of environ. */ 736 is responsible for restoring the ambient value of environ. */
794 environ = env; 737 environ = env;
795 execvp (new_argv[0], new_argv); 738 execvp (new_argv[0], new_argv);
796 739
797 stdout_out ("Can't exec program %s\n", new_argv[0]); 740 stdout_out ("Can't exec program %s\n", new_argv[0]);
798 _exit (1); 741 _exit (1);
799 #endif /* not WIN32_NATIVE */ 742 #endif /* not WINDOWSNT */
800 } 743 }
801 744
802 static int 745 static int
803 getenv_internal (const Bufbyte *var, 746 getenv_internal (CONST Bufbyte *var,
804 Bytecount varlen, 747 Bytecount varlen,
805 Bufbyte **value, 748 Bufbyte **value,
806 Bytecount *valuelen) 749 Bytecount *valuelen)
807 { 750 {
808 Lisp_Object scan; 751 Lisp_Object scan;
812 Lisp_Object entry = XCAR (scan); 755 Lisp_Object entry = XCAR (scan);
813 756
814 if (STRINGP (entry) 757 if (STRINGP (entry)
815 && XSTRING_LENGTH (entry) > varlen 758 && XSTRING_LENGTH (entry) > varlen
816 && XSTRING_BYTE (entry, varlen) == '=' 759 && XSTRING_BYTE (entry, varlen) == '='
817 #ifdef WIN32_NATIVE 760 #ifdef WINDOWSNT
818 /* NT environment variables are case insensitive. */ 761 /* NT environment variables are case insensitive. */
819 && ! memicmp (XSTRING_DATA (entry), var, varlen) 762 && ! memicmp (XSTRING_DATA (entry), var, varlen)
820 #else /* not WIN32_NATIVE */ 763 #else /* not WINDOWSNT */
821 && ! memcmp (XSTRING_DATA (entry), var, varlen) 764 && ! memcmp (XSTRING_DATA (entry), var, varlen)
822 #endif /* not WIN32_NATIVE */ 765 #endif /* not WINDOWSNT */
823 ) 766 )
824 { 767 {
825 *value = XSTRING_DATA (entry) + (varlen + 1); 768 *value = XSTRING_DATA (entry) + (varlen + 1);
826 *valuelen = XSTRING_LENGTH (entry) - (varlen + 1); 769 *valuelen = XSTRING_LENGTH (entry) - (varlen + 1);
827 return 1; 770 return 1;
861 } 804 }
862 805
863 /* A version of getenv that consults process_environment, easily 806 /* A version of getenv that consults process_environment, easily
864 callable from C. */ 807 callable from C. */
865 char * 808 char *
866 egetenv (const char *var) 809 egetenv (CONST char *var)
867 { 810 {
868 Bufbyte *value; 811 Bufbyte *value;
869 Bytecount valuelen; 812 Bytecount valuelen;
870 813
871 if (getenv_internal ((const Bufbyte *) var, strlen (var), &value, &valuelen)) 814 if (getenv_internal ((CONST Bufbyte *) var, strlen (var), &value, &valuelen))
872 return (char *) value; 815 return (char *) value;
873 else 816 else
874 return 0; 817 return 0;
875 } 818 }
876 819
884 /* jwz: always initialize Vprocess_environment, so that egetenv() 827 /* jwz: always initialize Vprocess_environment, so that egetenv()
885 works in temacs. */ 828 works in temacs. */
886 char **envp; 829 char **envp;
887 Vprocess_environment = Qnil; 830 Vprocess_environment = Qnil;
888 for (envp = environ; envp && *envp; envp++) 831 for (envp = environ; envp && *envp; envp++)
889 Vprocess_environment = 832 {
890 Fcons (build_ext_string (*envp, Qfile_name), Vprocess_environment); 833 Vprocess_environment = Fcons (build_ext_string (*envp, FORMAT_OS),
834 Vprocess_environment);
835 }
891 } 836 }
892 837
893 { 838 {
894 /* Initialize shell-file-name from environment variables or best guess. */ 839 /* Initialize shell-file-name from environment variables or best guess. */
895 #ifdef WIN32_NATIVE 840 #ifdef WINDOWSNT
896 const char *shell = egetenv ("COMSPEC"); 841 CONST char *shell = egetenv ("COMSPEC");
897 if (!shell) shell = "\\WINNT\\system32\\cmd.exe"; 842 if (!shell) shell = "\\WINNT\\system32\\cmd.exe";
898 #else /* not WIN32_NATIVE */ 843 #else /* not WINDOWSNT */
899 const char *shell = egetenv ("SHELL"); 844 CONST char *shell = egetenv ("SHELL");
900 if (!shell) shell = "/bin/sh"; 845 if (!shell) shell = "/bin/sh";
901 #endif 846 #endif
902 847
903 Vshell_file_name = build_string (shell); 848 Vshell_file_name = build_string (shell);
904 } 849 }
921 #endif /* unused */ 866 #endif /* unused */
922 867
923 void 868 void
924 syms_of_callproc (void) 869 syms_of_callproc (void)
925 { 870 {
926 DEFSUBR (Fold_call_process_internal); 871 DEFSUBR (Fcall_process_internal);
927 DEFSUBR (Fgetenv); 872 DEFSUBR (Fgetenv);
928 } 873 }
929 874
930 void 875 void
931 vars_of_callproc (void) 876 vars_of_callproc (void)
932 { 877 {
933 /* This function can GC */ 878 /* This function can GC */
934 #ifdef WIN32_NATIVE 879 #ifdef DOS_NT
935 DEFVAR_LISP ("binary-process-input", &Vbinary_process_input /* 880 DEFVAR_LISP ("binary-process-input", &Vbinary_process_input /*
936 *If non-nil then new subprocesses are assumed to take binary input. 881 *If non-nil then new subprocesses are assumed to take binary input.
937 */ ); 882 */ );
938 Vbinary_process_input = Qnil; 883 Vbinary_process_input = Qnil;
939 884
940 DEFVAR_LISP ("binary-process-output", &Vbinary_process_output /* 885 DEFVAR_LISP ("binary-process-output", &Vbinary_process_output /*
941 *If non-nil then new subprocesses are assumed to produce binary output. 886 *If non-nil then new subprocesses are assumed to produce binary output.
942 */ ); 887 */ );
943 Vbinary_process_output = Qnil; 888 Vbinary_process_output = Qnil;
944 #endif /* WIN32_NATIVE */ 889 #endif /* DOS_NT */
945 890
946 DEFVAR_LISP ("shell-file-name", &Vshell_file_name /* 891 DEFVAR_LISP ("shell-file-name", &Vshell_file_name /*
947 *File name to load inferior shells from. 892 *File name to load inferior shells from.
948 Initialized from the SHELL environment variable. 893 Initialized from the SHELL environment variable.
949 */ ); 894 */ );