/* 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.
#include <io.h>
#include <fcntl.h>
#include <signal.h>
+#include <sys/file.h>
/* must include CRT headers *before* config.h */
-#include "config.h"
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
#undef signal
#undef wait
#undef spawnve
#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
correct parsing by child process. Because not all uses of spawnve
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
{
nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew);
- if (nt_header > dos_header + executable.size)
+ if ((char *) nt_header > (char *) dos_header + executable.size)
{
/* Some dos headers (pkunzip) have bogus e_lfanew fields. */
*is_dos_app = TRUE;
{
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, make_number (X_OK));
UNGCPRO;
if (NILP (full))
{
unixtodos_filename (cmdname);
argv[0] = cmdname;
- /* Determine whether program is a 16-bit DOS executable, or a Win32
+ /* 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);
+ 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,
exactly, so we treat quotes at the beginning and end of arguments
as embedded quotes.
- The Win32 GNU-based library from Cygnus doubles quotes to escape
+ 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
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;
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. */
+ 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[];
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 pipe handles to wait on. */
- nh = 0;
+ nh = 1;
for (i = 0; i < nfds; i++)
if (FD_ISSET (i, &orfds))
{
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 ();
}
}
}
/* 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 */
- if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess)
+ /* 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;
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];
+
+ /* We cannot always signal SIGCHLD immediately; if we have not
+ finished reading the process output, we must delay sending
+ SIGCHLD until we do. */
+
+ 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 */
- if (sig_handlers[SIGCHLD] != SIG_DFL
- && sig_handlers[SIGCHLD] != SIG_IGN)
+ else if (sig_handlers[SIGCHLD] != SIG_DFL &&
+ sig_handlers[SIGCHLD] != SIG_IGN)
{
#ifdef FULL_DEBUG
DebPrint (("select calling SIGCHLD handler for pid %d\n",
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 */
/* 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);
-
- 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))
{
"for pid %lu\n", GetLastError (), pid));
errno = EINVAL;
rc = -1;
- }
+ }
}
else
{
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
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 ());
}
+DWORD int_from_hex (char * s)
+{
+ DWORD val = 0;
+ static char hex[] = "0123456789abcdefABCDEF";
+ char * p;
+
+ while (*s && (p = strchr(hex, *s)) != NULL)
+ {
+ unsigned digit = p - hex;
+ if (digit > 15)
+ digit -= 6;
+ val = val * 16 + digit;
+ s++;
+ }
+ return val;
+}
+
+/* We need to build a global list, since the EnumSystemLocale callback
+ function isn't given a context pointer. */
+Lisp_Object Vw32_valid_locale_ids;
+
+BOOL CALLBACK enum_locale_fn (LPTSTR localeNum)
+{
+ DWORD id = int_from_hex (localeNum);
+ Vw32_valid_locale_ids = Fcons (make_number (id), Vw32_valid_locale_ids);
+ return TRUE;
+}
+
+DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids,
+ Sw32_get_valid_locale_ids, 0, 0, 0,
+ doc: /* Return list of all valid Windows locale ids.
+Each id is a numerical value; use `w32-get-locale-info' to convert to a
+human-readable form. */)
+ ()
+{
+ Vw32_valid_locale_ids = Qnil;
+
+ EnumSystemLocales (enum_locale_fn, LCID_SUPPORTED);
+
+ Vw32_valid_locale_ids = Fnreverse (Vw32_valid_locale_ids);
+ return Vw32_valid_locale_ids;
+}
+
DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id, Sw32_get_default_locale_id, 0, 1, 0,
- "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;
if (!SetThreadLocale (XINT (lcid)))
return Qnil;
+ /* Need to set input thread locale if present. */
+ if (dwWindowsThreadId)
+ /* Reply is not needed. */
+ PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0);
+
return make_number (GetThreadLocale ());
}
+
+/* We need to build a global list, since the EnumCodePages callback
+ function isn't given a context pointer. */
+Lisp_Object Vw32_valid_codepages;
+
+BOOL CALLBACK enum_codepage_fn (LPTSTR codepageNum)
+{
+ DWORD id = atoi (codepageNum);
+ Vw32_valid_codepages = Fcons (make_number (id), Vw32_valid_codepages);
+ return TRUE;
+}
+
+DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages,
+ Sw32_get_valid_codepages, 0, 0, 0,
+ doc: /* Return list of all valid Windows codepages. */)
+ ()
+{
+ Vw32_valid_codepages = Qnil;
+
+ EnumSystemCodePages (enum_codepage_fn, CP_SUPPORTED);
+
+ Vw32_valid_codepages = Fnreverse (Vw32_valid_codepages);
+ return Vw32_valid_codepages;
+}
+
+
+DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage,
+ Sw32_get_console_codepage, 0, 0, 0,
+ doc: /* Return current Windows codepage for console input. */)
+ ()
+{
+ return make_number (GetConsoleCP ());
+}
+
+
+DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage,
+ Sw32_set_console_codepage, 1, 1, 0,
+ doc: /* Make Windows codepage CP be the current codepage setting for Emacs.
+The codepage setting affects keyboard input and display in tty mode.
+If successful, the new CP is returned, otherwise nil. */)
+ (cp)
+ Lisp_Object cp;
+{
+ CHECK_NUMBER (cp);
+
+ if (!IsValidCodePage (XINT (cp)))
+ return Qnil;
+
+ if (!SetConsoleCP (XINT (cp)))
+ return Qnil;
+
+ return make_number (GetConsoleCP ());
+}
+
+
+DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage,
+ Sw32_get_console_output_codepage, 0, 0, 0,
+ doc: /* Return current Windows codepage for console output. */)
+ ()
+{
+ return make_number (GetConsoleOutputCP ());
+}
+
+
+DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage,
+ Sw32_set_console_output_codepage, 1, 1, 0,
+ doc: /* Make Windows codepage CP be the current codepage setting for Emacs.
+The codepage setting affects keyboard input and display in tty mode.
+If successful, the new CP is returned, otherwise nil. */)
+ (cp)
+ Lisp_Object cp;
+{
+ CHECK_NUMBER (cp);
+
+ if (!IsValidCodePage (XINT (cp)))
+ return Qnil;
+
+ if (!SetConsoleOutputCP (XINT (cp)))
+ return Qnil;
+
+ return make_number (GetConsoleOutputCP ());
+}
+
+
+DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset,
+ Sw32_get_codepage_charset, 1, 1, 0,
+ doc: /* Return charset of codepage CP.
+Returns nil if the codepage is not valid. */)
+ (cp)
+ Lisp_Object cp;
+{
+ CHARSETINFO info;
+
+ CHECK_NUMBER (cp);
+
+ if (!IsValidCodePage (XINT (cp)))
+ return Qnil;
+
+ if (TranslateCharsetInfo ((DWORD *) XINT (cp), &info, TCI_SRCCODEPAGE))
+ return make_number (info.ciCharset);
+
+ return Qnil;
+}
+
+
+DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts,
+ Sw32_get_valid_keyboard_layouts, 0, 0, 0,
+ doc: /* Return list of Windows keyboard languages and layouts.
+The return value is a list of pairs of language id and layout id. */)
+ ()
+{
+ int num_layouts = GetKeyboardLayoutList (0, NULL);
+ HKL * layouts = (HKL *) alloca (num_layouts * sizeof (HKL));
+ Lisp_Object obj = Qnil;
+
+ if (GetKeyboardLayoutList (num_layouts, layouts) == num_layouts)
+ {
+ while (--num_layouts >= 0)
+ {
+ DWORD kl = (DWORD) layouts[num_layouts];
+
+ obj = Fcons (Fcons (make_number (kl & 0xffff),
+ make_number ((kl >> 16) & 0xffff)),
+ obj);
+ }
+ }
+
+ return obj;
+}
+
+
+DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout,
+ Sw32_get_keyboard_layout, 0, 0, 0,
+ doc: /* Return current Windows keyboard language and layout.
+The return value is the cons of the language id and the layout id. */)
+ ()
+{
+ DWORD kl = (DWORD) GetKeyboardLayout (dwWindowsThreadId);
+
+ return Fcons (make_number (kl & 0xffff),
+ make_number ((kl >> 16) & 0xffff));
+}
+
+
+DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout,
+ Sw32_set_keyboard_layout, 1, 1, 0,
+ doc: /* Make LAYOUT be the current keyboard layout for Emacs.
+The keyboard layout setting affects interpretation of keyboard input.
+If successful, the new layout id is returned, otherwise nil. */)
+ (layout)
+ Lisp_Object layout;
+{
+ DWORD kl;
+
+ CHECK_CONS (layout);
+ CHECK_NUMBER_CAR (layout);
+ CHECK_NUMBER_CDR (layout);
+
+ kl = (XINT (XCAR (layout)) & 0xffff)
+ | (XINT (XCDR (layout)) << 16);
+
+ /* Synchronize layout with input thread. */
+ if (dwWindowsThreadId)
+ {
+ if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETKEYBOARDLAYOUT,
+ (WPARAM) kl, 0))
+ {
+ MSG msg;
+ GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
+
+ if (msg.wParam == 0)
+ return Qnil;
+ }
+ }
+ else if (!ActivateKeyboardLayout ((HKL) kl, 0))
+ return Qnil;
+
+ return Fw32_get_keyboard_layout ();
+}
+
\f
syms_of_ntproc ()
{
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\
-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 one DOS subprocess to run at a time (whether started directly
+or indirectly by Emacs), and preventing Emacs from cleanly terminating the
+subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
+otherwise respond to interrupts from Emacs. */);
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.");
- Vw32_get_true_file_attributes = Qnil;
+ 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 = Qt;
}
/* end of ntproc.c */
HCoop / bpt / emacs.git / blobdiff