X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c519b5e10e0706332a557a49299b96537305d459..5bcf005469998ba44f13880e68c918bd7bc96053:/src/w32proc.c?ds=sidebyside diff --git a/src/w32proc.c b/src/w32proc.c index ee0f5f7986..7c9aad6b0a 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1,5 +1,5 @@ -/* Process support for Windows NT port of GNU EMACS. - Copyright (C) 1992, 1995 Free Software Foundation, Inc. +/* Process support for GNU Emacs on the Microsoft W32 API. + Copyright (C) 1992, 1995, 1999, 2000, 2001 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -38,16 +38,63 @@ Boston, MA 02111-1307, USA. #undef kill #include +#ifdef __GNUC__ +/* This definition is missing from mingw32 headers. */ +extern BOOL WINAPI IsValidLocale(LCID, DWORD); +#endif #include "lisp.h" -#include "nt.h" +#include "w32.h" +#include "w32heap.h" #include "systime.h" #include "syswait.h" #include "process.h" - -#ifndef SYS_SIGLIST_DECLARED -extern char *sys_siglist[]; -#endif +#include "syssignal.h" +#include "w32term.h" + +/* Control whether spawnve quotes arguments as necessary to ensure + correct parsing by child process. Because not all uses of spawnve + are careful about constructing argv arrays, we make this behaviour + conditional (off by default). */ +Lisp_Object Vw32_quote_process_args; + +/* Control whether create_child causes the process' window to be + hidden. The default is nil. */ +Lisp_Object Vw32_start_process_show_window; + +/* Control whether create_child causes the process to inherit Emacs' + console window, or be given a new one of its own. The default is + nil, to allow multiple DOS programs to run on Win95. Having separate + consoles also allows Emacs to cleanly terminate process groups. */ +Lisp_Object Vw32_start_process_share_console; + +/* Control whether create_child cause the process to inherit Emacs' + error mode setting. The default is t, to minimize the possibility of + subprocesses blocking when accessing unmounted drives. */ +Lisp_Object Vw32_start_process_inherit_error_mode; + +/* Time to sleep before reading from a subprocess output pipe - this + avoids the inefficiency of frequently reading small amounts of data. + This is primarily necessary for handling DOS processes on Windows 95, + but is useful for W32 processes on both Windows 95 and NT as well. */ +Lisp_Object Vw32_pipe_read_delay; + +/* Control conversion of upper case file names to lower case. + nil means no, t means yes. */ +Lisp_Object Vw32_downcase_file_names; + +/* Control whether stat() attempts to generate fake but hopefully + "accurate" inode values, by hashing the absolute truenames of files. + This should detect aliasing between long and short names, but still + allows the possibility of hash collisions. */ +Lisp_Object Vw32_generate_fake_inodes; + +/* Control whether stat() attempts to determine file type and link count + exactly, at the expense of slower operation. Since true hard links + are supported on NTFS volumes, this is only relevant on NT. */ +Lisp_Object Vw32_get_true_file_attributes; + +Lisp_Object Qhigh, Qlow; #ifdef EMACSDEBUG void _DebPrint (const char *fmt, ...) @@ -214,8 +261,8 @@ reader_thread (void *arg) cp = (child_process *)arg; /* We have to wait for the go-ahead before we can start */ - if (cp == NULL || - WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0) + if (cp == NULL + || WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0) return 1; for (;;) @@ -251,13 +298,22 @@ reader_thread (void *arg) return 0; } +/* To avoid Emacs changing directory, we just record here the directory + the new process should start in. This is set just before calling + sys_spawnve, and is not generally valid at any other time. */ +static char * process_dir; + static BOOL -create_child (char *exe, char *cmdline, char *env, +create_child (char *exe, char *cmdline, char *env, int is_gui_app, int * pPid, child_process *cp) { STARTUPINFO start; SECURITY_ATTRIBUTES sec_attrs; +#if 0 SECURITY_DESCRIPTOR sec_desc; +#endif + DWORD flags; + char dir[ MAXPATHLEN ]; if (cp == NULL) abort (); @@ -265,7 +321,10 @@ create_child (char *exe, char *cmdline, char *env, start.cb = sizeof (start); #ifdef HAVE_NTGUI - start.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW; + if (NILP (Vw32_start_process_show_window) && !is_gui_app) + start.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW; + else + start.dwFlags = STARTF_USESTDHANDLES; start.wShowWindow = SW_HIDE; start.hStdInput = GetStdHandle (STD_INPUT_HANDLE); @@ -273,19 +332,27 @@ create_child (char *exe, char *cmdline, char *env, start.hStdError = GetStdHandle (STD_ERROR_HANDLE); #endif /* HAVE_NTGUI */ +#if 0 /* Explicitly specify no security */ if (!InitializeSecurityDescriptor (&sec_desc, SECURITY_DESCRIPTOR_REVISION)) goto EH_Fail; if (!SetSecurityDescriptorDacl (&sec_desc, TRUE, NULL, FALSE)) goto EH_Fail; +#endif sec_attrs.nLength = sizeof (sec_attrs); - sec_attrs.lpSecurityDescriptor = &sec_desc; + sec_attrs.lpSecurityDescriptor = NULL /* &sec_desc */; sec_attrs.bInheritHandle = FALSE; + strcpy (dir, process_dir); + unixtodos_filename (dir); + + flags = (!NILP (Vw32_start_process_share_console) + ? CREATE_NEW_PROCESS_GROUP + : CREATE_NEW_CONSOLE); + if (NILP (Vw32_start_process_inherit_error_mode)) + flags |= CREATE_DEFAULT_ERROR_MODE; if (!CreateProcess (exe, cmdline, &sec_attrs, NULL, TRUE, - CREATE_NEW_PROCESS_GROUP, - env, NULL, - &start, &cp->procinfo)) + flags, env, dir, &start, &cp->procinfo)) goto EH_Fail; cp->pid = (int) cp->procinfo.dwProcessId; @@ -297,11 +364,10 @@ create_child (char *exe, char *cmdline, char *env, /* pid must fit in a Lisp_Int */ cp->pid = (cp->pid & VALMASK); - *pPid = cp->pid; - + return TRUE; - + EH_Fail: DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError());); return FALSE; @@ -354,9 +420,11 @@ reap_subprocess (child_process *cp) if (cp->procinfo.hProcess) { /* Reap the process */ - if (WaitForSingleObject (cp->procinfo.hProcess, INFINITE) != WAIT_OBJECT_0) - DebPrint (("reap_subprocess.WaitForSingleObject (process) failed " - "with %lu for fd %ld\n", GetLastError (), cp->fd)); +#ifdef FULL_DEBUG + /* Process should have already died before we are called. */ + if (WaitForSingleObject (cp->procinfo.hProcess, 0) != WAIT_OBJECT_0) + DebPrint (("reap_subprocess: child fpr fd %d has not died yet!", cp->fd)); +#endif CloseHandle (cp->procinfo.hProcess); cp->procinfo.hProcess = NULL; CloseHandle (cp->procinfo.hThread); @@ -392,6 +460,8 @@ sys_wait (int *status) cps[nh] = dead_child; if (!wait_hnd[nh]) abort (); nh++; + active = 0; + goto get_result; } else { @@ -401,7 +471,6 @@ sys_wait (int *status) { wait_hnd[nh] = cp->procinfo.hProcess; cps[nh] = cp; - if (!wait_hnd[nh]) abort (); nh++; } } @@ -412,30 +481,33 @@ sys_wait (int *status) errno = ECHILD; return -1; } - - active = WaitForMultipleObjects (nh, wait_hnd, FALSE, INFINITE); + + do + { + /* Check for quit about once a second. */ + QUIT; + active = WaitForMultipleObjects (nh, wait_hnd, FALSE, 1000); + } while (active == WAIT_TIMEOUT); + if (active == WAIT_FAILED) { errno = EBADF; return -1; } - else if (active == WAIT_TIMEOUT) - { - /* Should never happen */ - errno = EINVAL; - return -1; - } - else if (active >= WAIT_OBJECT_0 && - active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS) + else if (active >= WAIT_OBJECT_0 + && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS) { active -= WAIT_OBJECT_0; } - else if (active >= WAIT_ABANDONED_0 && - active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS) + else if (active >= WAIT_ABANDONED_0 + && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS) { active -= WAIT_ABANDONED_0; } - + else + abort (); + +get_result: if (!GetExitCodeProcess (wait_hnd[active], &retval)) { DebPrint (("Wait.GetExitCodeProcess failed with %lu\n", @@ -479,13 +551,11 @@ sys_wait (int *status) else if (WIFSIGNALED (retval)) { int code = WTERMSIG (retval); - char *signame = 0; - - if (code < NSIG) - { - /* Suppress warning if the table has const char *. */ - signame = (char *) sys_siglist[code]; - } + char *signame; + + synchronize_system_messages_locale (); + signame = strsignal (code); + if (signame == 0) signame = "unknown"; @@ -494,13 +564,151 @@ sys_wait (int *status) reap_subprocess (cp); } + + reap_subprocess (cp); return pid; } -/* We pass our process ID to our children by setting up an environment - variable in their environment. */ -char ppid_env_var_buffer[64]; +void +w32_executable_type (char * filename, int * is_dos_app, int * is_cygnus_app, int * is_gui_app) +{ + file_data executable; + char * p; + + /* Default values in case we can't tell for sure. */ + *is_dos_app = FALSE; + *is_cygnus_app = FALSE; + *is_gui_app = FALSE; + + if (!open_input_file (&executable, filename)) + return; + + p = strrchr (filename, '.'); + + /* We can only identify DOS .com programs from the extension. */ + if (p && stricmp (p, ".com") == 0) + *is_dos_app = TRUE; + else if (p && (stricmp (p, ".bat") == 0 + || stricmp (p, ".cmd") == 0)) + { + /* A DOS shell script - it appears that CreateProcess is happy to + accept this (somewhat surprisingly); presumably it looks at + COMSPEC to determine what executable to actually invoke. + Therefore, we have to do the same here as well. */ + /* Actually, I think it uses the program association for that + extension, which is defined in the registry. */ + p = egetenv ("COMSPEC"); + if (p) + w32_executable_type (p, is_dos_app, is_cygnus_app, is_gui_app); + } + else + { + /* Look for DOS .exe signature - if found, we must also check that + it isn't really a 16- or 32-bit Windows exe, since both formats + start with a DOS program stub. Note that 16-bit Windows + executables use the OS/2 1.x format. */ + + IMAGE_DOS_HEADER * dos_header; + IMAGE_NT_HEADERS * nt_header; + + dos_header = (PIMAGE_DOS_HEADER) executable.file_base; + if (dos_header->e_magic != IMAGE_DOS_SIGNATURE) + goto unwind; + + nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew); + + if ((char *) nt_header > (char *) dos_header + executable.size) + { + /* Some dos headers (pkunzip) have bogus e_lfanew fields. */ + *is_dos_app = TRUE; + } + else if (nt_header->Signature != IMAGE_NT_SIGNATURE + && LOWORD (nt_header->Signature) != IMAGE_OS2_SIGNATURE) + { + *is_dos_app = TRUE; + } + else if (nt_header->Signature == IMAGE_NT_SIGNATURE) + { + /* Look for cygwin.dll in DLL import list. */ + IMAGE_DATA_DIRECTORY import_dir = + nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT]; + IMAGE_IMPORT_DESCRIPTOR * imports; + IMAGE_SECTION_HEADER * section; + + section = rva_to_section (import_dir.VirtualAddress, nt_header); + imports = RVA_TO_PTR (import_dir.VirtualAddress, section, executable); + + for ( ; imports->Name; imports++) + { + char * dllname = RVA_TO_PTR (imports->Name, section, executable); + + /* The exact name of the cygwin dll has changed with + various releases, but hopefully this will be reasonably + future proof. */ + if (strncmp (dllname, "cygwin", 6) == 0) + { + *is_cygnus_app = TRUE; + break; + } + } + + /* Check whether app is marked as a console or windowed (aka + GUI) app. Accept Posix and OS2 subsytem apps as console + apps. */ + *is_gui_app = (nt_header->OptionalHeader.Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI); + } + } + +unwind: + close_file_data (&executable); +} + +int +compare_env (const void *strp1, const void *strp2) +{ + const char *str1 = *(const char **)strp1, *str2 = *(const char **)strp2; + + while (*str1 && *str2 && *str1 != '=' && *str2 != '=') + { + /* Sort order in command.com/cmd.exe is based on uppercasing + names, so do the same here. */ + if (toupper (*str1) > toupper (*str2)) + return 1; + else if (toupper (*str1) < toupper (*str2)) + return -1; + str1++, str2++; + } + + if (*str1 == '=' && *str2 == '=') + return 0; + else if (*str1 == '=') + return -1; + else + return 1; +} + +void +merge_and_sort_env (char **envp1, char **envp2, char **new_envp) +{ + char **optr, **nptr; + int num; + + nptr = new_envp; + optr = envp1; + while (*optr) + *nptr++ = *optr++; + num = optr - envp1; + + optr = envp2; + while (*optr) + *nptr++ = *optr++; + num += optr - envp2; + + qsort (new_envp, num, sizeof (char *), compare_env); + + *nptr = NULL; +} /* When a new child process is created we need to register it in our list, so intercept spawn requests. */ @@ -509,10 +717,18 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) { Lisp_Object program, full; char *cmdline, *env, *parg, **targ; - int arglen; + int arglen, numenv; int pid; child_process *cp; - + int is_dos_app, is_cygnus_app, is_gui_app; + int do_quoting = 0; + char escape_char; + /* We pass our process ID to our children by setting up an environment + variable in their environment. */ + char ppid_env_var_buffer[64]; + char *extra_env[] = {ppid_env_var_buffer, NULL}; + char *sepchars = " \t"; + /* We don't care about the other modes */ if (mode != _P_NOWAIT) { @@ -528,61 +744,140 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) full = Qnil; GCPRO1 (program); - openp (Vexec_path, program, EXEC_SUFFIXES, &full, 1); + openp (Vexec_path, program, Vexec_suffixes, &full, 1); UNGCPRO; if (NILP (full)) { errno = EINVAL; return -1; } - cmdname = XSTRING (full)->data; - argv[0] = cmdname; + program = full; } - /* make sure cmdname is in DOS format */ - strcpy (cmdname = alloca (strlen (cmdname) + 1), argv[0]); + /* make sure argv[0] and cmdname are both in DOS format */ + cmdname = XSTRING (program)->data; unixtodos_filename (cmdname); argv[0] = cmdname; + + /* Determine whether program is a 16-bit DOS executable, or a w32 + executable that is implicitly linked to the Cygnus dll (implying it + was compiled with the Cygnus GNU toolchain and hence relies on + cygwin.dll to parse the command line - we use this to decide how to + escape quote chars in command line args that must be quoted). + + Also determine whether it is a GUI app, so that we don't hide its + initial window unless specifically requested. */ + w32_executable_type (cmdname, &is_dos_app, &is_cygnus_app, &is_gui_app); + + /* 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 = alloca (MAXPATHLEN); + if (egetenv ("CMDPROXY")) + strcpy (cmdname, egetenv ("CMDPROXY")); + else + { + strcpy (cmdname, XSTRING (Vinvocation_directory)->data); + strcat (cmdname, "cmdproxy.exe"); + } + unixtodos_filename (cmdname); + } /* we have to do some conjuring here to put argv and envp into the form CreateProcess wants... argv needs to be a space separated/null terminated list of parameters, and envp is a null separated/double-null terminated list of parameters. - Additionally, zero-length args and args containing whitespace need - to be wrapped in double quotes. Args containing embedded double - quotes (as opposed to enclosing quotes, which we leave alone) are - usually illegal (most Win32 programs do not implement escaping of - double quotes - sad but true, at least for programs compiled with - MSVC), but we will escape quotes anyway for those programs that can - handle it. The Win32 gcc library from Cygnus doubles quotes to - escape them, so we will use that convention. - - Since I have no idea how large argv and envp are likely to be - we figure out list lengths on the fly and allocate them. */ + Additionally, zero-length args and args containing whitespace or + quote chars need to be wrapped in double quotes - for this to work, + embedded quotes need to be escaped as well. The aim is to ensure + the child process reconstructs the argv array we start with + exactly, so we treat quotes at the beginning and end of arguments + as embedded quotes. + + The w32 GNU-based library from Cygnus doubles quotes to escape + them, while MSVC uses backslash for escaping. (Actually the MSVC + startup code does attempt to recognise doubled quotes and accept + them, but gets it wrong and ends up requiring three quotes to get a + single embedded quote!) So by default we decide whether to use + quote or backslash as the escape character based on whether the + binary is apparently a Cygnus compiled app. + + Note that using backslash to escape embedded quotes requires + additional special handling if an embedded quote is already + preceeded by backslash, or if an arg requiring quoting ends with + backslash. In such cases, the run of escape characters needs to be + doubled. For consistency, we apply this special handling as long + as the escape character is not quote. + + Since we have no idea how large argv and envp are likely to be we + figure out list lengths on the fly and allocate them. */ + + if (!NILP (Vw32_quote_process_args)) + { + do_quoting = 1; + /* Override escape char by binding w32-quote-process-args to + desired character, or use t for auto-selection. */ + if (INTEGERP (Vw32_quote_process_args)) + escape_char = XINT (Vw32_quote_process_args); + else + escape_char = is_cygnus_app ? '"' : '\\'; + } + /* Cygwin apps needs quoting a bit more often */ + if (escape_char == '"') + sepchars = "\r\n\t\f '"; + /* do argv... */ arglen = 0; targ = argv; while (*targ) { char * p = *targ; - int add_quotes = 0; + int need_quotes = 0; + int escape_char_run = 0; if (*p == 0) - add_quotes = 1; - while (*p) - if (*p++ == '"') - { - /* allow for embedded quotes to be doubled - we won't - actually double quotes that aren't embedded though */ + need_quotes = 1; + for ( ; *p; p++) + { + if (escape_char == '"' && *p == '\\') + /* If it's a Cygwin app, \ needs to be escaped. */ arglen++; - add_quotes = 1; - } - else if (*p == ' ' || *p == '\t') - add_quotes = 1; - if (add_quotes) - arglen += 2; + else if (*p == '"') + { + /* allow for embedded quotes to be escaped */ + arglen++; + need_quotes = 1; + /* handle the case where the embedded quote is already escaped */ + if (escape_char_run > 0) + { + /* To preserve the arg exactly, we need to double the + preceding escape characters (plus adding one to + escape the quote character itself). */ + arglen += escape_char_run; + } + } + else if (strchr (sepchars, *p) != NULL) + { + need_quotes = 1; + } + + if (*p == escape_char && escape_char != '"') + escape_char_run++; + else + escape_char_run = 0; + } + if (need_quotes) + { + arglen += 2; + /* handle the case where the arg ends with an escape char - we + must not let the enclosing quote be escaped. */ + if (escape_char_run > 0) + arglen += escape_char_run; + } arglen += strlen (*targ++) + 1; } cmdline = alloca (arglen); @@ -591,22 +886,20 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) while (*targ) { char * p = *targ; - int add_quotes = 0; + int need_quotes = 0; if (*p == 0) - add_quotes = 1; -#if 0 - /* Unfortunately, this causes more problems than it solves, - because argv arrays are not always carefully constructed. - grep, for instance, passes the whole command line as one - argument, so it becomes impossible to pass a regexp which - contains spaces. */ - for ( ; *p; p++) - if (*p == ' ' || *p == '\t' || *p == '"') - add_quotes = 1; -#endif - if (add_quotes) + need_quotes = 1; + + if (do_quoting) + { + for ( ; *p; p++) + if ((strchr (sepchars, *p) != NULL) || *p == '"') + need_quotes = 1; + } + if (need_quotes) { + int escape_char_run = 0; char * first; char * last; @@ -614,12 +907,49 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) first = p; last = p + strlen (p) - 1; *parg++ = '"'; +#if 0 + /* This version does not escape quotes if they occur at the + beginning or end of the arg - this could lead to incorrect + behaviour when the arg itself represents a command line + containing quoted args. I believe this was originally done + as a hack to make some things work, before + `w32-quote-process-args' was added. */ while (*p) { if (*p == '"' && p > first && p < last) - *parg++ = '"'; /* double up embedded quotes only */ + *parg++ = escape_char; /* escape embedded quotes */ *parg++ = *p++; } +#else + for ( ; *p; p++) + { + if (*p == '"') + { + /* double preceding escape chars if any */ + while (escape_char_run > 0) + { + *parg++ = escape_char; + escape_char_run--; + } + /* escape all quote chars, even at beginning or end */ + *parg++ = escape_char; + } + else if (escape_char == '"' && *p == '\\') + *parg++ = '\\'; + *parg++ = *p; + + if (*p == escape_char && escape_char != '"') + escape_char_run++; + else + escape_char_run = 0; + } + /* double escape chars before enclosing quote */ + while (escape_char_run > 0) + { + *parg++ = escape_char; + escape_char_run--; + } +#endif *parg++ = '"'; } else @@ -635,16 +965,24 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) /* and envp... */ arglen = 1; targ = envp; + numenv = 1; /* for end null */ while (*targ) { arglen += strlen (*targ++) + 1; + numenv++; } - sprintf (ppid_env_var_buffer, "__PARENT_PROCESS_ID=%d", + /* extra env vars... */ + sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d", GetCurrentProcessId ()); arglen += strlen (ppid_env_var_buffer) + 1; + numenv++; + + /* merge env passed in and extra env into one, and sort it. */ + targ = (char **) alloca (numenv * sizeof (char *)); + merge_and_sort_env (envp, extra_env, targ); + /* concatenate env entries. */ env = alloca (arglen); - targ = envp; parg = env; while (*targ) { @@ -652,8 +990,6 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) parg += strlen (*targ++); *parg++ = '\0'; } - strcpy (parg, ppid_env_var_buffer); - parg += strlen (ppid_env_var_buffer); *parg++ = '\0'; *parg = '\0'; @@ -665,7 +1001,7 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) } /* Now create the process. */ - if (!create_child (cmdname, cmdline, env, &pid, cp)) + if (!create_child (cmdname, cmdline, env, is_gui_app, &pid, cp)) { delete_child (cp); errno = ENOEXEC; @@ -678,10 +1014,27 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) /* Emulate the select call Wait for available input on any of the given rfds, or timeout if a timeout is given and no input is detected - wfds and efds are not supported and must be NULL. */ + wfds and efds are not supported and must be NULL. + + For simplicity, we detect the death of child processes here and + synchronously call the SIGCHLD handler. Since it is possible for + children to be created without a corresponding pipe handle from which + to read output, we wait separately on the process handles as well as + the char_avail events for each process pipe. We only call + wait/reap_process when the process actually terminates. + + To reduce the number of places in which Emacs can be hung such that + C-g is not able to interrupt it, we always wait on interrupt_handle + (which is signalled by the input thread when C-g is detected). If we + detect that we were woken up by C-g, we return -1 with errno set to + EINTR as on Unix. */ /* From ntterm.c */ extern HANDLE keyboard_handle; + +/* From w32xfns.c */ +extern HANDLE interrupt_handle; + /* From process.c */ extern int proc_buffered_char[]; @@ -690,17 +1043,19 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds, EMACS_TIME *timeout) { SELECT_TYPE orfds; - DWORD timeout_ms; - int i, nh, nr; + DWORD timeout_ms, start_time; + int i, nh, nc, nr; DWORD active; - child_process *cp; - HANDLE wait_hnd[MAXDESC]; + child_process *cp, *cps[MAX_CHILDREN]; + HANDLE wait_hnd[MAXDESC + MAX_CHILDREN]; int fdindex[MAXDESC]; /* mapping from wait handles back to descriptors */ + timeout_ms = timeout ? (timeout->tv_sec * 1000 + timeout->tv_usec / 1000) : INFINITE; + /* If the descriptor sets are NULL but timeout isn't, then just Sleep. */ if (rfds == NULL && wfds == NULL && efds == NULL && timeout != NULL) { - Sleep (timeout->tv_sec * 1000 + timeout->tv_usec / 1000); + Sleep (timeout_ms); return 0; } @@ -714,9 +1069,13 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds, orfds = *rfds; FD_ZERO (rfds); nr = 0; + + /* Always wait on interrupt_handle, to detect C-g (quit). */ + wait_hnd[0] = interrupt_handle; + fdindex[0] = -1; - /* Build a list of handles to wait on. */ - nh = 0; + /* Build a list of pipe handles to wait on. */ + nh = 1; for (i = 0; i < nfds; i++) if (FD_ISSET (i, &orfds)) { @@ -767,8 +1126,8 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds, have changed) should indicate read has completed but has not been acknowledged. */ current_status = cp->status; - if (current_status != STATUS_READ_SUCCEEDED && - current_status != STATUS_READ_FAILED) + if (current_status != STATUS_READ_SUCCEEDED + && current_status != STATUS_READ_FAILED) DebPrint (("char_avail set, but read not completed: status %d\n", current_status)); } @@ -779,10 +1138,10 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds, that read has completed but event wasn't yet signalled when we tested it (because a context switch occurred or if running on separate CPUs). */ - if (current_status != STATUS_READ_READY && - current_status != STATUS_READ_IN_PROGRESS && - current_status != STATUS_READ_SUCCEEDED && - current_status != STATUS_READ_FAILED) + if (current_status != STATUS_READ_READY + && current_status != STATUS_READ_IN_PROGRESS + && current_status != STATUS_READ_SUCCEEDED + && current_status != STATUS_READ_FAILED) DebPrint (("char_avail reset, but read status is bad: %d\n", current_status)); } @@ -799,34 +1158,61 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds, else { /* Unable to find something to wait on for this fd, skip */ + + /* Note that this is not a fatal error, and can in fact + happen in unusual circumstances. Specifically, if + sys_spawnve fails, eg. because the program doesn't + exist, and debug-on-error is t so Fsignal invokes a + nested input loop, then the process output pipe is + still included in input_wait_mask with no child_proc + associated with it. (It is removed when the debugger + exits the nested input loop and the error is thrown.) */ + DebPrint (("sys_select: fd %ld is invalid! ignoring\n", i)); - abort (); } } } + +count_children: + /* Add handles of child processes. */ + nc = 0; + for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--) + /* Some child_procs might be sockets; ignore them. Also some + children may have died already, but we haven't finished reading + the process output; ignore them too. */ + if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess + && (cp->fd < 0 + || (fd_info[cp->fd].flags & FILE_SEND_SIGCHLD) == 0 + || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0) + ) + { + wait_hnd[nh + nc] = cp->procinfo.hProcess; + cps[nc] = cp; + nc++; + } /* Nothing to look for, so we didn't find anything */ - if (nh == 0) + if (nh + nc == 0) { if (timeout) - Sleep (timeout->tv_sec * 1000 + timeout->tv_usec / 1000); + Sleep (timeout_ms); return 0; } - /* - Wait for input - If a child process dies while this is waiting, its pipe will break - so the reader thread will signal an error condition, thus, the wait - will wake up - */ - timeout_ms = timeout ? (timeout->tv_sec * 1000 + timeout->tv_usec / 1000) : INFINITE; + start_time = GetTickCount (); - active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms); + /* Wait for input or child death to be signalled. If user input is + allowed, then also accept window messages. */ + if (FD_ISSET (0, &orfds)) + active = MsgWaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms, + QS_ALLINPUT); + else + active = WaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms); if (active == WAIT_FAILED) { DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n", - nh, timeout_ms, GetLastError ())); + nh + nc, timeout_ms, GetLastError ())); /* don't return EBADF - this causes wait_reading_process_input to abort; WAIT_FAILED is returned when single-stepping under Windows 95 after switching thread focus in debugger, and @@ -838,16 +1224,18 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds, { return 0; } - else if (active >= WAIT_OBJECT_0 && - active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS) + else if (active >= WAIT_OBJECT_0 + && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS) { active -= WAIT_OBJECT_0; } - else if (active >= WAIT_ABANDONED_0 && - active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS) + else if (active >= WAIT_ABANDONED_0 + && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS) { active -= WAIT_ABANDONED_0; } + else + abort (); /* Loop over all handles after active (now officially documented as being the first signalled handle in the array). We do this to @@ -855,68 +1243,120 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds, processed - otherwise higher numbered channels could be starved. */ do { - if (fdindex[active] == 0) + if (active == nh + nc) { - /* Keyboard input available */ - FD_SET (0, rfds); - nr++; + /* There are messages in the lisp thread's queue; we must + drain the queue now to ensure they are processed promptly, + because if we don't do so, we will not be woken again until + further messages arrive. + + NB. If ever we allow window message procedures to callback + into lisp, we will need to ensure messages are dispatched + at a safe time for lisp code to be run (*), and we may also + want to provide some hooks in the dispatch loop to cater + for modeless dialogs created by lisp (ie. to register + window handles to pass to IsDialogMessage). + + (*) Note that MsgWaitForMultipleObjects above is an + internal dispatch point for messages that are sent to + windows created by this thread. */ + drain_message_queue (); } - else + else if (active >= nh) { - /* must be a socket or pipe */ - int current_status; + cp = cps[active - nh]; - cp = fd_info[ fdindex[active] ].cp; + /* We cannot always signal SIGCHLD immediately; if we have not + finished reading the process output, we must delay sending + SIGCHLD until we do. */ - /* Read ahead should have completed, either succeeding or failing. */ - FD_SET (fdindex[active], rfds); - nr++; - current_status = cp->status; - if (current_status != STATUS_READ_SUCCEEDED) + if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_AT_EOF) == 0) + fd_info[cp->fd].flags |= FILE_SEND_SIGCHLD; + /* SIG_DFL for SIGCHLD is ignore */ + else if (sig_handlers[SIGCHLD] != SIG_DFL && + sig_handlers[SIGCHLD] != SIG_IGN) { - if (current_status != STATUS_READ_FAILED) - DebPrint (("internal error: subprocess pipe signalled " - "at the wrong time (status %d)\n!", current_status)); - - /* The child_process entry for a socket or pipe will be - freed when the last descriptor using it is closed; for - pipes, we call the SIGCHLD handler. */ - if (fd_info[ fdindex[active] ].flags & FILE_PIPE) - { - /* The SIGCHLD handler will do a Wait so we know it won't - return until the process is dead - We force Wait to only wait for this process to avoid it - picking up other children that happen to be dead but that - we haven't noticed yet - SIG_DFL for SIGCHLD is ignore? */ - if (sig_handlers[SIGCHLD] != SIG_DFL && - sig_handlers[SIGCHLD] != SIG_IGN) - { #ifdef FULL_DEBUG - DebPrint (("select calling SIGCHLD handler for pid %d\n", - cp->pid)); + DebPrint (("select calling SIGCHLD handler for pid %d\n", + cp->pid)); #endif - dead_child = cp; - sig_handlers[SIGCHLD] (SIGCHLD); - dead_child = NULL; - } - - /* Clean up the child process entry in the table */ - reap_subprocess (cp); - } + dead_child = cp; + sig_handlers[SIGCHLD] (SIGCHLD); + dead_child = NULL; } } + else if (fdindex[active] == -1) + { + /* Quit (C-g) was detected. */ + errno = EINTR; + return -1; + } + else if (fdindex[active] == 0) + { + /* Keyboard input available */ + FD_SET (0, rfds); + nr++; + } + else + { + /* must be a socket or pipe - read ahead should have + completed, either succeeding or failing. */ + FD_SET (fdindex[active], rfds); + nr++; + } - /* Test for input on remaining channels. */ - while (++active < nh) + /* Even though wait_reading_process_output only reads from at most + one channel, we must process all channels here so that we reap + all children that have died. */ + while (++active < nh + nc) if (WaitForSingleObject (wait_hnd[active], 0) == WAIT_OBJECT_0) break; - } while (active < nh); + } while (active < nh + nc); + + /* If no input has arrived and timeout hasn't expired, wait again. */ + if (nr == 0) + { + DWORD elapsed = GetTickCount () - start_time; + + if (timeout_ms > elapsed) /* INFINITE is MAX_UINT */ + { + if (timeout_ms != INFINITE) + timeout_ms -= elapsed; + goto count_children; + } + } return nr; } /* Substitute for certain kill () operations */ + +static BOOL CALLBACK +find_child_console (HWND hwnd, LPARAM arg) +{ + child_process * cp = (child_process *) arg; + DWORD thread_id; + DWORD process_id; + + thread_id = GetWindowThreadProcessId (hwnd, &process_id); + if (process_id == cp->procinfo.dwProcessId) + { + char window_class[32]; + + GetClassName (hwnd, window_class, sizeof (window_class)); + if (strcmp (window_class, + (os_subtype == OS_WIN95) + ? "tty" + : "ConsoleWindowClass") == 0) + { + cp->hwnd = hwnd; + return FALSE; + } + } + /* keep looking */ + return TRUE; +} + int sys_kill (int pid, int sig) { @@ -947,25 +1387,140 @@ sys_kill (int pid, int sig) { proc_hand = cp->procinfo.hProcess; pid = cp->procinfo.dwProcessId; + + /* Try to locate console window for process. */ + EnumWindows (find_child_console, (LPARAM) cp); } - if (sig == SIGINT) + if (sig == SIGINT || sig == SIGQUIT) { + if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd) + { + BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0); + /* Fake Ctrl-C for SIGINT, and Ctrl-Break for SIGQUIT. */ + BYTE vk_break_code = (sig == SIGINT) ? 'C' : VK_CANCEL; + BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0); + HWND foreground_window; + + if (break_scan_code == 0) + { + /* Fake Ctrl-C for SIGQUIT if we can't manage Ctrl-Break. */ + vk_break_code = 'C'; + break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0); + } + + foreground_window = GetForegroundWindow (); + if (foreground_window) + { + /* NT 5.0, and apparently also Windows 98, will not allow + a Window to be set to foreground directly without the + user's involvement. The workaround is to attach + ourselves to the thread that owns the foreground + window, since that is the only thread that can set the + foreground window. */ + DWORD foreground_thread, child_thread; + foreground_thread = + GetWindowThreadProcessId (foreground_window, NULL); + if (foreground_thread == GetCurrentThreadId () + || !AttachThreadInput (GetCurrentThreadId (), + foreground_thread, TRUE)) + foreground_thread = 0; + + child_thread = GetWindowThreadProcessId (cp->hwnd, NULL); + if (child_thread == GetCurrentThreadId () + || !AttachThreadInput (GetCurrentThreadId (), + child_thread, TRUE)) + child_thread = 0; + + /* Set the foreground window to the child. */ + if (SetForegroundWindow (cp->hwnd)) + { + /* Generate keystrokes as if user had typed Ctrl-Break or + Ctrl-C. */ + keybd_event (VK_CONTROL, control_scan_code, 0, 0); + keybd_event (vk_break_code, break_scan_code, + (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0); + keybd_event (vk_break_code, break_scan_code, + (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY) + | KEYEVENTF_KEYUP, 0); + keybd_event (VK_CONTROL, control_scan_code, + KEYEVENTF_KEYUP, 0); + + /* Sleep for a bit to give time for Emacs frame to respond + to focus change events (if Emacs was active app). */ + Sleep (100); + + SetForegroundWindow (foreground_window); + } + /* Detach from the foreground and child threads now that + the foreground switching is over. */ + if (foreground_thread) + AttachThreadInput (GetCurrentThreadId (), + foreground_thread, FALSE); + if (child_thread) + AttachThreadInput (GetCurrentThreadId (), + child_thread, FALSE); + } + } /* Ctrl-Break is NT equivalent of SIGINT. */ - if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid)) + else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid)) { DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d " "for pid %lu\n", GetLastError (), pid)); errno = EINVAL; rc = -1; - } + } } else { - /* Kill the process. On Win32 this doesn't kill child processes - so it doesn't work very well for shells which is why it's - not used in every case. */ - if (!TerminateProcess (proc_hand, 0xff)) + if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd) + { +#if 1 + if (os_subtype == OS_WIN95) + { +/* + Another possibility is to try terminating the VDM out-right by + calling the Shell VxD (id 0x17) V86 interface, function #4 + "SHELL_Destroy_VM", ie. + + mov edx,4 + mov ebx,vm_handle + call shellapi + + First need to determine the current VM handle, and then arrange for + the shellapi call to be made from the system vm (by using + Switch_VM_and_callback). + + Could try to invoke DestroyVM through CallVxD. + +*/ +#if 0 + /* On Win95, posting WM_QUIT causes the 16-bit subsystem + to hang when cmdproxy is used in conjunction with + command.com for an interactive shell. Posting + WM_CLOSE pops up a dialog that, when Yes is selected, + does the same thing. TerminateProcess is also less + than ideal in that subprocesses tend to stick around + until the machine is shutdown, but at least it + doesn't freeze the 16-bit subsystem. */ + PostMessage (cp->hwnd, WM_QUIT, 0xff, 0); +#endif + if (!TerminateProcess (proc_hand, 0xff)) + { + DebPrint (("sys_kill.TerminateProcess returned %d " + "for pid %lu\n", GetLastError (), pid)); + errno = EINVAL; + rc = -1; + } + } + else +#endif + PostMessage (cp->hwnd, WM_CLOSE, 0, 0); + } + /* Kill the process. On W32 this doesn't kill child processes + so it doesn't work very well for shells which is why it's not + used in every case. */ + else if (!TerminateProcess (proc_hand, 0xff)) { DebPrint (("sys_kill.TerminateProcess returned %d " "for pid %lu\n", GetLastError (), pid)); @@ -980,7 +1535,7 @@ sys_kill (int pid, int sig) return rc; } -extern int report_file_error (char *, Lisp_Object); +/* extern int report_file_error (char *, Lisp_Object); */ /* The following two routines are used to manipulate stdin, stdout, and stderr of our child processes. @@ -1064,4 +1619,618 @@ reset_standard_handles (int in, int out, int err, HANDLE handles[3]) SetStdHandle (STD_ERROR_HANDLE, handles[2]); } +void +set_process_dir (char * dir) +{ + process_dir = dir; +} + +#ifdef HAVE_SOCKETS + +/* To avoid problems with winsock implementations that work over dial-up + connections causing or requiring a connection to exist while Emacs is + running, Emacs no longer automatically loads winsock on startup if it + is present. Instead, it will be loaded when open-network-stream is + first called. + + To allow full control over when winsock is loaded, we provide these + two functions to dynamically load and unload winsock. This allows + dial-up users to only be connected when they actually need to use + socket services. */ + +/* From nt.c */ +extern HANDLE winsock_lib; +extern BOOL term_winsock (void); +extern BOOL init_winsock (int load_now); + +extern Lisp_Object Vsystem_name; + +DEFUN ("w32-has-winsock", Fw32_has_winsock, Sw32_has_winsock, 0, 1, 0, + doc: /* Test for presence of the Windows socket library `winsock'. +Returns non-nil if winsock support is present, nil otherwise. + +If the optional argument LOAD-NOW is non-nil, the winsock library is +also loaded immediately if not already loaded. If winsock is loaded, +the winsock local hostname is returned (since this may be different from +the value of `system-name' and should supplant it), otherwise t is +returned to indicate winsock support is present. */) + (load_now) + Lisp_Object load_now; +{ + int have_winsock; + + have_winsock = init_winsock (!NILP (load_now)); + if (have_winsock) + { + if (winsock_lib != NULL) + { + /* Return new value for system-name. The best way to do this + is to call init_system_name, saving and restoring the + original value to avoid side-effects. */ + Lisp_Object orig_hostname = Vsystem_name; + Lisp_Object hostname; + + init_system_name (); + hostname = Vsystem_name; + Vsystem_name = orig_hostname; + return hostname; + } + return Qt; + } + return Qnil; +} + +DEFUN ("w32-unload-winsock", Fw32_unload_winsock, Sw32_unload_winsock, + 0, 0, 0, + doc: /* Unload the Windows socket library `winsock' if loaded. +This is provided to allow dial-up socket connections to be disconnected +when no longer needed. Returns nil without unloading winsock if any +socket connections still exist. */) + () +{ + return term_winsock () ? Qt : Qnil; +} + +#endif /* HAVE_SOCKETS */ + + +/* Some miscellaneous functions that are Windows specific, but not GUI + specific (ie. are applicable in terminal or batch mode as well). */ + +/* lifted from fileio.c */ +#define CORRECT_DIR_SEPS(s) \ + do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \ + else unixtodos_filename (s); \ + } while (0) + +DEFUN ("w32-short-file-name", Fw32_short_file_name, Sw32_short_file_name, 1, 1, 0, + doc: /* Return the short file name version (8.3) of the full path of FILENAME. +If FILENAME does not exist, return nil. +All path elements in FILENAME are converted to their short names. */) + (filename) + Lisp_Object filename; +{ + char shortname[MAX_PATH]; + + CHECK_STRING (filename); + + /* first expand it. */ + filename = Fexpand_file_name (filename, Qnil); + + /* luckily, this returns the short version of each element in the path. */ + if (GetShortPathName (XSTRING (filename)->data, shortname, MAX_PATH) == 0) + return Qnil; + + CORRECT_DIR_SEPS (shortname); + + return build_string (shortname); +} + + +DEFUN ("w32-long-file-name", Fw32_long_file_name, Sw32_long_file_name, + 1, 1, 0, + doc: /* Return the long file name version of the full path of FILENAME. +If FILENAME does not exist, return nil. +All path elements in FILENAME are converted to their long names. */) + (filename) + Lisp_Object filename; +{ + char longname[ MAX_PATH ]; + + CHECK_STRING (filename); + + /* first expand it. */ + filename = Fexpand_file_name (filename, Qnil); + + if (!w32_get_long_filename (XSTRING (filename)->data, longname, MAX_PATH)) + return Qnil; + + CORRECT_DIR_SEPS (longname); + + return build_string (longname); +} + +DEFUN ("w32-set-process-priority", Fw32_set_process_priority, + Sw32_set_process_priority, 2, 2, 0, + doc: /* Set the priority of PROCESS to PRIORITY. +If PROCESS is nil, the priority of Emacs is changed, otherwise the +priority of the process whose pid is PROCESS is changed. +PRIORITY should be one of the symbols high, normal, or low; +any other symbol will be interpreted as normal. + +If successful, the return value is t, otherwise nil. */) + (process, priority) + Lisp_Object process, priority; +{ + HANDLE proc_handle = GetCurrentProcess (); + DWORD priority_class = NORMAL_PRIORITY_CLASS; + Lisp_Object result = Qnil; + + CHECK_SYMBOL (priority); + + if (!NILP (process)) + { + DWORD pid; + child_process *cp; + + CHECK_NUMBER (process); + + /* Allow pid to be an internally generated one, or one obtained + externally. This is necessary because real pids on Win95 are + negative. */ + + pid = XINT (process); + cp = find_child_pid (pid); + if (cp != NULL) + pid = cp->procinfo.dwProcessId; + + proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid); + } + + if (EQ (priority, Qhigh)) + priority_class = HIGH_PRIORITY_CLASS; + else if (EQ (priority, Qlow)) + priority_class = IDLE_PRIORITY_CLASS; + + if (proc_handle != NULL) + { + if (SetPriorityClass (proc_handle, priority_class)) + result = Qt; + if (!NILP (process)) + CloseHandle (proc_handle); + } + + return result; +} + + +DEFUN ("w32-get-locale-info", Fw32_get_locale_info, + Sw32_get_locale_info, 1, 2, 0, + doc: /* Return information about the Windows locale LCID. +By default, return a three letter locale code which encodes the default +language as the first two characters, and the country or regionial variant +as the third letter. For example, ENU refers to `English (United States)', +while ENC means `English (Canadian)'. + +If the optional argument LONGFORM is t, the long form of the locale +name is returned, e.g. `English (United States)' instead; if LONGFORM +is a number, it is interpreted as an LCTYPE constant and the corresponding +locale information is returned. + +If LCID (a 16-bit number) is not a valid locale, the result is nil. */) + (lcid, longform) + Lisp_Object lcid, longform; +{ + int got_abbrev; + int got_full; + char abbrev_name[32] = { 0 }; + char full_name[256] = { 0 }; + + CHECK_NUMBER (lcid); + + if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED)) + return Qnil; + + if (NILP (longform)) + { + got_abbrev = GetLocaleInfo (XINT (lcid), + LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP, + abbrev_name, sizeof (abbrev_name)); + if (got_abbrev) + return build_string (abbrev_name); + } + else if (EQ (longform, Qt)) + { + got_full = GetLocaleInfo (XINT (lcid), + LOCALE_SLANGUAGE | LOCALE_USE_CP_ACP, + full_name, sizeof (full_name)); + if (got_full) + return build_string (full_name); + } + else if (NUMBERP (longform)) + { + got_full = GetLocaleInfo (XINT (lcid), + XINT (longform), + full_name, sizeof (full_name)); + if (got_full) + return make_unibyte_string (full_name, got_full); + } + + return Qnil; +} + + +DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id, + Sw32_get_current_locale_id, 0, 0, 0, + doc: /* Return Windows locale id for current locale setting. +This is a numerical value; use `w32-get-locale-info' to convert to a +human-readable form. */) + () +{ + return make_number (GetThreadLocale ()); +} + +DWORD int_from_hex (char * s) +{ + DWORD val = 0; + static char hex[] = "0123456789abcdefABCDEF"; + char * p; + + while (*s && (p = strchr(hex, *s)) != NULL) + { + unsigned digit = p - hex; + if (digit > 15) + digit -= 6; + val = val * 16 + digit; + s++; + } + return val; +} + +/* We need to build a global list, since the EnumSystemLocale callback + function isn't given a context pointer. */ +Lisp_Object Vw32_valid_locale_ids; + +BOOL CALLBACK enum_locale_fn (LPTSTR localeNum) +{ + DWORD id = int_from_hex (localeNum); + Vw32_valid_locale_ids = Fcons (make_number (id), Vw32_valid_locale_ids); + return TRUE; +} + +DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids, + Sw32_get_valid_locale_ids, 0, 0, 0, + doc: /* Return list of all valid Windows locale ids. +Each id is a numerical value; use `w32-get-locale-info' to convert to a +human-readable form. */) + () +{ + Vw32_valid_locale_ids = Qnil; + + EnumSystemLocales (enum_locale_fn, LCID_SUPPORTED); + + Vw32_valid_locale_ids = Fnreverse (Vw32_valid_locale_ids); + return Vw32_valid_locale_ids; +} + + +DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id, Sw32_get_default_locale_id, 0, 1, 0, + doc: /* Return Windows locale id for default locale setting. +By default, the system default locale setting is returned; if the optional +parameter USERP is non-nil, the user default locale setting is returned. +This is a numerical value; use `w32-get-locale-info' to convert to a +human-readable form. */) + (userp) + Lisp_Object userp; +{ + if (NILP (userp)) + return make_number (GetSystemDefaultLCID ()); + return make_number (GetUserDefaultLCID ()); +} + + +DEFUN ("w32-set-current-locale", Fw32_set_current_locale, Sw32_set_current_locale, 1, 1, 0, + doc: /* Make Windows locale LCID be the current locale setting for Emacs. +If successful, the new locale id is returned, otherwise nil. */) + (lcid) + Lisp_Object lcid; +{ + CHECK_NUMBER (lcid); + + if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED)) + return Qnil; + + if (!SetThreadLocale (XINT (lcid))) + return Qnil; + + /* Need to set input thread locale if present. */ + if (dwWindowsThreadId) + /* Reply is not needed. */ + PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0); + + return make_number (GetThreadLocale ()); +} + + +/* We need to build a global list, since the EnumCodePages callback + function isn't given a context pointer. */ +Lisp_Object Vw32_valid_codepages; + +BOOL CALLBACK enum_codepage_fn (LPTSTR codepageNum) +{ + DWORD id = atoi (codepageNum); + Vw32_valid_codepages = Fcons (make_number (id), Vw32_valid_codepages); + return TRUE; +} + +DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages, + Sw32_get_valid_codepages, 0, 0, 0, + doc: /* Return list of all valid Windows codepages. */) + () +{ + Vw32_valid_codepages = Qnil; + + EnumSystemCodePages (enum_codepage_fn, CP_SUPPORTED); + + Vw32_valid_codepages = Fnreverse (Vw32_valid_codepages); + return Vw32_valid_codepages; +} + + +DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage, + Sw32_get_console_codepage, 0, 0, 0, + doc: /* Return current Windows codepage for console input. */) + () +{ + return make_number (GetConsoleCP ()); +} + + +DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage, + Sw32_set_console_codepage, 1, 1, 0, + doc: /* Make Windows codepage CP be the current codepage setting for Emacs. +The codepage setting affects keyboard input and display in tty mode. +If successful, the new CP is returned, otherwise nil. */) + (cp) + Lisp_Object cp; +{ + CHECK_NUMBER (cp); + + if (!IsValidCodePage (XINT (cp))) + return Qnil; + + if (!SetConsoleCP (XINT (cp))) + return Qnil; + + return make_number (GetConsoleCP ()); +} + + +DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage, + Sw32_get_console_output_codepage, 0, 0, 0, + doc: /* Return current Windows codepage for console output. */) + () +{ + return make_number (GetConsoleOutputCP ()); +} + + +DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage, + Sw32_set_console_output_codepage, 1, 1, 0, + doc: /* Make Windows codepage CP be the current codepage setting for Emacs. +The codepage setting affects keyboard input and display in tty mode. +If successful, the new CP is returned, otherwise nil. */) + (cp) + Lisp_Object cp; +{ + CHECK_NUMBER (cp); + + if (!IsValidCodePage (XINT (cp))) + return Qnil; + + if (!SetConsoleOutputCP (XINT (cp))) + return Qnil; + + return make_number (GetConsoleOutputCP ()); +} + + +DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset, + Sw32_get_codepage_charset, 1, 1, 0, + doc: /* Return charset of codepage CP. +Returns nil if the codepage is not valid. */) + (cp) + Lisp_Object cp; +{ + CHARSETINFO info; + + CHECK_NUMBER (cp); + + if (!IsValidCodePage (XINT (cp))) + return Qnil; + + if (TranslateCharsetInfo ((DWORD *) XINT (cp), &info, TCI_SRCCODEPAGE)) + return make_number (info.ciCharset); + + return Qnil; +} + + +DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts, + Sw32_get_valid_keyboard_layouts, 0, 0, 0, + doc: /* Return list of Windows keyboard languages and layouts. +The return value is a list of pairs of language id and layout id. */) + () +{ + int num_layouts = GetKeyboardLayoutList (0, NULL); + HKL * layouts = (HKL *) alloca (num_layouts * sizeof (HKL)); + Lisp_Object obj = Qnil; + + if (GetKeyboardLayoutList (num_layouts, layouts) == num_layouts) + { + while (--num_layouts >= 0) + { + DWORD kl = (DWORD) layouts[num_layouts]; + + obj = Fcons (Fcons (make_number (kl & 0xffff), + make_number ((kl >> 16) & 0xffff)), + obj); + } + } + + return obj; +} + + +DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout, + Sw32_get_keyboard_layout, 0, 0, 0, + doc: /* Return current Windows keyboard language and layout. +The return value is the cons of the language id and the layout id. */) + () +{ + DWORD kl = (DWORD) GetKeyboardLayout (dwWindowsThreadId); + + return Fcons (make_number (kl & 0xffff), + make_number ((kl >> 16) & 0xffff)); +} + + +DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout, + Sw32_set_keyboard_layout, 1, 1, 0, + doc: /* Make LAYOUT be the current keyboard layout for Emacs. +The keyboard layout setting affects interpretation of keyboard input. +If successful, the new layout id is returned, otherwise nil. */) + (layout) + Lisp_Object layout; +{ + DWORD kl; + + CHECK_CONS (layout); + CHECK_NUMBER_CAR (layout); + CHECK_NUMBER_CDR (layout); + + kl = (XINT (XCAR (layout)) & 0xffff) + | (XINT (XCDR (layout)) << 16); + + /* Synchronize layout with input thread. */ + if (dwWindowsThreadId) + { + if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETKEYBOARDLAYOUT, + (WPARAM) kl, 0)) + { + MSG msg; + GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE); + + if (msg.wParam == 0) + return Qnil; + } + } + else if (!ActivateKeyboardLayout ((HKL) kl, 0)) + return Qnil; + + return Fw32_get_keyboard_layout (); +} + + +syms_of_ntproc () +{ + Qhigh = intern ("high"); + Qlow = intern ("low"); + +#ifdef HAVE_SOCKETS + defsubr (&Sw32_has_winsock); + defsubr (&Sw32_unload_winsock); +#endif + defsubr (&Sw32_short_file_name); + defsubr (&Sw32_long_file_name); + defsubr (&Sw32_set_process_priority); + defsubr (&Sw32_get_locale_info); + defsubr (&Sw32_get_current_locale_id); + defsubr (&Sw32_get_default_locale_id); + defsubr (&Sw32_get_valid_locale_ids); + defsubr (&Sw32_set_current_locale); + + defsubr (&Sw32_get_console_codepage); + defsubr (&Sw32_set_console_codepage); + defsubr (&Sw32_get_console_output_codepage); + defsubr (&Sw32_set_console_output_codepage); + defsubr (&Sw32_get_valid_codepages); + defsubr (&Sw32_get_codepage_charset); + + defsubr (&Sw32_get_valid_keyboard_layouts); + defsubr (&Sw32_get_keyboard_layout); + defsubr (&Sw32_set_keyboard_layout); + + DEFVAR_LISP ("w32-quote-process-args", &Vw32_quote_process_args, + doc: /* Non-nil enables quoting of process arguments to ensure correct parsing. +Because Windows does not directly pass argv arrays to child processes, +programs have to reconstruct the argv array by parsing the command +line string. For an argument to contain a space, it must be enclosed +in double quotes or it will be parsed as multiple arguments. + +If the value is a character, that character will be used to escape any +quote characters that appear, otherwise a suitable escape character +will be chosen based on the type of the program. */); + Vw32_quote_process_args = Qt; + + DEFVAR_LISP ("w32-start-process-show-window", + &Vw32_start_process_show_window, + doc: /* When nil, new child processes hide their windows. +When non-nil, they show their window in the method of their choice. +This variable doesn't affect GUI applications, which will never be hidden. */); + Vw32_start_process_show_window = Qnil; + + DEFVAR_LISP ("w32-start-process-share-console", + &Vw32_start_process_share_console, + doc: /* 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 +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. */); + Vw32_start_process_share_console = Qnil; + + DEFVAR_LISP ("w32-start-process-inherit-error-mode", + &Vw32_start_process_inherit_error_mode, + doc: /* When nil, new child processes revert to the default error mode. +When non-nil, they inherit their error mode setting from Emacs, which stops +them blocking when trying to access unmounted drives etc. */); + Vw32_start_process_inherit_error_mode = Qt; + + DEFVAR_INT ("w32-pipe-read-delay", &Vw32_pipe_read_delay, + doc: /* Forced delay before reading subprocess output. +This is done to improve the buffering of subprocess output, by +avoiding the inefficiency of frequently reading small amounts of data. + +If positive, the value is the number of milliseconds to sleep before +reading the subprocess output. If negative, the magnitude is the number +of time slices to wait (effectively boosting the priority of the child +process temporarily). A value of zero disables waiting entirely. */); + Vw32_pipe_read_delay = 50; + + DEFVAR_LISP ("w32-downcase-file-names", &Vw32_downcase_file_names, + doc: /* Non-nil means convert all-upper case file names to lower case. +This applies when performing completions and file name expansion. +Note that the value of this setting also affects remote file names, +so you probably don't want to set to non-nil if you use case-sensitive +filesystems via ange-ftp. */); + Vw32_downcase_file_names = Qnil; + +#if 0 + DEFVAR_LISP ("w32-generate-fake-inodes", &Vw32_generate_fake_inodes, + doc: /* Non-nil means attempt to fake realistic inode values. +This works by hashing the truename of files, and should detect +aliasing between long and short (8.3 DOS) names, but can have +false positives because of hash collisions. Note that determing +the truename of a file can be slow. */); + Vw32_generate_fake_inodes = Qnil; +#endif + + DEFVAR_LISP ("w32-get-true-file-attributes", &Vw32_get_true_file_attributes, + doc: /* Non-nil means determine accurate link count in file-attributes. +This option slows down file-attributes noticeably, so is disabled by +default. Note that it is only useful for files on NTFS volumes, +where hard links are supported. */); + Vw32_get_true_file_attributes = Qnil; +} /* end of ntproc.c */