/* 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.
#undef kill
#include <windows.h>
+#ifdef __GNUC__
+/* This definition is missing from mingw32 headers. */
+extern BOOL WINAPI IsValidLocale(LCID, DWORD);
+#endif
#include "lisp.h"
#include "w32.h"
#include "systime.h"
#include "syswait.h"
#include "process.h"
+#include "syssignal.h"
#include "w32term.h"
/* Control whether spawnve quotes arguments as necessary to ensure
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,
Lisp_Object Qhigh, Qlow;
-#ifndef SYS_SIGLIST_DECLARED
-extern char *sys_siglist[];
-#endif
-
#ifdef EMACSDEBUG
void _DebPrint (const char *fmt, ...)
{
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 ();
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;
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;
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";
}
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;
/* 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;
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
{
{
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);
}
}
}
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++;
}
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)
full = Qnil;
GCPRO1 (program);
- openp (Vexec_path, program, EXEC_SUFFIXES, &full, 1);
+ openp (Vexec_path, program, Vexec_suffixes, &full, 1);
UNGCPRO;
if (NILP (full))
{
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,
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;
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++;
arglen += escape_char_run;
}
}
- else if (*p == ' ' || *p == '\t')
+ else if (strchr (sepchars, *p) != NULL)
{
need_quotes = 1;
}
if (do_quoting)
{
for ( ; *p; p++)
- if (*p == ' ' || *p == '\t' || *p == '"')
+ if ((strchr (sepchars, *p) != NULL) || *p == '"')
need_quotes = 1;
}
if (need_quotes)
/* 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 != '"')
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++;
}
/* 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;
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)
{
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];
/* 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;
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))
{
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;
{
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;
} 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);
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);
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;
{
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
}
-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;
{
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;
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,
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 ());
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;
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;
{
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;
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 ();
+}
+
\f
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 */