X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/86143765b73911455910d7d034810c97e05d2919..5bcf005469998ba44f13880e68c918bd7bc96053:/src/w32proc.c diff --git a/src/w32proc.c b/src/w32proc.c index ccb47ccc89..7c9aad6b0a 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1,5 +1,5 @@ /* Process support for GNU Emacs on the Microsoft W32 API. - Copyright (C) 1992, 1995 Free Software Foundation, Inc. + Copyright (C) 1992, 1995, 1999, 2000, 2001 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -38,6 +38,10 @@ 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 "w32.h" @@ -45,6 +49,7 @@ Boston, MA 02111-1307, USA. #include "systime.h" #include "syswait.h" #include "process.h" +#include "syssignal.h" #include "w32term.h" /* Control whether spawnve quotes arguments as necessary to ensure @@ -63,6 +68,11 @@ Lisp_Object Vw32_start_process_show_window; 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, @@ -86,10 +96,6 @@ Lisp_Object Vw32_get_true_file_attributes; Lisp_Object Qhigh, Qlow; -#ifndef SYS_SIGLIST_DECLARED -extern char *sys_siglist[]; -#endif - #ifdef EMACSDEBUG void _DebPrint (const char *fmt, ...) { @@ -298,12 +304,15 @@ reader_thread (void *arg) 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 (); @@ -312,7 +321,7 @@ create_child (char *exe, char *cmdline, char *env, start.cb = sizeof (start); #ifdef HAVE_NTGUI - if (NILP (Vw32_start_process_show_window)) + if (NILP (Vw32_start_process_show_window) && !is_gui_app) start.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW; else start.dwFlags = STARTF_USESTDHANDLES; @@ -323,24 +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, - (!NILP (Vw32_start_process_share_console) - ? CREATE_NEW_PROCESS_GROUP - : CREATE_NEW_CONSOLE), - env, dir, - &start, &cp->procinfo)) + flags, env, dir, &start, &cp->procinfo)) goto EH_Fail; cp->pid = (int) cp->procinfo.dwProcessId; @@ -539,13 +551,11 @@ get_result: 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"; @@ -561,7 +571,7 @@ get_result: } void -w32_executable_type (char * filename, int * is_dos_app, int * is_cygnus_app) +w32_executable_type (char * filename, int * is_dos_app, int * is_cygnus_app, int * is_gui_app) { file_data executable; char * p; @@ -569,6 +579,7 @@ w32_executable_type (char * filename, int * is_dos_app, int * is_cygnus_app) /* 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; @@ -589,7 +600,7 @@ w32_executable_type (char * filename, int * is_dos_app, int * is_cygnus_app) extension, which is defined in the registry. */ p = egetenv ("COMSPEC"); if (p) - w32_executable_type (p, is_dos_app, is_cygnus_app); + w32_executable_type (p, is_dos_app, is_cygnus_app, is_gui_app); } else { @@ -632,12 +643,20 @@ w32_executable_type (char * filename, int * is_dos_app, int * is_cygnus_app) { char * dllname = RVA_TO_PTR (imports->Name, section, executable); - if (strcmp (dllname, "cygwin.dll") == 0) + /* 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); } } @@ -646,15 +665,17 @@ unwind: } int -compare_env (const char **strp1, const char **strp2) +compare_env (const void *strp1, const void *strp2) { - const char *str1 = *strp1, *str2 = *strp2; + const char *str1 = *(const char **)strp1, *str2 = *(const char **)strp2; while (*str1 && *str2 && *str1 != '=' && *str2 != '=') { - if (tolower (*str1) > tolower (*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 (tolower (*str1) < tolower (*str2)) + else if (toupper (*str1) < toupper (*str2)) return -1; str1++, str2++; } @@ -699,13 +720,14 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) int arglen, numenv; int pid; child_process *cp; - int is_dos_app, is_cygnus_app; + 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) @@ -722,7 +744,7 @@ 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)) { @@ -741,8 +763,11 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) 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); + 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, @@ -801,6 +826,10 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) 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; @@ -814,7 +843,10 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) need_quotes = 1; for ( ; *p; p++) { - if (*p == '"') + if (escape_char == '"' && *p == '\\') + /* If it's a Cygwin app, \ needs to be escaped. */ + arglen++; + else if (*p == '"') { /* allow for embedded quotes to be escaped */ arglen++; @@ -828,7 +860,7 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) arglen += escape_char_run; } } - else if (*p == ' ' || *p == '\t') + else if (strchr (sepchars, *p) != NULL) { need_quotes = 1; } @@ -862,7 +894,7 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) if (do_quoting) { for ( ; *p; p++) - if (*p == ' ' || *p == '\t' || *p == '"') + if ((strchr (sepchars, *p) != NULL) || *p == '"') need_quotes = 1; } if (need_quotes) @@ -902,6 +934,8 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) /* 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 != '"') @@ -938,7 +972,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++; @@ -967,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; @@ -1165,9 +1199,15 @@ count_children: return 0; } - /* Wait for input or child death to be signalled. */ start_time = GetTickCount (); - active = WaitForMultipleObjects (nh + nc, 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) { @@ -1203,7 +1243,26 @@ count_children: processed - otherwise higher numbered channels could be starved. */ do { - if (active >= nh) + if (active == nh + nc) + { + /* 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 if (active >= nh) { cp = cps[active - nh]; @@ -1273,8 +1332,9 @@ count_children: /* Substitute for certain kill () operations */ static BOOL CALLBACK -find_child_console (HWND hwnd, child_process * cp) +find_child_console (HWND hwnd, LPARAM arg) { + child_process * cp = (child_process *) arg; DWORD thread_id; DWORD process_id; @@ -1332,38 +1392,76 @@ sys_kill (int pid, int sig) 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); - BYTE vk_break_code = VK_CANCEL; + /* 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 if we can't manage Ctrl-Break. */ + /* 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 && SetForegroundWindow (cp->hwnd)) + if (foreground_window) { - /* 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, 0, 0); - keybd_event (vk_break_code, break_scan_code, 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 (10); - - SetForegroundWindow (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. */ else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid)) { @@ -1548,14 +1646,14 @@ 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, - "Test for presence of the Windows socket library `winsock'.\n\ -Returns non-nil if winsock support is present, nil otherwise.\n\ -\n\ -If the optional argument LOAD-NOW is non-nil, the winsock library is\n\ -also loaded immediately if not already loaded. If winsock is loaded,\n\ -the winsock local hostname is returned (since this may be different from\n\ -the value of `system-name' and should supplant it), otherwise t is\n\ -returned to indicate winsock support is present.") + 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; { @@ -1584,10 +1682,10 @@ returned to indicate winsock support is present.") DEFUN ("w32-unload-winsock", Fw32_unload_winsock, Sw32_unload_winsock, 0, 0, 0, - "Unload the Windows socket library `winsock' if loaded.\n\ -This is provided to allow dial-up socket connections to be disconnected\n\ -when no longer needed. Returns nil without unloading winsock if any\n\ -socket connections still exist.") + 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; @@ -1606,15 +1704,15 @@ socket connections still exist.") } 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.") + 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, 0); + CHECK_STRING (filename); /* first expand it. */ filename = Fexpand_file_name (filename, Qnil); @@ -1631,15 +1729,15 @@ All path elements in FILENAME are converted to their short names.") 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.") + 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, 0); + CHECK_STRING (filename); /* first expand it. */ filename = Fexpand_file_name (filename, Qnil); @@ -1652,15 +1750,15 @@ All path elements in FILENAME are converted to their long names.") 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.") +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; { @@ -1668,14 +1766,14 @@ If successful, the return value is t, otherwise nil.") DWORD priority_class = NORMAL_PRIORITY_CLASS; Lisp_Object result = Qnil; - CHECK_SYMBOL (priority, 0); + CHECK_SYMBOL (priority); if (!NILP (process)) { DWORD pid; child_process *cp; - CHECK_NUMBER (process, 0); + CHECK_NUMBER (process); /* Allow pid to be an internally generated one, or one obtained externally. This is necessary because real pids on Win95 are @@ -1706,17 +1804,20 @@ If successful, the return value is t, otherwise nil.") } -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 non-nil, the long form of the locale\n\ -name is returned, e.g. `English (United States)' instead.\n\ -\n\ -If LCID (a 16-bit number) is not a valid locale, the result is nil.") +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; { @@ -1725,7 +1826,7 @@ If LCID (a 16-bit number) is not a valid locale, the result is nil.") char abbrev_name[32] = { 0 }; char full_name[256] = { 0 }; - CHECK_NUMBER (lcid, 0); + CHECK_NUMBER (lcid); if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED)) return Qnil; @@ -1738,7 +1839,7 @@ If LCID (a 16-bit number) is not a valid locale, the result is nil.") if (got_abbrev) return build_string (abbrev_name); } - else + else if (EQ (longform, Qt)) { got_full = GetLocaleInfo (XINT (lcid), LOCALE_SLANGUAGE | LOCALE_USE_CP_ACP, @@ -1746,15 +1847,24 @@ If LCID (a 16-bit number) is not a valid locale, the result is nil.") 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.") +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 ()); @@ -1788,10 +1898,11 @@ BOOL CALLBACK enum_locale_fn (LPTSTR localeNum) 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.") +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; @@ -1804,11 +1915,11 @@ human-readable form.") 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.") + 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; { @@ -1819,12 +1930,12 @@ human-readable form.") 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.") + 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, 0); + CHECK_NUMBER (lcid); if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED)) return Qnil; @@ -1840,6 +1951,186 @@ If successful, the new locale id is returned, otherwise nil.") 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 () { @@ -1859,65 +2150,87 @@ syms_of_ntproc () 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\ -Because Windows does not directly pass argv arrays to child processes,\n\ -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\ -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."); + 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, - "When nil, processes started via start-process hide their windows.\n\ -When non-nil, they show their window in the method of their choice."); + 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, - "When nil, processes started via start-process 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."); + 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, - "Forced delay before reading subprocess output.\n\ -This is done to improve the buffering of subprocess output, by\n\ -avoiding the inefficiency of frequently reading small amounts of data.\n\ -\n\ -If positive, the value is the number of milliseconds to sleep before\n\ -reading the subprocess output. If negative, the magnitude is the number\n\ -of time slices to wait (effectively boosting the priority of the child\n\ -process temporarily). A value of zero disables waiting entirely."); + 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, - "Non-nil means convert all-upper case file names to lower case.\n\ -This applies when performing completions and file name expansion."); + 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, - "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."); + 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, - "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."); + 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 */