X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d9709fde351393361e1d8379aa7edea1a195b53c..40aeecadb8fc54c941eb36c6584654627c300c39:/src/w32proc.c diff --git a/src/w32proc.c b/src/w32proc.c index 755336299b..21bdebbbec 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 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -41,9 +41,11 @@ Boston, MA 02111-1307, USA. #include "lisp.h" #include "w32.h" +#include "w32heap.h" #include "systime.h" #include "syswait.h" #include "process.h" +#include "w32term.h" /* Control whether spawnve quotes arguments as necessary to ensure correct parsing by child process. Because not all uses of spawnve @@ -55,22 +57,39 @@ Lisp_Object Vw32_quote_process_args; 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 Win95 and NT as well. */ + 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; -/* Keep track of whether we have already started a DOS program. */ -BOOL dos_process_running; +/* 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; -#ifndef SYS_SIGLIST_DECLARED -extern char *sys_siglist[]; -#endif +/* 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, ...) @@ -237,8 +256,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 (;;) @@ -274,6 +293,11 @@ 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, int * pPid, child_process *cp) @@ -281,6 +305,8 @@ create_child (char *exe, char *cmdline, char *env, STARTUPINFO start; SECURITY_ATTRIBUTES sec_attrs; SECURITY_DESCRIPTOR sec_desc; + DWORD flags; + char dir[ MAXPATHLEN ]; if (cp == NULL) abort (); @@ -308,10 +334,16 @@ create_child (char *exe, char *cmdline, char *env, sec_attrs.lpSecurityDescriptor = &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; @@ -323,11 +355,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; @@ -380,18 +411,15 @@ 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); cp->procinfo.hThread = NULL; - - /* If this was a DOS process, indicate that it is now safe to - start a new one. */ - if (cp->is_dos_process) - dos_process_running = FALSE; } /* For asynchronous children, the child_proc resources will be freed @@ -423,6 +451,8 @@ sys_wait (int *status) cps[nh] = dead_child; if (!wait_hnd[nh]) abort (); nh++; + active = 0; + goto get_result; } else { @@ -432,7 +462,6 @@ sys_wait (int *status) { wait_hnd[nh] = cp->procinfo.hProcess; cps[nh] = cp; - if (!wait_hnd[nh]) abort (); nh++; } } @@ -443,30 +472,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", @@ -510,13 +542,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"; @@ -525,56 +555,98 @@ sys_wait (int *status) reap_subprocess (cp); } + + reap_subprocess (cp); return pid; } -int -w32_is_dos_binary (char * filename) +void +w32_executable_type (char * filename, int * is_dos_app, int * is_cygnus_app) { - IMAGE_DOS_HEADER dos_header; - DWORD signature; - int fd; - int is_dos_binary = FALSE; + file_data executable; + char * p; + + /* Default values in case we can't tell for sure. */ + *is_dos_app = FALSE; + *is_cygnus_app = FALSE; + + if (!open_input_file (&executable, filename)) + return; - fd = open (filename, O_RDONLY | O_BINARY, 0); - if (fd >= 0) + 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)) { - char * p = strrchr (filename, '.'); + /* 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); + } + 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. */ - /* We can only identify DOS .com programs from the extension. */ - if (p && stricmp (p, ".com") == 0) - is_dos_binary = TRUE; - else if (p && stricmp (p, ".bat") == 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. */ - p = getenv ("COMSPEC"); - if (p) - is_dos_binary = w32_is_dos_binary (p); - } - else + 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) { - /* 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. */ - if (read (fd, &dos_header, sizeof (dos_header)) == sizeof (dos_header) - && dos_header.e_magic == IMAGE_DOS_SIGNATURE - && lseek (fd, dos_header.e_lfanew, SEEK_SET) != -1) - { - if (read (fd, &signature, sizeof (signature)) != sizeof (signature) - || (signature != IMAGE_NT_SIGNATURE && - LOWORD (signature) != IMAGE_OS2_SIGNATURE)) - is_dos_binary = TRUE; - } - } - close (fd); + /* 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; + } + } + } } - - return is_dos_binary; + +unwind: + close_file_data (&executable); } int @@ -631,7 +703,9 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) int arglen, numenv; int pid; child_process *cp; - int is_dos_binary; + int is_dos_app, is_cygnus_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]; @@ -659,22 +733,35 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) 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; - /* Check if program is a DOS executable, and if so whether we are - allowed to start it. */ - is_dos_binary = w32_is_dos_binary (cmdname); - if (is_dos_binary && dos_process_running) + /* 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). */ + w32_executable_type (cmdname, &is_dos_app, &is_cygnus_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) { - errno = EAGAIN; - return -1; + 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 @@ -682,17 +769,41 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) 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 W32 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 W32 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 ? '"' : '\\'; + } /* do argv... */ arglen = 0; @@ -700,22 +811,45 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) 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 */ - arglen++; - add_quotes = 1; - } - else if (*p == ' ' || *p == '\t') - add_quotes = 1; - if (add_quotes) - arglen += 2; + need_quotes = 1; + for ( ; *p; p++) + { + 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 (*p == ' ' || *p == '\t') + { + 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); @@ -724,24 +858,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; + need_quotes = 1; - if (!NILP (Vw32_quote_process_args)) + if (do_quoting) { - /* This is conditional because it sometimes causes more - problems than it solves, since argv arrays are not always - carefully constructed. M-x 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; + need_quotes = 1; } - if (add_quotes) + if (need_quotes) { + int escape_char_run = 0; char * first; char * last; @@ -749,12 +879,47 @@ 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; + } + *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 @@ -777,7 +942,7 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) numenv++; } /* extra env vars... */ - sprintf (ppid_env_var_buffer, "__PARENT_PROCESS_ID=%d", + sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d", GetCurrentProcessId ()); arglen += strlen (ppid_env_var_buffer) + 1; numenv++; @@ -812,12 +977,6 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) errno = ENOEXEC; return -1; } - - if (is_dos_binary) - { - cp->is_dos_process = TRUE; - dos_process_running = TRUE; - } return pid; } @@ -825,10 +984,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[]; @@ -837,17 +1013,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; } @@ -861,9 +1039,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)) { @@ -914,8 +1096,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)); } @@ -926,10 +1108,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)); } @@ -946,34 +1128,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 @@ -985,16 +1194,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 @@ -1002,68 +1213,119 @@ 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, child_process * cp) +{ + 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) { @@ -1094,27 +1356,139 @@ 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 (NILP (Vw32_start_process_share_console) && cp && cp->hwnd) + { + BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0); + BYTE vk_break_code = VK_CANCEL; + BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0); + HWND foreground_window; + + if (break_scan_code == 0) + { + /* Fake Ctrl-C 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 { + 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. Also, don't try to terminate DOS processes - (on Win95), because this will hang Emacs. */ - if (!(cp && cp->is_dos_process) - && !TerminateProcess (proc_hand, 0xff)) + used in every case. */ + else if (!TerminateProcess (proc_hand, 0xff)) { DebPrint (("sys_kill.TerminateProcess returned %d " "for pid %lu\n", GetLastError (), pid)); @@ -1129,7 +1503,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. @@ -1213,6 +1587,12 @@ 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 @@ -1281,13 +1661,461 @@ socket connections still exist.") #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, + "Return the short file name version (8.3) of the full path of FILENAME.\n\ +If FILENAME does not exist, return nil.\n\ +All path elements in FILENAME are converted to their short names.") + (filename) + Lisp_Object filename; +{ + char shortname[MAX_PATH]; + + CHECK_STRING (filename, 0); + + /* 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, + "Return the long file name version of the full path of FILENAME.\n\ +If FILENAME does not exist, return nil.\n\ +All path elements in FILENAME are converted to their long names.") + (filename) + Lisp_Object filename; +{ + char longname[ MAX_PATH ]; + + CHECK_STRING (filename, 0); + + /* 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, + "Set the priority of PROCESS to PRIORITY.\n\ +If PROCESS is nil, the priority of Emacs is changed, otherwise the\n\ +priority of the process whose pid is PROCESS is changed.\n\ +PRIORITY should be one of the symbols high, normal, or low;\n\ +any other symbol will be interpreted as normal.\n\ +\n\ +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, 0); + + if (!NILP (process)) + { + DWORD pid; + child_process *cp; + + CHECK_NUMBER (process, 0); + + /* 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, + "Return information about the Windows locale LCID.\n\ +By default, return a three letter locale code which encodes the default\n\ +language as the first two characters, and the country or regionial variant\n\ +as the third letter. For example, ENU refers to `English (United States)',\n\ +while ENC means `English (Canadian)'.\n\ +\n\ +If the optional argument LONGFORM is t, the long form of the locale\n\ +name is returned, e.g. `English (United States)' instead; if LONGFORM\n\ +is a number, it is interpreted as an LCTYPE constant and the corresponding\n\ +locale information is returned.\n\ +\n\ +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, 0); + + 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, + "Return Windows locale id for current locale setting.\n\ +This is a numerical value; use `w32-get-locale-info' to convert to a\n\ +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, + "Return list of all valid Windows locale ids.\n\ +Each id is a numerical value; use `w32-get-locale-info' to convert to a\n\ +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, + "Return Windows locale id for default locale setting.\n\ +By default, the system default locale setting is returned; if the optional\n\ +parameter USERP is non-nil, the user default locale setting is returned.\n\ +This is a numerical value; use `w32-get-locale-info' to convert to a\n\ +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, + "Make Windows locale LCID be the current locale setting for Emacs.\n\ +If successful, the new locale id is returned, otherwise nil.") + (lcid) + Lisp_Object lcid; +{ + CHECK_NUMBER (lcid, 0); + + 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, + "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, + "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, + "Make Windows codepage CP be the current codepage setting for Emacs.\n\ +The codepage setting affects keyboard input and display in tty mode.\n\ +If successful, the new CP is returned, otherwise nil.") + (cp) + Lisp_Object cp; +{ + CHECK_NUMBER (cp, 0); + + 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, + "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, + "Make Windows codepage CP be the current codepage setting for Emacs.\n\ +The codepage setting affects keyboard input and display in tty mode.\n\ +If successful, the new CP is returned, otherwise nil.") + (cp) + Lisp_Object cp; +{ + CHECK_NUMBER (cp, 0); + + 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, + "Return charset of codepage CP.\n\ +Returns nil if the codepage is not valid.") + (cp) + Lisp_Object cp; +{ + CHARSETINFO info; + + CHECK_NUMBER (cp, 0); + + 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, + "Return list of Windows keyboard languages and layouts.\n\ +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, + "Return current Windows keyboard language and layout.\n\ +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, + "Make LAYOUT be the current keyboard layout for Emacs.\n\ +The keyboard layout setting affects interpretation of keyboard input.\n\ +If successful, the new layout id is returned, otherwise nil.") + (layout) + Lisp_Object layout; +{ + DWORD kl; + + CHECK_CONS (layout, 0); + CHECK_NUMBER (XCAR (layout), 0); + CHECK_NUMBER (XCDR (layout), 0); + + 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, "Non-nil enables quoting of process arguments to ensure correct parsing.\n\ @@ -1296,17 +2124,34 @@ programs have to reconstruct the argv array by parsing the command\n\ line string. For an argument to contain a space, it must be enclosed\n\ in double quotes or it will be parsed as multiple arguments.\n\ \n\ -However, the argument list to call-process is not always correctly\n\ -constructed (or arguments have already been quoted), so enabling this\n\ -option may cause unexpected behavior."); - Vw32_quote_process_args = Qnil; +If the value is a character, that character will be used to escape any\n\ +quote characters that appear, otherwise a suitable escape character\n\ +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, - "When nil, processes started via start-process hide their windows.\n\ + "When nil, new child processes hide their windows.\n\ When non-nil, they show their window in the method of their choice."); Vw32_start_process_show_window = Qnil; + DEFVAR_LISP ("w32-start-process-share-console", + &Vw32_start_process_share_console, + "When nil, new child processes are given a new console.\n\ +When non-nil, they share the Emacs console; this has the limitation of\n\ +allowing only only DOS subprocess to run at a time (whether started directly\n\ +or indirectly by Emacs), and preventing Emacs from cleanly terminating the\n\ +subprocess group, but may allow Emacs to interrupt a subprocess that doesn't\n\ +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, + "When nil, new child processes revert to the default error mode.\n\ +When non-nil, they inherit their error mode setting from Emacs, which stops\n\ +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, "Forced delay before reading subprocess output.\n\ This is done to improve the buffering of subprocess output, by\n\ @@ -1322,5 +2167,22 @@ process temporarily). A value of zero disables waiting entirely."); "Non-nil means convert all-upper case file names to lower case.\n\ This applies when performing completions and file name expansion."); Vw32_downcase_file_names = Qnil; + +#if 0 + DEFVAR_LISP ("w32-generate-fake-inodes", &Vw32_generate_fake_inodes, + "Non-nil means attempt to fake realistic inode values.\n\ +This works by hashing the truename of files, and should detect \n\ +aliasing between long and short (8.3 DOS) names, but can have\n\ +false positives because of hash collisions. Note that determing\n\ +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, + "Non-nil means determine accurate link count in file-attributes.\n\ +This option slows down file-attributes noticeably, so is disabled by\n\ +default. Note that it is only useful for files on NTFS volumes,\n\ +where hard links are supported."); + Vw32_get_true_file_attributes = Qnil; } /* end of ntproc.c */