Mercurial > hg > xemacs-beta
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 */ ); |