X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fprocess-nt.c;h=9c0a4efae9192ae95f21b027f02df9f1029ce624;hb=515ed47192a2fc212474dc246a875771890e0cbe;hp=8450fbc4be45522e20c11261cda52ae6f03d5b96;hpb=2fd9701a4f902054649dde9143a3f77809afee8f;p=chise%2Fxemacs-chise.git.1 diff --git a/src/process-nt.c b/src/process-nt.c index 8450fbc..9c0a4ef 100644 --- a/src/process-nt.c +++ b/src/process-nt.c @@ -26,35 +26,34 @@ Boston, MA 02111-1307, USA. */ #include #include "lisp.h" +#include "buffer.h" #include "console-msw.h" #include "hash.h" #include "lstream.h" +#include "nt.h" #include "process.h" #include "procimpl.h" #include "sysdep.h" #include -#ifdef __MINGW32__ #include -#endif #include #ifdef HAVE_SOCKETS #include #endif +/* Bound by win32-native.el */ +Lisp_Object Qmswindows_construct_process_command_line; + /* Arbitrary size limit for code fragments passed to run_in_other_process */ #define FRAGMENT_CODE_SIZE 32 -/* Bound by winnt.el */ -Lisp_Object Qnt_quote_process_args; - /* Implementation-specific data. Pointed to by Lisp_Process->process_data */ struct nt_process_data { HANDLE h_process; DWORD dwProcessId; HWND hwnd; /* console window */ - int need_enable_child_signals; }; /* Control whether create_child causes the process to inherit Emacs' @@ -407,10 +406,11 @@ enable_child_signals (HANDLE h_process) /* ---------------------------- the 95 way ------------------------------- */ static BOOL CALLBACK -find_child_console (HWND hwnd, struct nt_process_data *cp) +find_child_console (HWND hwnd, long putada) { DWORD thread_id; DWORD process_id; + struct nt_process_data *cp = (struct nt_process_data *) putada; thread_id = GetWindowThreadProcessId (hwnd, &process_id); if (process_id == cp->dwProcessId) @@ -419,7 +419,7 @@ find_child_console (HWND hwnd, struct nt_process_data *cp) GetClassName (hwnd, window_class, sizeof (window_class)); if (strcmp (window_class, - msw_windows9x_p () + mswindows_windows9x_p () ? "tty" : "ConsoleWindowClass") == 0) { @@ -540,7 +540,7 @@ send_signal_the_95_way (struct nt_process_data *cp, int pid, int signo) if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd) { #if 1 - if (msw_windows9x_p ()) + if (mswindows_windows9x_p ()) { /* Another possibility is to try terminating the VDM out-right by @@ -608,7 +608,7 @@ send_signal_the_95_way (struct nt_process_data *cp, int pid, int signo) static int send_signal (struct nt_process_data *cp, int pid, int signo) { - return send_signal_the_nt_way (cp, pid, signo) + return (!mswindows_windows9x_p () && send_signal_the_nt_way (cp, pid, signo)) || send_signal_the_95_way (cp, pid, signo); } @@ -621,7 +621,7 @@ validate_signal_number (int signo) if (signo != SIGKILL && signo != SIGTERM && signo != SIGQUIT && signo != SIGINT && signo != SIGHUP) - signal_simple_error ("Signal number not supported", make_int (signo)); + invalid_argument ("Signal number not supported", make_int (signo)); } /*-----------------------------------------------------------------------*/ @@ -642,6 +642,9 @@ static void nt_finalize_process_data (Lisp_Process *p, int for_disksave) { assert (!for_disksave); + /* If it's still in the list of processes we are waiting on delete + it. */ + mswindows_unwait_process (p); if (NT_DATA (p)->h_process) CloseHandle (NT_DATA (p)->h_process); } @@ -672,14 +675,36 @@ static void signal_cannot_launch (Lisp_Object image_file, DWORD err) { mswindows_set_errno (err); - signal_simple_error_2 ("Error starting", image_file, lisp_strerror (errno)); + report_file_error ("Error starting", image_file); } static void -ensure_console_window_exists () +ensure_console_window_exists (void) { - if (msw_windows9x_p ()) - msw_hide_console (); + if (mswindows_windows9x_p ()) + mswindows_hide_console (); +} + +int +compare_env (const void *strp1, const void *strp2) +{ + const char *str1 = *(const char**)strp1, *str2 = *(const char**)strp2; + + while (*str1 && *str2 && *str1 != '=' && *str2 != '=') + { + if ((*str1) > (*str2)) + return 1; + else if ((*str1) < (*str2)) + return -1; + str1++, str2++; + } + + if (*str1 == '=' && *str2 == '=') + return 0; + else if (*str1 == '=') + return -1; + else + return 1; } static int @@ -687,37 +712,45 @@ nt_create_process (Lisp_Process *p, Lisp_Object *argv, int nargv, Lisp_Object program, Lisp_Object cur_dir) { + /* Synched up with sys_spawnve in FSF 20.6. Significantly different + but still synchable. */ HANDLE hmyshove, hmyslurp, hprocin, hprocout, hprocerr; - LPTSTR command_line; + Extbyte *command_line; BOOL do_io, windowed; char *proc_env; + /* No need to DOS-ize the filename; expand-file-name (called prior) + already does this. */ + /* Find out whether the application is windowed or not */ - { - /* SHGetFileInfo tends to return ERROR_FILE_NOT_FOUND on most - errors. This leads to bogus error message. */ - DWORD image_type; - char *p = strrchr ((char *)XSTRING_DATA (program), '.'); - if (p != NULL && - (stricmp (p, ".exe") == 0 || - stricmp (p, ".com") == 0 || - stricmp (p, ".bat") == 0 || - stricmp (p, ".cmd") == 0)) - { - image_type = SHGetFileInfo ((char *)XSTRING_DATA (program), 0,NULL, - 0, SHGFI_EXETYPE); - } - else - { - char progname[MAX_PATH]; - sprintf (progname, "%s.exe", (char *)XSTRING_DATA (program)); - image_type = SHGetFileInfo (progname, 0, NULL, 0, SHGFI_EXETYPE); - } - if (image_type == 0) - signal_cannot_launch (program, (GetLastError () == ERROR_FILE_NOT_FOUND - ? ERROR_BAD_FORMAT : GetLastError ())); - windowed = HIWORD (image_type) != 0; - } + if (xSHGetFileInfoA) + { + /* SHGetFileInfo tends to return ERROR_FILE_NOT_FOUND on most + errors. This leads to bogus error message. */ + DWORD image_type; + char *p = strrchr ((char *)XSTRING_DATA (program), '.'); + if (p != NULL && + (stricmp (p, ".exe") == 0 || + stricmp (p, ".com") == 0 || + stricmp (p, ".bat") == 0 || + stricmp (p, ".cmd") == 0)) + { + image_type = xSHGetFileInfoA ((char *)XSTRING_DATA (program), 0,NULL, + 0, SHGFI_EXETYPE); + } + else + { + char progname[MAX_PATH]; + sprintf (progname, "%s.exe", (char *)XSTRING_DATA (program)); + image_type = xSHGetFileInfoA (progname, 0, NULL, 0, SHGFI_EXETYPE); + } + if (image_type == 0) + signal_cannot_launch (program, (GetLastError () == ERROR_FILE_NOT_FOUND + ? ERROR_BAD_FORMAT : GetLastError ())); + windowed = HIWORD (image_type) != 0; + } + else /* NT 3.5; we have no idea so just guess. */ + windowed = 0; /* Decide whether to do I/O on process handles, or just mark the process exited immediately upon successful launching. We do I/O if the @@ -739,22 +772,25 @@ nt_create_process (Lisp_Process *p, CreatePipe (&hmyslurp, &hprocout, &sa, 0); /* Duplicate the stdout handle for use as stderr */ - DuplicateHandle(GetCurrentProcess(), hprocout, GetCurrentProcess(), &hprocerr, - 0, TRUE, DUPLICATE_SAME_ACCESS); + DuplicateHandle(GetCurrentProcess(), hprocout, GetCurrentProcess(), + &hprocerr, 0, TRUE, DUPLICATE_SAME_ACCESS); /* Stupid Win32 allows to create a pipe with *both* ends either inheritable or not. We need process ends inheritable, and local ends not inheritable. */ - DuplicateHandle (GetCurrentProcess(), hmyshove, GetCurrentProcess(), &htmp, - 0, FALSE, DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS); + DuplicateHandle (GetCurrentProcess(), hmyshove, GetCurrentProcess(), + &htmp, 0, FALSE, + DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS); hmyshove = htmp; - DuplicateHandle (GetCurrentProcess(), hmyslurp, GetCurrentProcess(), &htmp, - 0, FALSE, DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS); + DuplicateHandle (GetCurrentProcess(), hmyslurp, GetCurrentProcess(), + &htmp, 0, FALSE, + DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS); hmyslurp = htmp; } /* Convert an argv vector into Win32 style command line by a call to - lisp function `nt-quote-process-args' which see (in winnt.el)*/ + lisp function `mswindows-construct-process-command-line' + (in win32-native.el) */ { int i; Lisp_Object args_or_ret = Qnil; @@ -767,17 +803,16 @@ nt_create_process (Lisp_Process *p, args_or_ret = Fnreverse (args_or_ret); args_or_ret = Fcons (program, args_or_ret); - args_or_ret = call1 (Qnt_quote_process_args, args_or_ret); + args_or_ret = call1 (Qmswindows_construct_process_command_line, + args_or_ret); if (!STRINGP (args_or_ret)) /* Luser wrote his/her own clever version */ - error ("Bogus return value from `nt-quote-process-args'"); + invalid_argument + ("Bogus return value from `mswindows-construct-process-command-line'", + args_or_ret); - command_line = alloca_array (char, (XSTRING_LENGTH (program) - + XSTRING_LENGTH (args_or_ret) + 2)); - strcpy (command_line, XSTRING_DATA (program)); - strcat (command_line, " "); - strcat (command_line, XSTRING_DATA (args_or_ret)); + LISP_STRING_TO_EXTERNAL (args_or_ret, command_line, Qmswindows_tstr); UNGCPRO; /* args_or_ret */ } @@ -786,7 +821,6 @@ nt_create_process (Lisp_Process *p, Vprocess_environment terminated by 2 nuls. */ { - extern int compare_env (const char **strp1, const char **strp2); char **env; REGISTER Lisp_Object tem; REGISTER char **new_env; @@ -798,6 +832,17 @@ nt_create_process (Lisp_Process *p, && STRINGP (XCAR (tem))); tem = XCDR (tem)) new_length++; + + /* FSF adds an extra env var to hold the current process ID of the + Emacs process. Apparently this is used only by emacsserver.c, + which we have superseded to gnuserv.c. (#### Does it work under + MS Windows?) + + sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d", + GetCurrentProcessId ()); + arglen += strlen (ppid_env_var_buffer) + 1; + numenv++; + */ /* new_length + 1 to include terminating 0. */ env = new_env = alloca_array (char *, new_length + 1); @@ -855,6 +900,24 @@ nt_create_process (Lisp_Process *p, } *penv = 0; } + +#if 0 + /* #### we need to port this. */ + /* On Windows 95, if cmdname is a DOS app, we invoke a helper + application to start it by specifying the helper app as cmdname, + while leaving the real app name as argv[0]. */ + if (is_dos_app) + { + cmdname = (char*) alloca (MAXPATHLEN); + if (egetenv ("CMDPROXY")) + strcpy ((char*)cmdname, egetenv ("CMDPROXY")); + else + { + strcpy ((char*)cmdname, XSTRING_DATA (Vinvocation_directory)); + strcat ((char*)cmdname, "cmdproxy.exe"); + } + } +#endif /* Create process */ { @@ -875,7 +938,7 @@ nt_create_process (Lisp_Process *p, } flags = CREATE_SUSPENDED; - if (msw_windows9x_p ()) + if (mswindows_windows9x_p ()) flags |= (!NILP (Vmswindows_start_process_share_console) ? CREATE_NEW_PROCESS_GROUP : CREATE_NEW_CONSOLE); @@ -923,18 +986,12 @@ nt_create_process (Lisp_Process *p, CloseHandle (pi.hProcess); } + if (!windowed) + enable_child_signals (pi.hProcess); + ResumeThread (pi.hThread); CloseHandle (pi.hThread); - /* Remember to enable child signals later if this is not a windowed - app. Can't do it right now because that screws up the MKS Toolkit - shell. */ - if (!windowed) - { - NT_DATA(p)->need_enable_child_signals = 10; - kick_status_notify (); - } - return ((int)pi.dwProcessId); } } @@ -951,18 +1008,6 @@ static void nt_update_status_if_terminated (Lisp_Process* p) { DWORD exit_code; - - if (NT_DATA(p)->need_enable_child_signals > 1) - { - NT_DATA(p)->need_enable_child_signals -= 1; - kick_status_notify (); - } - else if (NT_DATA(p)->need_enable_child_signals == 1) - { - enable_child_signals(NT_DATA(p)->h_process); - NT_DATA(p)->need_enable_child_signals = 0; - } - if (GetExitCodeProcess (NT_DATA(p)->h_process, &exit_code) && exit_code != STILL_ACTIVE) { @@ -1000,16 +1045,16 @@ nt_send_process (Lisp_Object proc, struct lstream* lstream) /* use a reasonable-sized buffer (somewhere around the size of the stream buffer) so as to avoid inundating the stream with blocked data. */ - Bufbyte chunkbuf[128]; + Bufbyte chunkbuf[512]; Bytecount chunklen; while (1) { - ssize_t writeret; + Lstream_data_count writeret; - chunklen = Lstream_read (lstream, chunkbuf, 128); + chunklen = Lstream_read (lstream, chunkbuf, 512); if (chunklen <= 0) - break; /* perhaps should abort() if < 0? + break; /* perhaps should ABORT() if < 0? This should never happen. */ /* Lstream_write() will never successfully write less than the @@ -1026,8 +1071,8 @@ nt_send_process (Lisp_Object proc, struct lstream* lstream) p->tick++; process_tick++; deactivate_process (*((Lisp_Object *) (&vol_proc))); - error ("Broken pipe error sending to process %s; closed it", - XSTRING_DATA (p->name)); + invalid_operation ("Broken pipe error sending to process; closed it", + p->name); } { @@ -1065,24 +1110,16 @@ nt_kill_child_process (Lisp_Object proc, int signo, { Lisp_Process *p = XPROCESS (proc); - /* Enable child signals if necessary. This may lose the first - but it's better than nothing. */ - if (NT_DATA (p)->need_enable_child_signals > 0) - { - enable_child_signals (NT_DATA(p)->h_process); - NT_DATA (p)->need_enable_child_signals = 0; - } - /* Signal error if SIGNO cannot be sent */ validate_signal_number (signo); /* Send signal */ if (!send_signal (NT_DATA (p), 0, signo)) - signal_simple_error ("Cannot send signal to process", proc); + invalid_operation ("Cannot send signal to process", proc); } /* - * Kill any process in the system given its PID. + * Kill any process in the system given its PID * * Returns zero if a signal successfully sent, or * negative number upon failure @@ -1220,7 +1257,7 @@ nt_open_network_stream (Lisp_Object name, Lisp_Object host, CHECK_STRING (host); if (!EQ (protocol, Qtcp)) - signal_simple_error ("Unsupported protocol", protocol); + invalid_argument ("Unsupported protocol", protocol); if (INTP (service)) port = htons ((unsigned short) XINT (service)); @@ -1230,7 +1267,7 @@ nt_open_network_stream (Lisp_Object name, Lisp_Object host, CHECK_STRING (service); svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp"); if (svc_info == 0) - signal_simple_error ("Unknown service", service); + invalid_argument ("Unknown service", service); port = svc_info->s_port; } @@ -1339,7 +1376,7 @@ process_type_create_nt (void) void syms_of_process_nt (void) { - defsymbol (&Qnt_quote_process_args, "nt-quote-process-args"); + DEFSYMBOL (Qmswindows_construct_process_command_line); } void @@ -1349,7 +1386,7 @@ vars_of_process_nt (void) &Vmswindows_start_process_share_console /* When nil, new child processes are given a new console. When non-nil, they share the Emacs console; this has the limitation of -allowing only only DOS subprocess to run at a time (whether started directly +allowing only one DOS subprocess to run at a time (whether started directly or indirectly by Emacs), and preventing Emacs from cleanly terminating the subprocess group, but may allow Emacs to interrupt a subprocess that doesn't otherwise respond to interrupts from Emacs.