Mercurial > hg > xemacs-beta
comparison src/callproc.c @ 410:de805c49cfc1 r21-2-35
Import from CVS: tag r21-2-35
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:19:21 +0200 |
parents | 501cfd01ee6d |
children | 697ef44129c6 |
comparison
equal
deleted
inserted
replaced
409:301b9ebbdf3b | 410:de805c49cfc1 |
---|---|
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 WINDOWSNT | 44 #ifdef WIN32_NATIVE |
45 #define _P_NOWAIT 1 /* from process.h */ | 45 #define _P_NOWAIT 1 /* from process.h */ |
46 #include "nt.h" | 46 #include "nt.h" |
47 #endif | 47 #endif |
48 | 48 |
49 #ifdef DOS_NT | 49 #ifdef WIN32_NATIVE |
50 /* When we are starting external processes we need to know whether they | 50 /* 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 | 51 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 | 52 \r\n). Similarly for output: if newlines are written as \r\n then it's |
53 text process output, otherwise it's binary. */ | 53 text process output, otherwise it's binary. */ |
54 Lisp_Object Vbinary_process_input; | 54 Lisp_Object Vbinary_process_input; |
55 Lisp_Object Vbinary_process_output; | 55 Lisp_Object Vbinary_process_output; |
56 #endif /* DOS_NT */ | 56 #endif /* WIN32_NATIVE */ |
57 | 57 |
58 Lisp_Object Vshell_file_name; | 58 Lisp_Object Vshell_file_name; |
59 | 59 |
60 /* The environment to pass to all subprocesses when they are started. | 60 /* The environment to pass to all subprocesses when they are started. |
61 This is in the semi-bogus format of ("VAR=VAL" "VAR2=VAL2" ... ) | 61 This is in the semi-bogus format of ("VAR=VAL" "VAR2=VAL2" ... ) |
72 /* If synch_process_death is zero, | 72 /* If synch_process_death is zero, |
73 this is exit code of synchronous subprocess. */ | 73 this is exit code of synchronous subprocess. */ |
74 int synch_process_retcode; | 74 int synch_process_retcode; |
75 | 75 |
76 /* Clean up when exiting Fcall_process_internal. | 76 /* Clean up when exiting Fcall_process_internal. |
77 On MSDOS, delete the temporary file on any kind of termination. | 77 On Windows, delete the temporary file on any kind of termination. |
78 On Unix, kill the process and any children on termination by signal. */ | 78 On Unix, kill the process and any children on termination by signal. */ |
79 | 79 |
80 /* Nonzero if this is termination due to exit. */ | 80 /* Nonzero if this is termination due to exit. */ |
81 static int call_process_exited; | 81 static int call_process_exited; |
82 | 82 |
111 | 111 |
112 record_unwind_protect (call_process_kill, fdpid); | 112 record_unwind_protect (call_process_kill, fdpid); |
113 /* #### "c-G" -- need non-consing Single-key-description */ | 113 /* #### "c-G" -- need non-consing Single-key-description */ |
114 message ("Waiting for process to die...(type C-g again to kill it instantly)"); | 114 message ("Waiting for process to die...(type C-g again to kill it instantly)"); |
115 | 115 |
116 #ifdef WINDOWSNT | 116 #ifdef WIN32_NATIVE |
117 { | 117 { |
118 HANDLE pHandle = OpenProcess (PROCESS_ALL_ACCESS, 0, pid); | 118 HANDLE pHandle = OpenProcess (PROCESS_ALL_ACCESS, 0, pid); |
119 if (pHandle == NULL) | 119 if (pHandle == NULL) |
120 warn_when_safe (Qprocess, Qwarning, | 120 warn_when_safe (Qprocess, Qwarning, |
121 "cannot open process (PID %d) for cleanup", pid); | 121 "cannot open process (PID %d) for cleanup", pid); |
178 { | 178 { |
179 /* This function can GC */ | 179 /* This function can GC */ |
180 Lisp_Object infile, buffer, current_dir, display, path; | 180 Lisp_Object infile, buffer, current_dir, display, path; |
181 int fd[2]; | 181 int fd[2]; |
182 int filefd; | 182 int filefd; |
183 #ifdef WINDOWSNT | 183 #ifdef WIN32_NATIVE |
184 HANDLE pHandle; | 184 HANDLE pHandle; |
185 #endif | 185 #endif |
186 int pid; | 186 int pid; |
187 char buf[16384]; | 187 char buf[16384]; |
188 char *bufptr = buf; | 188 char *bufptr = buf; |
347 if (NILP (error_file)) | 347 if (NILP (error_file)) |
348 fd_error = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY); | 348 fd_error = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY); |
349 else if (STRINGP (error_file)) | 349 else if (STRINGP (error_file)) |
350 { | 350 { |
351 fd_error = open ((const char *) XSTRING_DATA (error_file), | 351 fd_error = open ((const char *) XSTRING_DATA (error_file), |
352 #ifdef DOS_NT | 352 #ifdef WIN32_NATIVE |
353 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, | 353 O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, |
354 S_IREAD | S_IWRITE | 354 S_IREAD | S_IWRITE |
355 #else /* not DOS_NT */ | 355 #else /* not WIN32_NATIVE */ |
356 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, | 356 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, |
357 CREAT_MODE | 357 CREAT_MODE |
358 #endif /* not DOS_NT */ | 358 #endif /* not WIN32_NATIVE */ |
359 ); | 359 ); |
360 } | 360 } |
361 | 361 |
362 if (fd_error < 0) | 362 if (fd_error < 0) |
363 { | 363 { |
367 close (fd1); | 367 close (fd1); |
368 report_file_error ("Cannot open", Fcons(error_file, Qnil)); | 368 report_file_error ("Cannot open", Fcons(error_file, Qnil)); |
369 } | 369 } |
370 | 370 |
371 fork_error = Qnil; | 371 fork_error = Qnil; |
372 #ifdef WINDOWSNT | 372 #ifdef WIN32_NATIVE |
373 pid = child_setup (filefd, fd1, fd_error, new_argv, | 373 pid = child_setup (filefd, fd1, fd_error, new_argv, |
374 (char *) XSTRING_DATA (current_dir)); | 374 (char *) XSTRING_DATA (current_dir)); |
375 if (!INTP (buffer)) | 375 if (!INTP (buffer)) |
376 { | 376 { |
377 /* OpenProcess() as soon after child_setup as possible. It's too | 377 /* OpenProcess() as soon after child_setup as possible. It's too |
387 #endif | 387 #endif |
388 } | 388 } |
389 /* Close STDERR into the parent process. We no longer need it. */ | 389 /* Close STDERR into the parent process. We no longer need it. */ |
390 if (fd_error >= 0) | 390 if (fd_error >= 0) |
391 close (fd_error); | 391 close (fd_error); |
392 #else /* not WINDOWSNT */ | 392 #else /* not WIN32_NATIVE */ |
393 pid = fork (); | 393 pid = fork (); |
394 | 394 |
395 if (pid == 0) | 395 if (pid == 0) |
396 { | 396 { |
397 if (fd[0] >= 0) | 397 if (fd[0] >= 0) |
408 (char *) XSTRING_DATA (current_dir)); | 408 (char *) XSTRING_DATA (current_dir)); |
409 } | 409 } |
410 if (fd_error >= 0) | 410 if (fd_error >= 0) |
411 close (fd_error); | 411 close (fd_error); |
412 | 412 |
413 #endif /* not WINDOWSNT */ | 413 #endif /* not WIN32_NATIVE */ |
414 | 414 |
415 environ = save_environ; | 415 environ = save_environ; |
416 | 416 |
417 /* Close most of our fd's, but not fd[0] | 417 /* Close most of our fd's, but not fd[0] |
418 since we will use that to read input from. */ | 418 since we will use that to read input from. */ |
422 } | 422 } |
423 | 423 |
424 if (!NILP (fork_error)) | 424 if (!NILP (fork_error)) |
425 signal_error (Qfile_error, fork_error); | 425 signal_error (Qfile_error, fork_error); |
426 | 426 |
427 #ifndef WINDOWSNT | 427 #ifndef WIN32_NATIVE |
428 if (pid < 0) | 428 if (pid < 0) |
429 { | 429 { |
430 if (fd[0] >= 0) | 430 if (fd[0] >= 0) |
431 close (fd[0]); | 431 close (fd[0]); |
432 report_file_error ("Doing fork", Qnil); | 432 report_file_error ("Doing fork", Qnil); |
500 /* Now NREAD is the total amount of data in the buffer. */ | 500 /* Now NREAD is the total amount of data in the buffer. */ |
501 if (nread == 0) | 501 if (nread == 0) |
502 break; | 502 break; |
503 | 503 |
504 #if 0 | 504 #if 0 |
505 #ifdef DOS_NT | 505 #ifdef WIN32_NATIVE |
506 /* Until we pull out of MULE things like | 506 /* Until we pull out of MULE things like |
507 make_decoding_input_stream(), we do the following which is | 507 make_decoding_input_stream(), we do the following which is |
508 less elegant. --marcpa */ | 508 less elegant. --marcpa */ |
509 /* We did. -- kkm */ | 509 /* We did. -- kkm */ |
510 { | 510 { |
540 Lstream_close (XLSTREAM (instream)); | 540 Lstream_close (XLSTREAM (instream)); |
541 NUNGCPRO; | 541 NUNGCPRO; |
542 | 542 |
543 QUIT; | 543 QUIT; |
544 /* Wait for it to terminate, unless it already has. */ | 544 /* Wait for it to terminate, unless it already has. */ |
545 #ifdef WINDOWSNT | 545 #ifdef WIN32_NATIVE |
546 wait_for_termination (pHandle); | 546 wait_for_termination (pHandle); |
547 #else | 547 #else |
548 wait_for_termination (pid); | 548 wait_for_termination (pid); |
549 #endif | 549 #endif |
550 | 550 |
600 CURRENT_DIR is an elisp string giving the path of the current | 600 CURRENT_DIR is an elisp string giving the path of the current |
601 directory the subprocess should have. Since we can't really signal | 601 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 | 602 a decent error from within the child, this should be verified as an |
603 executable directory by the parent. */ | 603 executable directory by the parent. */ |
604 | 604 |
605 #ifdef WINDOWSNT | 605 #ifdef WIN32_NATIVE |
606 int | 606 int |
607 #else | 607 #else |
608 void | 608 void |
609 #endif | 609 #endif |
610 child_setup (int in, int out, int err, char **new_argv, | 610 child_setup (int in, int out, int err, char **new_argv, |
611 const char *current_dir) | 611 const char *current_dir) |
612 { | 612 { |
613 char **env; | 613 char **env; |
614 char *pwd; | 614 char *pwd; |
615 #ifdef WINDOWSNT | 615 #ifdef WIN32_NATIVE |
616 int cpid; | 616 int cpid; |
617 HANDLE handles[4]; | 617 HANDLE handles[4]; |
618 #endif /* WINDOWSNT */ | 618 #endif /* WIN32_NATIVE */ |
619 | 619 |
620 #ifdef SET_EMACS_PRIORITY | 620 #ifdef SET_EMACS_PRIORITY |
621 if (emacs_priority != 0) | 621 if (emacs_priority != 0) |
622 nice (- emacs_priority); | 622 nice (- emacs_priority); |
623 #endif | 623 #endif |
624 | 624 |
625 #if !defined (NO_SUBPROCESSES) && !defined (WINDOWSNT) | 625 /* Under Windows, we are not in a child process at all, so we should |
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) | |
626 /* Close Emacs's descriptors that this process should not have. */ | 641 /* Close Emacs's descriptors that this process should not have. */ |
627 close_process_descs (); | 642 close_process_descs (); |
628 #endif /* not NO_SUBPROCESSES */ | 643 #endif /* not NO_SUBPROCESSES */ |
644 #ifndef WIN32_NATIVE | |
629 close_load_descs (); | 645 close_load_descs (); |
646 #endif | |
630 | 647 |
631 /* Note that use of alloca is always safe here. It's obvious for systems | 648 /* Note that use of alloca is always safe here. It's obvious for systems |
632 that do not have true vfork or that have true (stack) alloca. | 649 that do not have true vfork or that have true (stack) alloca. |
633 If using vfork and C_ALLOCA it is safe because that changes | 650 If using vfork and C_ALLOCA it is safe because that changes |
634 the superior's static variables as if the superior had done alloca | 651 the superior's static variables as if the superior had done alloca |
719 duplicate: ; | 736 duplicate: ; |
720 } | 737 } |
721 *new_env = 0; | 738 *new_env = 0; |
722 } | 739 } |
723 | 740 |
724 #ifdef WINDOWSNT | 741 #ifdef WIN32_NATIVE |
725 prepare_standard_handles (in, out, err, handles); | 742 prepare_standard_handles (in, out, err, handles); |
726 set_process_dir (current_dir); | 743 set_process_dir (current_dir); |
727 #else /* not WINDOWSNT */ | 744 #else /* not WIN32_NATIVE */ |
728 /* Make sure that in, out, and err are not actually already in | 745 /* Make sure that in, out, and err are not actually already in |
729 descriptors zero, one, or two; this could happen if Emacs is | 746 descriptors zero, one, or two; this could happen if Emacs is |
730 started with its standard in, out, or error closed, as might | 747 started with its standard in, out, or error closed, as might |
731 happen under X. */ | 748 happen under X. */ |
732 in = relocate_fd (in, 3); | 749 in = relocate_fd (in, 3); |
753 { | 770 { |
754 int fd; | 771 int fd; |
755 for (fd=3; fd<=64; fd++) | 772 for (fd=3; fd<=64; fd++) |
756 close (fd); | 773 close (fd); |
757 } | 774 } |
758 #endif /* not WINDOWSNT */ | 775 #endif /* not WIN32_NATIVE */ |
759 | 776 |
760 #ifdef vipc | 777 #ifdef vipc |
761 something missing here; | 778 something missing here; |
762 #endif /* vipc */ | 779 #endif /* vipc */ |
763 | 780 |
764 #ifdef WINDOWSNT | 781 #ifdef WIN32_NATIVE |
765 /* Spawn the child. (See ntproc.c:Spawnve). */ | 782 /* Spawn the child. (See ntproc.c:Spawnve). */ |
766 cpid = spawnve (_P_NOWAIT, new_argv[0], (const char* const*)new_argv, | 783 cpid = spawnve (_P_NOWAIT, new_argv[0], (const char* const*)new_argv, |
767 (const char* const*)env); | 784 (const char* const*)env); |
768 if (cpid == -1) | 785 if (cpid == -1) |
769 /* An error occurred while trying to spawn the process. */ | 786 /* An error occurred while trying to spawn the process. */ |
770 report_file_error ("Spawning child process", Qnil); | 787 report_file_error ("Spawning child process", Qnil); |
771 reset_standard_handles (in, out, err, handles); | 788 reset_standard_handles (in, out, err, handles); |
772 return cpid; | 789 return cpid; |
773 #else /* not WINDOWSNT */ | 790 #else /* not WIN32_NATIVE */ |
774 /* execvp does not accept an environment arg so the only way | 791 /* execvp does not accept an environment arg so the only way |
775 to pass this environment is to set environ. Our caller | 792 to pass this environment is to set environ. Our caller |
776 is responsible for restoring the ambient value of environ. */ | 793 is responsible for restoring the ambient value of environ. */ |
777 environ = env; | 794 environ = env; |
778 execvp (new_argv[0], new_argv); | 795 execvp (new_argv[0], new_argv); |
779 | 796 |
780 stdout_out ("Can't exec program %s\n", new_argv[0]); | 797 stdout_out ("Can't exec program %s\n", new_argv[0]); |
781 _exit (1); | 798 _exit (1); |
782 #endif /* not WINDOWSNT */ | 799 #endif /* not WIN32_NATIVE */ |
783 } | 800 } |
784 | 801 |
785 static int | 802 static int |
786 getenv_internal (const Bufbyte *var, | 803 getenv_internal (const Bufbyte *var, |
787 Bytecount varlen, | 804 Bytecount varlen, |
795 Lisp_Object entry = XCAR (scan); | 812 Lisp_Object entry = XCAR (scan); |
796 | 813 |
797 if (STRINGP (entry) | 814 if (STRINGP (entry) |
798 && XSTRING_LENGTH (entry) > varlen | 815 && XSTRING_LENGTH (entry) > varlen |
799 && XSTRING_BYTE (entry, varlen) == '=' | 816 && XSTRING_BYTE (entry, varlen) == '=' |
800 #ifdef WINDOWSNT | 817 #ifdef WIN32_NATIVE |
801 /* NT environment variables are case insensitive. */ | 818 /* NT environment variables are case insensitive. */ |
802 && ! memicmp (XSTRING_DATA (entry), var, varlen) | 819 && ! memicmp (XSTRING_DATA (entry), var, varlen) |
803 #else /* not WINDOWSNT */ | 820 #else /* not WIN32_NATIVE */ |
804 && ! memcmp (XSTRING_DATA (entry), var, varlen) | 821 && ! memcmp (XSTRING_DATA (entry), var, varlen) |
805 #endif /* not WINDOWSNT */ | 822 #endif /* not WIN32_NATIVE */ |
806 ) | 823 ) |
807 { | 824 { |
808 *value = XSTRING_DATA (entry) + (varlen + 1); | 825 *value = XSTRING_DATA (entry) + (varlen + 1); |
809 *valuelen = XSTRING_LENGTH (entry) - (varlen + 1); | 826 *valuelen = XSTRING_LENGTH (entry) - (varlen + 1); |
810 return 1; | 827 return 1; |
873 Fcons (build_ext_string (*envp, Qfile_name), Vprocess_environment); | 890 Fcons (build_ext_string (*envp, Qfile_name), Vprocess_environment); |
874 } | 891 } |
875 | 892 |
876 { | 893 { |
877 /* Initialize shell-file-name from environment variables or best guess. */ | 894 /* Initialize shell-file-name from environment variables or best guess. */ |
878 #ifdef WINDOWSNT | 895 #ifdef WIN32_NATIVE |
879 const char *shell = egetenv ("COMSPEC"); | 896 const char *shell = egetenv ("COMSPEC"); |
880 if (!shell) shell = "\\WINNT\\system32\\cmd.exe"; | 897 if (!shell) shell = "\\WINNT\\system32\\cmd.exe"; |
881 #else /* not WINDOWSNT */ | 898 #else /* not WIN32_NATIVE */ |
882 const char *shell = egetenv ("SHELL"); | 899 const char *shell = egetenv ("SHELL"); |
883 if (!shell) shell = "/bin/sh"; | 900 if (!shell) shell = "/bin/sh"; |
884 #endif | 901 #endif |
885 | 902 |
886 Vshell_file_name = build_string (shell); | 903 Vshell_file_name = build_string (shell); |
912 | 929 |
913 void | 930 void |
914 vars_of_callproc (void) | 931 vars_of_callproc (void) |
915 { | 932 { |
916 /* This function can GC */ | 933 /* This function can GC */ |
917 #ifdef DOS_NT | 934 #ifdef WIN32_NATIVE |
918 DEFVAR_LISP ("binary-process-input", &Vbinary_process_input /* | 935 DEFVAR_LISP ("binary-process-input", &Vbinary_process_input /* |
919 *If non-nil then new subprocesses are assumed to take binary input. | 936 *If non-nil then new subprocesses are assumed to take binary input. |
920 */ ); | 937 */ ); |
921 Vbinary_process_input = Qnil; | 938 Vbinary_process_input = Qnil; |
922 | 939 |
923 DEFVAR_LISP ("binary-process-output", &Vbinary_process_output /* | 940 DEFVAR_LISP ("binary-process-output", &Vbinary_process_output /* |
924 *If non-nil then new subprocesses are assumed to produce binary output. | 941 *If non-nil then new subprocesses are assumed to produce binary output. |
925 */ ); | 942 */ ); |
926 Vbinary_process_output = Qnil; | 943 Vbinary_process_output = Qnil; |
927 #endif /* DOS_NT */ | 944 #endif /* WIN32_NATIVE */ |
928 | 945 |
929 DEFVAR_LISP ("shell-file-name", &Vshell_file_name /* | 946 DEFVAR_LISP ("shell-file-name", &Vshell_file_name /* |
930 *File name to load inferior shells from. | 947 *File name to load inferior shells from. |
931 Initialized from the SHELL environment variable. | 948 Initialized from the SHELL environment variable. |
932 */ ); | 949 */ ); |