(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
[bpt/emacs.git] / src / w32proc.c
CommitLineData
e9e23e23 1/* Process support for GNU Emacs on the Microsoft W32 API.
0b5538bd
TTN
2 Copyright (C) 1992, 1995, 1999, 2000, 2001, 2002, 2003, 2004,
3 2005 Free Software Foundation, Inc.
6cdfb6e6 4
3b7ad313
EN
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
4fc5845f
LK
19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20Boston, MA 02110-1301, USA.
6cdfb6e6
RS
21
22 Drew Bliss Oct 14, 1993
23 Adapted from alarm.c by Tim Fleehart
24*/
25
26#include <stdio.h>
27#include <stdlib.h>
28#include <errno.h>
29#include <io.h>
c519b5e1 30#include <fcntl.h>
6cdfb6e6 31#include <signal.h>
51f635c4 32#include <sys/file.h>
6cdfb6e6 33
c519b5e1 34/* must include CRT headers *before* config.h */
4838e624
PJ
35
36#ifdef HAVE_CONFIG_H
37#include <config.h>
38#endif
39
c519b5e1
GV
40#undef signal
41#undef wait
42#undef spawnve
43#undef select
44#undef kill
45
6cdfb6e6 46#include <windows.h>
42c95ffb
AI
47#ifdef __GNUC__
48/* This definition is missing from mingw32 headers. */
49extern BOOL WINAPI IsValidLocale(LCID, DWORD);
50#endif
6cdfb6e6
RS
51
52#include "lisp.h"
489f9371 53#include "w32.h"
b2fc9f3d 54#include "w32heap.h"
6cdfb6e6 55#include "systime.h"
3d7eead0
GV
56#include "syswait.h"
57#include "process.h"
e7c15bba 58#include "syssignal.h"
ef79fbba 59#include "w32term.h"
3d7eead0 60
8747ac3f
EZ
61#define RVA_TO_PTR(var,section,filedata) \
62 ((void *)((section)->PointerToRawData \
63 + ((DWORD)(var) - (section)->VirtualAddress) \
64 + (filedata).file_base))
65
93fdf2f8
RS
66/* Control whether spawnve quotes arguments as necessary to ensure
67 correct parsing by child process. Because not all uses of spawnve
68 are careful about constructing argv arrays, we make this behaviour
69 conditional (off by default). */
fbd6baed 70Lisp_Object Vw32_quote_process_args;
93fdf2f8 71
0ecf7d36
RS
72/* Control whether create_child causes the process' window to be
73 hidden. The default is nil. */
fbd6baed 74Lisp_Object Vw32_start_process_show_window;
0ecf7d36 75
b2fc9f3d
GV
76/* Control whether create_child causes the process to inherit Emacs'
77 console window, or be given a new one of its own. The default is
78 nil, to allow multiple DOS programs to run on Win95. Having separate
79 consoles also allows Emacs to cleanly terminate process groups. */
80Lisp_Object Vw32_start_process_share_console;
81
82e7c0a9
AI
82/* Control whether create_child cause the process to inherit Emacs'
83 error mode setting. The default is t, to minimize the possibility of
84 subprocesses blocking when accessing unmounted drives. */
85Lisp_Object Vw32_start_process_inherit_error_mode;
86
817abdf6
KH
87/* Time to sleep before reading from a subprocess output pipe - this
88 avoids the inefficiency of frequently reading small amounts of data.
89 This is primarily necessary for handling DOS processes on Windows 95,
e9e23e23 90 but is useful for W32 processes on both Windows 95 and NT as well. */
5322f50b 91int w32_pipe_read_delay;
817abdf6 92
0c04091e
RS
93/* Control conversion of upper case file names to lower case.
94 nil means no, t means yes. */
fbd6baed 95Lisp_Object Vw32_downcase_file_names;
0c04091e 96
b2fc9f3d
GV
97/* Control whether stat() attempts to generate fake but hopefully
98 "accurate" inode values, by hashing the absolute truenames of files.
99 This should detect aliasing between long and short names, but still
100 allows the possibility of hash collisions. */
101Lisp_Object Vw32_generate_fake_inodes;
102
103/* Control whether stat() attempts to determine file type and link count
104 exactly, at the expense of slower operation. Since true hard links
105 are supported on NTFS volumes, this is only relevant on NT. */
106Lisp_Object Vw32_get_true_file_attributes;
107
108Lisp_Object Qhigh, Qlow;
817abdf6 109
6cdfb6e6 110#ifdef EMACSDEBUG
c519b5e1 111void _DebPrint (const char *fmt, ...)
6cdfb6e6 112{
c519b5e1 113 char buf[1024];
6cdfb6e6
RS
114 va_list args;
115
116 va_start (args, fmt);
117 vsprintf (buf, fmt, args);
118 va_end (args);
119 OutputDebugString (buf);
120}
121#endif
122
c519b5e1 123typedef void (_CALLBACK_ *signal_handler)(int);
6cdfb6e6
RS
124
125/* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */
126static signal_handler sig_handlers[NSIG];
127
128/* Fake signal implementation to record the SIGCHLD handler. */
177c0ea7 129signal_handler
c519b5e1 130sys_signal (int sig, signal_handler handler)
6cdfb6e6
RS
131{
132 signal_handler old;
177c0ea7 133
6cdfb6e6
RS
134 if (sig != SIGCHLD)
135 {
136 errno = EINVAL;
137 return SIG_ERR;
138 }
139 old = sig_handlers[sig];
140 sig_handlers[sig] = handler;
141 return old;
142}
143
c519b5e1
GV
144/* Defined in <process.h> which conflicts with the local copy */
145#define _P_NOWAIT 1
146
147/* Child process management list. */
148int child_proc_count = 0;
149child_process child_procs[ MAX_CHILDREN ];
150child_process *dead_child = NULL;
151
152DWORD WINAPI reader_thread (void *arg);
153
6cdfb6e6 154/* Find an unused process slot. */
c519b5e1 155child_process *
6cdfb6e6
RS
156new_child (void)
157{
158 child_process *cp;
c519b5e1 159 DWORD id;
177c0ea7 160
6cdfb6e6
RS
161 for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--)
162 if (!CHILD_ACTIVE (cp))
c519b5e1
GV
163 goto Initialise;
164 if (child_proc_count == MAX_CHILDREN)
165 return NULL;
166 cp = &child_procs[child_proc_count++];
167
168 Initialise:
169 memset (cp, 0, sizeof(*cp));
170 cp->fd = -1;
171 cp->pid = -1;
172 cp->procinfo.hProcess = NULL;
173 cp->status = STATUS_READ_ERROR;
174
175 /* use manual reset event so that select() will function properly */
176 cp->char_avail = CreateEvent (NULL, TRUE, FALSE, NULL);
177 if (cp->char_avail)
178 {
179 cp->char_consumed = CreateEvent (NULL, FALSE, FALSE, NULL);
180 if (cp->char_consumed)
181 {
182 cp->thrd = CreateThread (NULL, 1024, reader_thread, cp, 0, &id);
183 if (cp->thrd)
184 return cp;
185 }
186 }
187 delete_child (cp);
188 return NULL;
189}
190
177c0ea7 191void
c519b5e1
GV
192delete_child (child_process *cp)
193{
194 int i;
195
196 /* Should not be deleting a child that is still needed. */
197 for (i = 0; i < MAXDESC; i++)
198 if (fd_info[i].cp == cp)
199 abort ();
200
201 if (!CHILD_ACTIVE (cp))
202 return;
203
204 /* reap thread if necessary */
205 if (cp->thrd)
206 {
207 DWORD rc;
208
209 if (GetExitCodeThread (cp->thrd, &rc) && rc == STILL_ACTIVE)
210 {
211 /* let the thread exit cleanly if possible */
212 cp->status = STATUS_READ_ERROR;
213 SetEvent (cp->char_consumed);
214 if (WaitForSingleObject (cp->thrd, 1000) != WAIT_OBJECT_0)
215 {
216 DebPrint (("delete_child.WaitForSingleObject (thread) failed "
217 "with %lu for fd %ld\n", GetLastError (), cp->fd));
218 TerminateThread (cp->thrd, 0);
219 }
220 }
221 CloseHandle (cp->thrd);
222 cp->thrd = NULL;
223 }
224 if (cp->char_avail)
225 {
226 CloseHandle (cp->char_avail);
227 cp->char_avail = NULL;
228 }
229 if (cp->char_consumed)
230 {
231 CloseHandle (cp->char_consumed);
232 cp->char_consumed = NULL;
233 }
234
235 /* update child_proc_count (highest numbered slot in use plus one) */
236 if (cp == child_procs + child_proc_count - 1)
237 {
238 for (i = child_proc_count-1; i >= 0; i--)
239 if (CHILD_ACTIVE (&child_procs[i]))
240 {
241 child_proc_count = i + 1;
242 break;
243 }
244 }
245 if (i < 0)
246 child_proc_count = 0;
6cdfb6e6
RS
247}
248
249/* Find a child by pid. */
250static child_process *
251find_child_pid (DWORD pid)
252{
253 child_process *cp;
c519b5e1 254
6cdfb6e6
RS
255 for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--)
256 if (CHILD_ACTIVE (cp) && pid == cp->pid)
257 return cp;
258 return NULL;
259}
260
6cdfb6e6 261
c519b5e1
GV
262/* Thread proc for child process and socket reader threads. Each thread
263 is normally blocked until woken by select() to check for input by
264 reading one char. When the read completes, char_avail is signalled
265 to wake up the select emulator and the thread blocks itself again. */
177c0ea7 266DWORD WINAPI
6cdfb6e6
RS
267reader_thread (void *arg)
268{
269 child_process *cp;
177c0ea7 270
6cdfb6e6
RS
271 /* Our identity */
272 cp = (child_process *)arg;
177c0ea7 273
6cdfb6e6 274 /* We have to wait for the go-ahead before we can start */
b2fc9f3d
GV
275 if (cp == NULL
276 || WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0)
c519b5e1
GV
277 return 1;
278
6cdfb6e6
RS
279 for (;;)
280 {
c519b5e1
GV
281 int rc;
282
283 rc = _sys_read_ahead (cp->fd);
284
285 /* The name char_avail is a misnomer - it really just means the
286 read-ahead has completed, whether successfully or not. */
6cdfb6e6
RS
287 if (!SetEvent (cp->char_avail))
288 {
289 DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld\n",
290 GetLastError (), cp->fd));
c519b5e1
GV
291 return 1;
292 }
293
294 if (rc == STATUS_READ_ERROR)
295 return 1;
177c0ea7 296
6cdfb6e6 297 /* If the read died, the child has died so let the thread die */
c519b5e1 298 if (rc == STATUS_READ_FAILED)
6cdfb6e6 299 break;
177c0ea7 300
6cdfb6e6
RS
301 /* Wait until our input is acknowledged before reading again */
302 if (WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0)
303 {
304 DebPrint (("reader_thread.WaitForSingleObject failed with "
305 "%lu for fd %ld\n", GetLastError (), cp->fd));
306 break;
307 }
308 }
309 return 0;
310}
311
b2fc9f3d
GV
312/* To avoid Emacs changing directory, we just record here the directory
313 the new process should start in. This is set just before calling
314 sys_spawnve, and is not generally valid at any other time. */
315static char * process_dir;
316
177c0ea7 317static BOOL
a55a5f3c 318create_child (char *exe, char *cmdline, char *env, int is_gui_app,
c519b5e1 319 int * pPid, child_process *cp)
6cdfb6e6 320{
6cdfb6e6
RS
321 STARTUPINFO start;
322 SECURITY_ATTRIBUTES sec_attrs;
42c95ffb 323#if 0
6cdfb6e6 324 SECURITY_DESCRIPTOR sec_desc;
42c95ffb 325#endif
82e7c0a9 326 DWORD flags;
b2fc9f3d 327 char dir[ MAXPATHLEN ];
177c0ea7 328
c519b5e1 329 if (cp == NULL) abort ();
177c0ea7 330
6cdfb6e6
RS
331 memset (&start, 0, sizeof (start));
332 start.cb = sizeof (start);
177c0ea7 333
58d4e829 334#ifdef HAVE_NTGUI
a55a5f3c 335 if (NILP (Vw32_start_process_show_window) && !is_gui_app)
0ecf7d36
RS
336 start.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW;
337 else
338 start.dwFlags = STARTF_USESTDHANDLES;
58d4e829
GV
339 start.wShowWindow = SW_HIDE;
340
341 start.hStdInput = GetStdHandle (STD_INPUT_HANDLE);
342 start.hStdOutput = GetStdHandle (STD_OUTPUT_HANDLE);
343 start.hStdError = GetStdHandle (STD_ERROR_HANDLE);
344#endif /* HAVE_NTGUI */
345
42c95ffb 346#if 0
6cdfb6e6
RS
347 /* Explicitly specify no security */
348 if (!InitializeSecurityDescriptor (&sec_desc, SECURITY_DESCRIPTOR_REVISION))
c519b5e1 349 goto EH_Fail;
6cdfb6e6 350 if (!SetSecurityDescriptorDacl (&sec_desc, TRUE, NULL, FALSE))
c519b5e1 351 goto EH_Fail;
42c95ffb 352#endif
6cdfb6e6 353 sec_attrs.nLength = sizeof (sec_attrs);
42c95ffb 354 sec_attrs.lpSecurityDescriptor = NULL /* &sec_desc */;
6cdfb6e6 355 sec_attrs.bInheritHandle = FALSE;
177c0ea7 356
b2fc9f3d
GV
357 strcpy (dir, process_dir);
358 unixtodos_filename (dir);
82e7c0a9
AI
359
360 flags = (!NILP (Vw32_start_process_share_console)
361 ? CREATE_NEW_PROCESS_GROUP
362 : CREATE_NEW_CONSOLE);
363 if (NILP (Vw32_start_process_inherit_error_mode))
364 flags |= CREATE_DEFAULT_ERROR_MODE;
6cdfb6e6 365 if (!CreateProcess (exe, cmdline, &sec_attrs, NULL, TRUE,
82e7c0a9 366 flags, env, dir, &start, &cp->procinfo))
c519b5e1
GV
367 goto EH_Fail;
368
369 cp->pid = (int) cp->procinfo.dwProcessId;
370
371 /* Hack for Windows 95, which assigns large (ie negative) pids */
372 if (cp->pid < 0)
373 cp->pid = -cp->pid;
374
375 /* pid must fit in a Lisp_Int */
acba5cae 376 cp->pid = cp->pid & INTMASK;
c519b5e1 377
c519b5e1 378 *pPid = cp->pid;
b2fc9f3d 379
6cdfb6e6 380 return TRUE;
b2fc9f3d 381
6cdfb6e6 382 EH_Fail:
c519b5e1 383 DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError()););
6cdfb6e6
RS
384 return FALSE;
385}
386
387/* create_child doesn't know what emacs' file handle will be for waiting
388 on output from the child, so we need to make this additional call
389 to register the handle with the process
390 This way the select emulator knows how to match file handles with
391 entries in child_procs. */
177c0ea7 392void
6cdfb6e6
RS
393register_child (int pid, int fd)
394{
395 child_process *cp;
177c0ea7 396
6cdfb6e6
RS
397 cp = find_child_pid (pid);
398 if (cp == NULL)
399 {
400 DebPrint (("register_child unable to find pid %lu\n", pid));
401 return;
402 }
177c0ea7 403
6cdfb6e6
RS
404#ifdef FULL_DEBUG
405 DebPrint (("register_child registered fd %d with pid %lu\n", fd, pid));
406#endif
177c0ea7 407
6cdfb6e6 408 cp->fd = fd;
6cdfb6e6 409
c519b5e1
GV
410 /* thread is initially blocked until select is called; set status so
411 that select will release thread */
412 cp->status = STATUS_READ_ACKNOWLEDGED;
413
414 /* attach child_process to fd_info */
415 if (fd_info[fd].cp != NULL)
6cdfb6e6 416 {
c519b5e1
GV
417 DebPrint (("register_child: fd_info[%d] apparently in use!\n", fd));
418 abort ();
6cdfb6e6 419 }
c519b5e1
GV
420
421 fd_info[fd].cp = cp;
6cdfb6e6
RS
422}
423
424/* When a process dies its pipe will break so the reader thread will
425 signal failure to the select emulator.
426 The select emulator then calls this routine to clean up.
427 Since the thread signaled failure we can assume it is exiting. */
177c0ea7 428static void
c519b5e1 429reap_subprocess (child_process *cp)
6cdfb6e6 430{
c519b5e1 431 if (cp->procinfo.hProcess)
6cdfb6e6 432 {
c519b5e1 433 /* Reap the process */
b2fc9f3d
GV
434#ifdef FULL_DEBUG
435 /* Process should have already died before we are called. */
436 if (WaitForSingleObject (cp->procinfo.hProcess, 0) != WAIT_OBJECT_0)
437 DebPrint (("reap_subprocess: child fpr fd %d has not died yet!", cp->fd));
438#endif
c519b5e1
GV
439 CloseHandle (cp->procinfo.hProcess);
440 cp->procinfo.hProcess = NULL;
441 CloseHandle (cp->procinfo.hThread);
442 cp->procinfo.hThread = NULL;
6cdfb6e6 443 }
c519b5e1
GV
444
445 /* For asynchronous children, the child_proc resources will be freed
446 when the last pipe read descriptor is closed; for synchronous
447 children, we must explicitly free the resources now because
448 register_child has not been called. */
449 if (cp->fd == -1)
450 delete_child (cp);
6cdfb6e6
RS
451}
452
453/* Wait for any of our existing child processes to die
454 When it does, close its handle
455 Return the pid and fill in the status if non-NULL. */
22759c72 456
177c0ea7 457int
c519b5e1 458sys_wait (int *status)
6cdfb6e6
RS
459{
460 DWORD active, retval;
461 int nh;
c519b5e1 462 int pid;
6cdfb6e6
RS
463 child_process *cp, *cps[MAX_CHILDREN];
464 HANDLE wait_hnd[MAX_CHILDREN];
177c0ea7 465
6cdfb6e6
RS
466 nh = 0;
467 if (dead_child != NULL)
468 {
469 /* We want to wait for a specific child */
c519b5e1 470 wait_hnd[nh] = dead_child->procinfo.hProcess;
6cdfb6e6 471 cps[nh] = dead_child;
c519b5e1 472 if (!wait_hnd[nh]) abort ();
6cdfb6e6 473 nh++;
b2fc9f3d
GV
474 active = 0;
475 goto get_result;
6cdfb6e6
RS
476 }
477 else
478 {
479 for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--)
c519b5e1
GV
480 /* some child_procs might be sockets; ignore them */
481 if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess)
6cdfb6e6 482 {
c519b5e1 483 wait_hnd[nh] = cp->procinfo.hProcess;
6cdfb6e6
RS
484 cps[nh] = cp;
485 nh++;
486 }
487 }
177c0ea7 488
6cdfb6e6
RS
489 if (nh == 0)
490 {
491 /* Nothing to wait on, so fail */
492 errno = ECHILD;
493 return -1;
494 }
b2fc9f3d
GV
495
496 do
497 {
498 /* Check for quit about once a second. */
499 QUIT;
500 active = WaitForMultipleObjects (nh, wait_hnd, FALSE, 1000);
501 } while (active == WAIT_TIMEOUT);
502
6cdfb6e6
RS
503 if (active == WAIT_FAILED)
504 {
505 errno = EBADF;
506 return -1;
507 }
b2fc9f3d
GV
508 else if (active >= WAIT_OBJECT_0
509 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
6cdfb6e6
RS
510 {
511 active -= WAIT_OBJECT_0;
512 }
b2fc9f3d
GV
513 else if (active >= WAIT_ABANDONED_0
514 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
6cdfb6e6
RS
515 {
516 active -= WAIT_ABANDONED_0;
517 }
b2fc9f3d
GV
518 else
519 abort ();
520
521get_result:
6cdfb6e6
RS
522 if (!GetExitCodeProcess (wait_hnd[active], &retval))
523 {
524 DebPrint (("Wait.GetExitCodeProcess failed with %lu\n",
525 GetLastError ()));
526 retval = 1;
527 }
528 if (retval == STILL_ACTIVE)
529 {
530 /* Should never happen */
531 DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
532 errno = EINVAL;
533 return -1;
534 }
bc69349b
RS
535
536 /* Massage the exit code from the process to match the format expected
8e6208c5 537 by the WIFSTOPPED et al macros in syswait.h. Only WIFSIGNALED and
bc69349b
RS
538 WIFEXITED are supported; WIFSTOPPED doesn't make sense under NT. */
539
540 if (retval == STATUS_CONTROL_C_EXIT)
541 retval = SIGINT;
542 else
543 retval <<= 8;
177c0ea7 544
6cdfb6e6 545 cp = cps[active];
c519b5e1
GV
546 pid = cp->pid;
547#ifdef FULL_DEBUG
548 DebPrint (("Wait signaled with process pid %d\n", cp->pid));
549#endif
22759c72 550
6cdfb6e6
RS
551 if (status)
552 {
22759c72
KH
553 *status = retval;
554 }
555 else if (synch_process_alive)
556 {
557 synch_process_alive = 0;
22759c72 558
3d7eead0
GV
559 /* Report the status of the synchronous process. */
560 if (WIFEXITED (retval))
561 synch_process_retcode = WRETCODE (retval);
562 else if (WIFSIGNALED (retval))
563 {
564 int code = WTERMSIG (retval);
68c45bf0
PE
565 char *signame;
566
ca9c0567 567 synchronize_system_messages_locale ();
68c45bf0
PE
568 signame = strsignal (code);
569
3d7eead0
GV
570 if (signame == 0)
571 signame = "unknown";
572
573 synch_process_death = signame;
574 }
c519b5e1
GV
575
576 reap_subprocess (cp);
6cdfb6e6 577 }
b2fc9f3d
GV
578
579 reap_subprocess (cp);
177c0ea7 580
c519b5e1 581 return pid;
6cdfb6e6
RS
582}
583
b2fc9f3d 584void
a55a5f3c 585w32_executable_type (char * filename, int * is_dos_app, int * is_cygnus_app, int * is_gui_app)
817abdf6 586{
b2fc9f3d
GV
587 file_data executable;
588 char * p;
177c0ea7 589
b2fc9f3d
GV
590 /* Default values in case we can't tell for sure. */
591 *is_dos_app = FALSE;
592 *is_cygnus_app = FALSE;
a55a5f3c 593 *is_gui_app = FALSE;
b2fc9f3d
GV
594
595 if (!open_input_file (&executable, filename))
596 return;
817abdf6 597
b2fc9f3d 598 p = strrchr (filename, '.');
177c0ea7 599
b2fc9f3d
GV
600 /* We can only identify DOS .com programs from the extension. */
601 if (p && stricmp (p, ".com") == 0)
602 *is_dos_app = TRUE;
603 else if (p && (stricmp (p, ".bat") == 0
604 || stricmp (p, ".cmd") == 0))
605 {
606 /* A DOS shell script - it appears that CreateProcess is happy to
607 accept this (somewhat surprisingly); presumably it looks at
608 COMSPEC to determine what executable to actually invoke.
609 Therefore, we have to do the same here as well. */
610 /* Actually, I think it uses the program association for that
611 extension, which is defined in the registry. */
612 p = egetenv ("COMSPEC");
613 if (p)
a55a5f3c 614 w32_executable_type (p, is_dos_app, is_cygnus_app, is_gui_app);
b2fc9f3d
GV
615 }
616 else
817abdf6 617 {
b2fc9f3d
GV
618 /* Look for DOS .exe signature - if found, we must also check that
619 it isn't really a 16- or 32-bit Windows exe, since both formats
620 start with a DOS program stub. Note that 16-bit Windows
621 executables use the OS/2 1.x format. */
817abdf6 622
b2fc9f3d
GV
623 IMAGE_DOS_HEADER * dos_header;
624 IMAGE_NT_HEADERS * nt_header;
625
626 dos_header = (PIMAGE_DOS_HEADER) executable.file_base;
627 if (dos_header->e_magic != IMAGE_DOS_SIGNATURE)
628 goto unwind;
629
630 nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew);
631
177c0ea7 632 if ((char *) nt_header > (char *) dos_header + executable.size)
817abdf6 633 {
b2fc9f3d
GV
634 /* Some dos headers (pkunzip) have bogus e_lfanew fields. */
635 *is_dos_app = TRUE;
177c0ea7 636 }
b2fc9f3d
GV
637 else if (nt_header->Signature != IMAGE_NT_SIGNATURE
638 && LOWORD (nt_header->Signature) != IMAGE_OS2_SIGNATURE)
639 {
640 *is_dos_app = TRUE;
641 }
642 else if (nt_header->Signature == IMAGE_NT_SIGNATURE)
643 {
644 /* Look for cygwin.dll in DLL import list. */
645 IMAGE_DATA_DIRECTORY import_dir =
646 nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT];
647 IMAGE_IMPORT_DESCRIPTOR * imports;
648 IMAGE_SECTION_HEADER * section;
649
650 section = rva_to_section (import_dir.VirtualAddress, nt_header);
651 imports = RVA_TO_PTR (import_dir.VirtualAddress, section, executable);
652
653 for ( ; imports->Name; imports++)
654 {
655 char * dllname = RVA_TO_PTR (imports->Name, section, executable);
656
a7325b56
AI
657 /* The exact name of the cygwin dll has changed with
658 various releases, but hopefully this will be reasonably
659 future proof. */
660 if (strncmp (dllname, "cygwin", 6) == 0)
b2fc9f3d
GV
661 {
662 *is_cygnus_app = TRUE;
663 break;
664 }
665 }
a55a5f3c
AI
666
667 /* Check whether app is marked as a console or windowed (aka
668 GUI) app. Accept Posix and OS2 subsytem apps as console
669 apps. */
670 *is_gui_app = (nt_header->OptionalHeader.Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
b2fc9f3d 671 }
817abdf6 672 }
177c0ea7 673
b2fc9f3d
GV
674unwind:
675 close_file_data (&executable);
817abdf6
KH
676}
677
d9709fde 678int
42c95ffb 679compare_env (const void *strp1, const void *strp2)
d9709fde 680{
42c95ffb 681 const char *str1 = *(const char **)strp1, *str2 = *(const char **)strp2;
d9709fde
GV
682
683 while (*str1 && *str2 && *str1 != '=' && *str2 != '=')
684 {
11c22fff
AI
685 /* Sort order in command.com/cmd.exe is based on uppercasing
686 names, so do the same here. */
687 if (toupper (*str1) > toupper (*str2))
d9709fde 688 return 1;
11c22fff 689 else if (toupper (*str1) < toupper (*str2))
d9709fde
GV
690 return -1;
691 str1++, str2++;
692 }
693
694 if (*str1 == '=' && *str2 == '=')
695 return 0;
696 else if (*str1 == '=')
697 return -1;
698 else
699 return 1;
700}
701
702void
703merge_and_sort_env (char **envp1, char **envp2, char **new_envp)
704{
705 char **optr, **nptr;
706 int num;
707
708 nptr = new_envp;
709 optr = envp1;
710 while (*optr)
711 *nptr++ = *optr++;
712 num = optr - envp1;
713
714 optr = envp2;
715 while (*optr)
716 *nptr++ = *optr++;
717 num += optr - envp2;
718
719 qsort (new_envp, num, sizeof (char *), compare_env);
720
721 *nptr = NULL;
722}
6cdfb6e6
RS
723
724/* When a new child process is created we need to register it in our list,
725 so intercept spawn requests. */
177c0ea7 726int
c519b5e1 727sys_spawnve (int mode, char *cmdname, char **argv, char **envp)
6cdfb6e6 728{
0a4de642 729 Lisp_Object program, full;
6cdfb6e6 730 char *cmdline, *env, *parg, **targ;
d9709fde 731 int arglen, numenv;
c519b5e1
GV
732 int pid;
733 child_process *cp;
a55a5f3c 734 int is_dos_app, is_cygnus_app, is_gui_app;
b2fc9f3d
GV
735 int do_quoting = 0;
736 char escape_char;
d9709fde
GV
737 /* We pass our process ID to our children by setting up an environment
738 variable in their environment. */
739 char ppid_env_var_buffer[64];
740 char *extra_env[] = {ppid_env_var_buffer, NULL};
dbb70029 741 char *sepchars = " \t";
d9709fde 742
c519b5e1
GV
743 /* We don't care about the other modes */
744 if (mode != _P_NOWAIT)
745 {
746 errno = EINVAL;
747 return -1;
748 }
0a4de642
RS
749
750 /* Handle executable names without an executable suffix. */
751 program = make_string (cmdname, strlen (cmdname));
752 if (NILP (Ffile_executable_p (program)))
753 {
754 struct gcpro gcpro1;
177c0ea7 755
0a4de642
RS
756 full = Qnil;
757 GCPRO1 (program);
44c7a526 758 openp (Vexec_path, program, Vexec_suffixes, &full, make_number (X_OK));
0a4de642
RS
759 UNGCPRO;
760 if (NILP (full))
761 {
762 errno = EINVAL;
763 return -1;
764 }
b2fc9f3d 765 program = full;
0a4de642
RS
766 }
767
b2fc9f3d 768 /* make sure argv[0] and cmdname are both in DOS format */
d5db4077 769 cmdname = SDATA (program);
c519b5e1
GV
770 unixtodos_filename (cmdname);
771 argv[0] = cmdname;
817abdf6 772
ef79fbba 773 /* Determine whether program is a 16-bit DOS executable, or a w32
b2fc9f3d
GV
774 executable that is implicitly linked to the Cygnus dll (implying it
775 was compiled with the Cygnus GNU toolchain and hence relies on
776 cygwin.dll to parse the command line - we use this to decide how to
a55a5f3c
AI
777 escape quote chars in command line args that must be quoted).
778
779 Also determine whether it is a GUI app, so that we don't hide its
780 initial window unless specifically requested. */
781 w32_executable_type (cmdname, &is_dos_app, &is_cygnus_app, &is_gui_app);
b2fc9f3d
GV
782
783 /* On Windows 95, if cmdname is a DOS app, we invoke a helper
784 application to start it by specifying the helper app as cmdname,
785 while leaving the real app name as argv[0]. */
786 if (is_dos_app)
817abdf6 787 {
b2fc9f3d
GV
788 cmdname = alloca (MAXPATHLEN);
789 if (egetenv ("CMDPROXY"))
790 strcpy (cmdname, egetenv ("CMDPROXY"));
791 else
792 {
d5db4077 793 strcpy (cmdname, SDATA (Vinvocation_directory));
b2fc9f3d
GV
794 strcat (cmdname, "cmdproxy.exe");
795 }
796 unixtodos_filename (cmdname);
817abdf6 797 }
177c0ea7 798
6cdfb6e6
RS
799 /* we have to do some conjuring here to put argv and envp into the
800 form CreateProcess wants... argv needs to be a space separated/null
801 terminated list of parameters, and envp is a null
802 separated/double-null terminated list of parameters.
c519b5e1 803
b2fc9f3d
GV
804 Additionally, zero-length args and args containing whitespace or
805 quote chars need to be wrapped in double quotes - for this to work,
806 embedded quotes need to be escaped as well. The aim is to ensure
807 the child process reconstructs the argv array we start with
808 exactly, so we treat quotes at the beginning and end of arguments
809 as embedded quotes.
810
ef79fbba 811 The w32 GNU-based library from Cygnus doubles quotes to escape
b2fc9f3d
GV
812 them, while MSVC uses backslash for escaping. (Actually the MSVC
813 startup code does attempt to recognise doubled quotes and accept
814 them, but gets it wrong and ends up requiring three quotes to get a
815 single embedded quote!) So by default we decide whether to use
816 quote or backslash as the escape character based on whether the
817 binary is apparently a Cygnus compiled app.
818
819 Note that using backslash to escape embedded quotes requires
820 additional special handling if an embedded quote is already
821 preceeded by backslash, or if an arg requiring quoting ends with
822 backslash. In such cases, the run of escape characters needs to be
823 doubled. For consistency, we apply this special handling as long
824 as the escape character is not quote.
825
826 Since we have no idea how large argv and envp are likely to be we
827 figure out list lengths on the fly and allocate them. */
828
829 if (!NILP (Vw32_quote_process_args))
830 {
831 do_quoting = 1;
832 /* Override escape char by binding w32-quote-process-args to
833 desired character, or use t for auto-selection. */
834 if (INTEGERP (Vw32_quote_process_args))
835 escape_char = XINT (Vw32_quote_process_args);
836 else
837 escape_char = is_cygnus_app ? '"' : '\\';
838 }
177c0ea7
JB
839
840 /* Cygwin apps needs quoting a bit more often */
dbb70029
GM
841 if (escape_char == '"')
842 sepchars = "\r\n\t\f '";
843
6cdfb6e6
RS
844 /* do argv... */
845 arglen = 0;
846 targ = argv;
847 while (*targ)
848 {
c519b5e1 849 char * p = *targ;
b2fc9f3d
GV
850 int need_quotes = 0;
851 int escape_char_run = 0;
c519b5e1
GV
852
853 if (*p == 0)
b2fc9f3d
GV
854 need_quotes = 1;
855 for ( ; *p; p++)
856 {
dbb70029
GM
857 if (escape_char == '"' && *p == '\\')
858 /* If it's a Cygwin app, \ needs to be escaped. */
859 arglen++;
860 else if (*p == '"')
b2fc9f3d
GV
861 {
862 /* allow for embedded quotes to be escaped */
863 arglen++;
864 need_quotes = 1;
865 /* handle the case where the embedded quote is already escaped */
866 if (escape_char_run > 0)
867 {
868 /* To preserve the arg exactly, we need to double the
869 preceding escape characters (plus adding one to
870 escape the quote character itself). */
871 arglen += escape_char_run;
872 }
873 }
dbb70029 874 else if (strchr (sepchars, *p) != NULL)
b2fc9f3d
GV
875 {
876 need_quotes = 1;
877 }
878
879 if (*p == escape_char && escape_char != '"')
880 escape_char_run++;
881 else
882 escape_char_run = 0;
883 }
884 if (need_quotes)
885 {
886 arglen += 2;
887 /* handle the case where the arg ends with an escape char - we
888 must not let the enclosing quote be escaped. */
889 if (escape_char_run > 0)
890 arglen += escape_char_run;
891 }
6cdfb6e6
RS
892 arglen += strlen (*targ++) + 1;
893 }
c519b5e1 894 cmdline = alloca (arglen);
6cdfb6e6
RS
895 targ = argv;
896 parg = cmdline;
897 while (*targ)
898 {
c519b5e1 899 char * p = *targ;
b2fc9f3d 900 int need_quotes = 0;
c519b5e1
GV
901
902 if (*p == 0)
b2fc9f3d 903 need_quotes = 1;
93fdf2f8 904
b2fc9f3d 905 if (do_quoting)
93fdf2f8 906 {
93fdf2f8 907 for ( ; *p; p++)
dbb70029 908 if ((strchr (sepchars, *p) != NULL) || *p == '"')
b2fc9f3d 909 need_quotes = 1;
93fdf2f8 910 }
b2fc9f3d 911 if (need_quotes)
c519b5e1 912 {
b2fc9f3d 913 int escape_char_run = 0;
c519b5e1
GV
914 char * first;
915 char * last;
916
917 p = *targ;
918 first = p;
919 last = p + strlen (p) - 1;
920 *parg++ = '"';
b2fc9f3d
GV
921#if 0
922 /* This version does not escape quotes if they occur at the
923 beginning or end of the arg - this could lead to incorrect
924 behaviour when the arg itself represents a command line
925 containing quoted args. I believe this was originally done
926 as a hack to make some things work, before
927 `w32-quote-process-args' was added. */
c519b5e1
GV
928 while (*p)
929 {
930 if (*p == '"' && p > first && p < last)
b2fc9f3d 931 *parg++ = escape_char; /* escape embedded quotes */
c519b5e1
GV
932 *parg++ = *p++;
933 }
b2fc9f3d
GV
934#else
935 for ( ; *p; p++)
936 {
937 if (*p == '"')
938 {
939 /* double preceding escape chars if any */
940 while (escape_char_run > 0)
941 {
942 *parg++ = escape_char;
943 escape_char_run--;
944 }
945 /* escape all quote chars, even at beginning or end */
946 *parg++ = escape_char;
947 }
dbb70029
GM
948 else if (escape_char == '"' && *p == '\\')
949 *parg++ = '\\';
b2fc9f3d
GV
950 *parg++ = *p;
951
952 if (*p == escape_char && escape_char != '"')
953 escape_char_run++;
954 else
955 escape_char_run = 0;
956 }
957 /* double escape chars before enclosing quote */
958 while (escape_char_run > 0)
959 {
960 *parg++ = escape_char;
961 escape_char_run--;
962 }
963#endif
c519b5e1
GV
964 *parg++ = '"';
965 }
966 else
967 {
968 strcpy (parg, *targ);
969 parg += strlen (*targ);
970 }
6cdfb6e6 971 *parg++ = ' ';
c519b5e1 972 targ++;
6cdfb6e6
RS
973 }
974 *--parg = '\0';
177c0ea7 975
6cdfb6e6
RS
976 /* and envp... */
977 arglen = 1;
978 targ = envp;
d9709fde 979 numenv = 1; /* for end null */
6cdfb6e6
RS
980 while (*targ)
981 {
982 arglen += strlen (*targ++) + 1;
d9709fde 983 numenv++;
6cdfb6e6 984 }
d9709fde 985 /* extra env vars... */
177c0ea7 986 sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d",
6cdfb6e6
RS
987 GetCurrentProcessId ());
988 arglen += strlen (ppid_env_var_buffer) + 1;
d9709fde 989 numenv++;
6cdfb6e6 990
d9709fde
GV
991 /* merge env passed in and extra env into one, and sort it. */
992 targ = (char **) alloca (numenv * sizeof (char *));
993 merge_and_sort_env (envp, extra_env, targ);
994
995 /* concatenate env entries. */
c519b5e1 996 env = alloca (arglen);
6cdfb6e6
RS
997 parg = env;
998 while (*targ)
999 {
1000 strcpy (parg, *targ);
1001 parg += strlen (*targ++);
1002 *parg++ = '\0';
1003 }
6cdfb6e6
RS
1004 *parg++ = '\0';
1005 *parg = '\0';
c519b5e1
GV
1006
1007 cp = new_child ();
1008 if (cp == NULL)
1009 {
1010 errno = EAGAIN;
1011 return -1;
1012 }
177c0ea7 1013
6cdfb6e6 1014 /* Now create the process. */
a55a5f3c 1015 if (!create_child (cmdname, cmdline, env, is_gui_app, &pid, cp))
6cdfb6e6 1016 {
c519b5e1 1017 delete_child (cp);
6cdfb6e6 1018 errno = ENOEXEC;
c519b5e1 1019 return -1;
6cdfb6e6 1020 }
177c0ea7 1021
c519b5e1 1022 return pid;
6cdfb6e6
RS
1023}
1024
1025/* Emulate the select call
1026 Wait for available input on any of the given rfds, or timeout if
1027 a timeout is given and no input is detected
b2fc9f3d
GV
1028 wfds and efds are not supported and must be NULL.
1029
1030 For simplicity, we detect the death of child processes here and
1031 synchronously call the SIGCHLD handler. Since it is possible for
1032 children to be created without a corresponding pipe handle from which
1033 to read output, we wait separately on the process handles as well as
1034 the char_avail events for each process pipe. We only call
86143765
RS
1035 wait/reap_process when the process actually terminates.
1036
1037 To reduce the number of places in which Emacs can be hung such that
1038 C-g is not able to interrupt it, we always wait on interrupt_handle
1039 (which is signalled by the input thread when C-g is detected). If we
1040 detect that we were woken up by C-g, we return -1 with errno set to
1041 EINTR as on Unix. */
6cdfb6e6
RS
1042
1043/* From ntterm.c */
1044extern HANDLE keyboard_handle;
86143765
RS
1045
1046/* From w32xfns.c */
1047extern HANDLE interrupt_handle;
1048
6cdfb6e6
RS
1049/* From process.c */
1050extern int proc_buffered_char[];
1051
177c0ea7 1052int
22759c72
KH
1053sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
1054 EMACS_TIME *timeout)
6cdfb6e6
RS
1055{
1056 SELECT_TYPE orfds;
b2fc9f3d
GV
1057 DWORD timeout_ms, start_time;
1058 int i, nh, nc, nr;
6cdfb6e6 1059 DWORD active;
b2fc9f3d
GV
1060 child_process *cp, *cps[MAX_CHILDREN];
1061 HANDLE wait_hnd[MAXDESC + MAX_CHILDREN];
c519b5e1 1062 int fdindex[MAXDESC]; /* mapping from wait handles back to descriptors */
177c0ea7 1063
b2fc9f3d
GV
1064 timeout_ms = timeout ? (timeout->tv_sec * 1000 + timeout->tv_usec / 1000) : INFINITE;
1065
6cdfb6e6 1066 /* If the descriptor sets are NULL but timeout isn't, then just Sleep. */
177c0ea7 1067 if (rfds == NULL && wfds == NULL && efds == NULL && timeout != NULL)
6cdfb6e6 1068 {
b2fc9f3d 1069 Sleep (timeout_ms);
6cdfb6e6
RS
1070 return 0;
1071 }
1072
1073 /* Otherwise, we only handle rfds, so fail otherwise. */
1074 if (rfds == NULL || wfds != NULL || efds != NULL)
1075 {
1076 errno = EINVAL;
1077 return -1;
1078 }
177c0ea7 1079
6cdfb6e6
RS
1080 orfds = *rfds;
1081 FD_ZERO (rfds);
1082 nr = 0;
86143765
RS
1083
1084 /* Always wait on interrupt_handle, to detect C-g (quit). */
1085 wait_hnd[0] = interrupt_handle;
1086 fdindex[0] = -1;
177c0ea7 1087
b2fc9f3d 1088 /* Build a list of pipe handles to wait on. */
86143765 1089 nh = 1;
6cdfb6e6
RS
1090 for (i = 0; i < nfds; i++)
1091 if (FD_ISSET (i, &orfds))
1092 {
1093 if (i == 0)
1094 {
c519b5e1
GV
1095 if (keyboard_handle)
1096 {
1097 /* Handle stdin specially */
1098 wait_hnd[nh] = keyboard_handle;
1099 fdindex[nh] = i;
1100 nh++;
1101 }
6cdfb6e6
RS
1102
1103 /* Check for any emacs-generated input in the queue since
1104 it won't be detected in the wait */
1105 if (detect_input_pending ())
1106 {
1107 FD_SET (i, rfds);
c519b5e1 1108 return 1;
6cdfb6e6
RS
1109 }
1110 }
1111 else
1112 {
c519b5e1
GV
1113 /* Child process and socket input */
1114 cp = fd_info[i].cp;
6cdfb6e6
RS
1115 if (cp)
1116 {
c519b5e1
GV
1117 int current_status = cp->status;
1118
1119 if (current_status == STATUS_READ_ACKNOWLEDGED)
1120 {
1121 /* Tell reader thread which file handle to use. */
1122 cp->fd = i;
1123 /* Wake up the reader thread for this process */
1124 cp->status = STATUS_READ_READY;
1125 if (!SetEvent (cp->char_consumed))
1126 DebPrint (("nt_select.SetEvent failed with "
1127 "%lu for fd %ld\n", GetLastError (), i));
1128 }
1129
1130#ifdef CHECK_INTERLOCK
1131 /* slightly crude cross-checking of interlock between threads */
1132
1133 current_status = cp->status;
1134 if (WaitForSingleObject (cp->char_avail, 0) == WAIT_OBJECT_0)
1135 {
1136 /* char_avail has been signalled, so status (which may
1137 have changed) should indicate read has completed
1138 but has not been acknowledged. */
1139 current_status = cp->status;
b2fc9f3d
GV
1140 if (current_status != STATUS_READ_SUCCEEDED
1141 && current_status != STATUS_READ_FAILED)
c519b5e1
GV
1142 DebPrint (("char_avail set, but read not completed: status %d\n",
1143 current_status));
1144 }
1145 else
1146 {
1147 /* char_avail has not been signalled, so status should
1148 indicate that read is in progress; small possibility
1149 that read has completed but event wasn't yet signalled
1150 when we tested it (because a context switch occurred
1151 or if running on separate CPUs). */
b2fc9f3d
GV
1152 if (current_status != STATUS_READ_READY
1153 && current_status != STATUS_READ_IN_PROGRESS
1154 && current_status != STATUS_READ_SUCCEEDED
1155 && current_status != STATUS_READ_FAILED)
c519b5e1
GV
1156 DebPrint (("char_avail reset, but read status is bad: %d\n",
1157 current_status));
1158 }
1159#endif
1160 wait_hnd[nh] = cp->char_avail;
1161 fdindex[nh] = i;
1162 if (!wait_hnd[nh]) abort ();
1163 nh++;
6cdfb6e6
RS
1164#ifdef FULL_DEBUG
1165 DebPrint (("select waiting on child %d fd %d\n",
1166 cp-child_procs, i));
1167#endif
6cdfb6e6
RS
1168 }
1169 else
1170 {
c519b5e1 1171 /* Unable to find something to wait on for this fd, skip */
ef79fbba
GV
1172
1173 /* Note that this is not a fatal error, and can in fact
1174 happen in unusual circumstances. Specifically, if
1175 sys_spawnve fails, eg. because the program doesn't
1176 exist, and debug-on-error is t so Fsignal invokes a
1177 nested input loop, then the process output pipe is
1178 still included in input_wait_mask with no child_proc
1179 associated with it. (It is removed when the debugger
1180 exits the nested input loop and the error is thrown.) */
1181
c519b5e1 1182 DebPrint (("sys_select: fd %ld is invalid! ignoring\n", i));
6cdfb6e6
RS
1183 }
1184 }
1185 }
b2fc9f3d
GV
1186
1187count_children:
1188 /* Add handles of child processes. */
1189 nc = 0;
1190 for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--)
ef79fbba
GV
1191 /* Some child_procs might be sockets; ignore them. Also some
1192 children may have died already, but we haven't finished reading
1193 the process output; ignore them too. */
1194 if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess
1195 && (cp->fd < 0
1196 || (fd_info[cp->fd].flags & FILE_SEND_SIGCHLD) == 0
1197 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0)
1198 )
b2fc9f3d
GV
1199 {
1200 wait_hnd[nh + nc] = cp->procinfo.hProcess;
1201 cps[nc] = cp;
1202 nc++;
1203 }
177c0ea7 1204
6cdfb6e6 1205 /* Nothing to look for, so we didn't find anything */
177c0ea7 1206 if (nh + nc == 0)
6cdfb6e6 1207 {
22759c72 1208 if (timeout)
b2fc9f3d 1209 Sleep (timeout_ms);
6cdfb6e6
RS
1210 return 0;
1211 }
177c0ea7 1212
b2fc9f3d 1213 start_time = GetTickCount ();
8b031dcc
AI
1214
1215 /* Wait for input or child death to be signalled. If user input is
1216 allowed, then also accept window messages. */
1217 if (FD_ISSET (0, &orfds))
1218 active = MsgWaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms,
1219 QS_ALLINPUT);
1220 else
1221 active = WaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms);
c519b5e1 1222
6cdfb6e6
RS
1223 if (active == WAIT_FAILED)
1224 {
1225 DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n",
b2fc9f3d 1226 nh + nc, timeout_ms, GetLastError ()));
d64b707c 1227 /* don't return EBADF - this causes wait_reading_process_output to
c519b5e1
GV
1228 abort; WAIT_FAILED is returned when single-stepping under
1229 Windows 95 after switching thread focus in debugger, and
1230 possibly at other times. */
1231 errno = EINTR;
6cdfb6e6
RS
1232 return -1;
1233 }
1234 else if (active == WAIT_TIMEOUT)
1235 {
1236 return 0;
1237 }
b2fc9f3d
GV
1238 else if (active >= WAIT_OBJECT_0
1239 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
6cdfb6e6
RS
1240 {
1241 active -= WAIT_OBJECT_0;
1242 }
b2fc9f3d
GV
1243 else if (active >= WAIT_ABANDONED_0
1244 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
6cdfb6e6
RS
1245 {
1246 active -= WAIT_ABANDONED_0;
1247 }
b2fc9f3d
GV
1248 else
1249 abort ();
6cdfb6e6 1250
c519b5e1
GV
1251 /* Loop over all handles after active (now officially documented as
1252 being the first signalled handle in the array). We do this to
1253 ensure fairness, so that all channels with data available will be
1254 processed - otherwise higher numbered channels could be starved. */
1255 do
6cdfb6e6 1256 {
8b031dcc
AI
1257 if (active == nh + nc)
1258 {
1259 /* There are messages in the lisp thread's queue; we must
1260 drain the queue now to ensure they are processed promptly,
1261 because if we don't do so, we will not be woken again until
1262 further messages arrive.
1263
1264 NB. If ever we allow window message procedures to callback
1265 into lisp, we will need to ensure messages are dispatched
1266 at a safe time for lisp code to be run (*), and we may also
1267 want to provide some hooks in the dispatch loop to cater
1268 for modeless dialogs created by lisp (ie. to register
1269 window handles to pass to IsDialogMessage).
1270
1271 (*) Note that MsgWaitForMultipleObjects above is an
1272 internal dispatch point for messages that are sent to
1273 windows created by this thread. */
1274 drain_message_queue ();
1275 }
1276 else if (active >= nh)
b2fc9f3d
GV
1277 {
1278 cp = cps[active - nh];
ef79fbba
GV
1279
1280 /* We cannot always signal SIGCHLD immediately; if we have not
1281 finished reading the process output, we must delay sending
1282 SIGCHLD until we do. */
1283
1284 if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_AT_EOF) == 0)
1285 fd_info[cp->fd].flags |= FILE_SEND_SIGCHLD;
b2fc9f3d 1286 /* SIG_DFL for SIGCHLD is ignore */
ef79fbba
GV
1287 else if (sig_handlers[SIGCHLD] != SIG_DFL &&
1288 sig_handlers[SIGCHLD] != SIG_IGN)
b2fc9f3d
GV
1289 {
1290#ifdef FULL_DEBUG
1291 DebPrint (("select calling SIGCHLD handler for pid %d\n",
1292 cp->pid));
1293#endif
1294 dead_child = cp;
1295 sig_handlers[SIGCHLD] (SIGCHLD);
1296 dead_child = NULL;
1297 }
1298 }
86143765
RS
1299 else if (fdindex[active] == -1)
1300 {
1301 /* Quit (C-g) was detected. */
1302 errno = EINTR;
1303 return -1;
1304 }
b2fc9f3d 1305 else if (fdindex[active] == 0)
c519b5e1
GV
1306 {
1307 /* Keyboard input available */
1308 FD_SET (0, rfds);
6cdfb6e6 1309 nr++;
c519b5e1 1310 }
6cdfb6e6 1311 else
c519b5e1 1312 {
b2fc9f3d
GV
1313 /* must be a socket or pipe - read ahead should have
1314 completed, either succeeding or failing. */
c519b5e1
GV
1315 FD_SET (fdindex[active], rfds);
1316 nr++;
c519b5e1
GV
1317 }
1318
b2fc9f3d
GV
1319 /* Even though wait_reading_process_output only reads from at most
1320 one channel, we must process all channels here so that we reap
1321 all children that have died. */
1322 while (++active < nh + nc)
c519b5e1
GV
1323 if (WaitForSingleObject (wait_hnd[active], 0) == WAIT_OBJECT_0)
1324 break;
b2fc9f3d
GV
1325 } while (active < nh + nc);
1326
1327 /* If no input has arrived and timeout hasn't expired, wait again. */
1328 if (nr == 0)
1329 {
1330 DWORD elapsed = GetTickCount () - start_time;
1331
1332 if (timeout_ms > elapsed) /* INFINITE is MAX_UINT */
1333 {
1334 if (timeout_ms != INFINITE)
1335 timeout_ms -= elapsed;
1336 goto count_children;
1337 }
1338 }
c519b5e1 1339
6cdfb6e6
RS
1340 return nr;
1341}
1342
c519b5e1 1343/* Substitute for certain kill () operations */
b2fc9f3d
GV
1344
1345static BOOL CALLBACK
42c95ffb 1346find_child_console (HWND hwnd, LPARAM arg)
b2fc9f3d 1347{
42c95ffb 1348 child_process * cp = (child_process *) arg;
b2fc9f3d
GV
1349 DWORD thread_id;
1350 DWORD process_id;
1351
1352 thread_id = GetWindowThreadProcessId (hwnd, &process_id);
1353 if (process_id == cp->procinfo.dwProcessId)
1354 {
1355 char window_class[32];
1356
1357 GetClassName (hwnd, window_class, sizeof (window_class));
1358 if (strcmp (window_class,
1359 (os_subtype == OS_WIN95)
1360 ? "tty"
1361 : "ConsoleWindowClass") == 0)
1362 {
1363 cp->hwnd = hwnd;
1364 return FALSE;
1365 }
1366 }
1367 /* keep looking */
1368 return TRUE;
1369}
1370
177c0ea7 1371int
c519b5e1 1372sys_kill (int pid, int sig)
6cdfb6e6
RS
1373{
1374 child_process *cp;
c519b5e1
GV
1375 HANDLE proc_hand;
1376 int need_to_free = 0;
1377 int rc = 0;
177c0ea7 1378
6cdfb6e6
RS
1379 /* Only handle signals that will result in the process dying */
1380 if (sig != SIGINT && sig != SIGKILL && sig != SIGQUIT && sig != SIGHUP)
1381 {
1382 errno = EINVAL;
1383 return -1;
1384 }
c519b5e1 1385
6cdfb6e6
RS
1386 cp = find_child_pid (pid);
1387 if (cp == NULL)
1388 {
c519b5e1
GV
1389 proc_hand = OpenProcess (PROCESS_TERMINATE, 0, pid);
1390 if (proc_hand == NULL)
1391 {
1392 errno = EPERM;
1393 return -1;
1394 }
1395 need_to_free = 1;
1396 }
1397 else
1398 {
1399 proc_hand = cp->procinfo.hProcess;
1400 pid = cp->procinfo.dwProcessId;
b2fc9f3d
GV
1401
1402 /* Try to locate console window for process. */
1403 EnumWindows (find_child_console, (LPARAM) cp);
6cdfb6e6 1404 }
177c0ea7 1405
a55a5f3c 1406 if (sig == SIGINT || sig == SIGQUIT)
6cdfb6e6 1407 {
b2fc9f3d
GV
1408 if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
1409 {
1410 BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0);
a55a5f3c
AI
1411 /* Fake Ctrl-C for SIGINT, and Ctrl-Break for SIGQUIT. */
1412 BYTE vk_break_code = (sig == SIGINT) ? 'C' : VK_CANCEL;
b2fc9f3d
GV
1413 BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
1414 HWND foreground_window;
1415
1416 if (break_scan_code == 0)
1417 {
a55a5f3c 1418 /* Fake Ctrl-C for SIGQUIT if we can't manage Ctrl-Break. */
b2fc9f3d
GV
1419 vk_break_code = 'C';
1420 break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
1421 }
1422
1423 foreground_window = GetForegroundWindow ();
f446016f 1424 if (foreground_window)
b2fc9f3d 1425 {
f446016f
AI
1426 /* NT 5.0, and apparently also Windows 98, will not allow
1427 a Window to be set to foreground directly without the
1428 user's involvement. The workaround is to attach
1429 ourselves to the thread that owns the foreground
1430 window, since that is the only thread that can set the
1431 foreground window. */
1432 DWORD foreground_thread, child_thread;
1433 foreground_thread =
1434 GetWindowThreadProcessId (foreground_window, NULL);
1435 if (foreground_thread == GetCurrentThreadId ()
1436 || !AttachThreadInput (GetCurrentThreadId (),
1437 foreground_thread, TRUE))
1438 foreground_thread = 0;
1439
1440 child_thread = GetWindowThreadProcessId (cp->hwnd, NULL);
1441 if (child_thread == GetCurrentThreadId ()
1442 || !AttachThreadInput (GetCurrentThreadId (),
1443 child_thread, TRUE))
1444 child_thread = 0;
1445
1446 /* Set the foreground window to the child. */
1447 if (SetForegroundWindow (cp->hwnd))
1448 {
1449 /* Generate keystrokes as if user had typed Ctrl-Break or
1450 Ctrl-C. */
1451 keybd_event (VK_CONTROL, control_scan_code, 0, 0);
1452 keybd_event (vk_break_code, break_scan_code,
1453 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0);
1454 keybd_event (vk_break_code, break_scan_code,
1455 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY)
1456 | KEYEVENTF_KEYUP, 0);
1457 keybd_event (VK_CONTROL, control_scan_code,
1458 KEYEVENTF_KEYUP, 0);
1459
1460 /* Sleep for a bit to give time for Emacs frame to respond
1461 to focus change events (if Emacs was active app). */
1462 Sleep (100);
1463
1464 SetForegroundWindow (foreground_window);
1465 }
1466 /* Detach from the foreground and child threads now that
1467 the foreground switching is over. */
1468 if (foreground_thread)
1469 AttachThreadInput (GetCurrentThreadId (),
1470 foreground_thread, FALSE);
1471 if (child_thread)
1472 AttachThreadInput (GetCurrentThreadId (),
1473 child_thread, FALSE);
1474 }
1475 }
c519b5e1 1476 /* Ctrl-Break is NT equivalent of SIGINT. */
b2fc9f3d 1477 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid))
6cdfb6e6 1478 {
c519b5e1 1479 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
6cdfb6e6
RS
1480 "for pid %lu\n", GetLastError (), pid));
1481 errno = EINVAL;
c519b5e1 1482 rc = -1;
80874ef7 1483 }
6cdfb6e6
RS
1484 }
1485 else
1486 {
b2fc9f3d
GV
1487 if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
1488 {
1489#if 1
1490 if (os_subtype == OS_WIN95)
1491 {
1492/*
1493 Another possibility is to try terminating the VDM out-right by
1494 calling the Shell VxD (id 0x17) V86 interface, function #4
1495 "SHELL_Destroy_VM", ie.
1496
1497 mov edx,4
1498 mov ebx,vm_handle
1499 call shellapi
1500
1501 First need to determine the current VM handle, and then arrange for
1502 the shellapi call to be made from the system vm (by using
1503 Switch_VM_and_callback).
1504
1505 Could try to invoke DestroyVM through CallVxD.
1506
1507*/
ef79fbba
GV
1508#if 0
1509 /* On Win95, posting WM_QUIT causes the 16-bit subsystem
1510 to hang when cmdproxy is used in conjunction with
1511 command.com for an interactive shell. Posting
1512 WM_CLOSE pops up a dialog that, when Yes is selected,
1513 does the same thing. TerminateProcess is also less
1514 than ideal in that subprocesses tend to stick around
1515 until the machine is shutdown, but at least it
1516 doesn't freeze the 16-bit subsystem. */
b2fc9f3d 1517 PostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
ef79fbba
GV
1518#endif
1519 if (!TerminateProcess (proc_hand, 0xff))
1520 {
1521 DebPrint (("sys_kill.TerminateProcess returned %d "
1522 "for pid %lu\n", GetLastError (), pid));
1523 errno = EINVAL;
1524 rc = -1;
1525 }
b2fc9f3d
GV
1526 }
1527 else
1528#endif
1529 PostMessage (cp->hwnd, WM_CLOSE, 0, 0);
1530 }
fbd6baed 1531 /* Kill the process. On W32 this doesn't kill child processes
8eae7766 1532 so it doesn't work very well for shells which is why it's not
b2fc9f3d
GV
1533 used in every case. */
1534 else if (!TerminateProcess (proc_hand, 0xff))
6cdfb6e6 1535 {
c519b5e1 1536 DebPrint (("sys_kill.TerminateProcess returned %d "
6cdfb6e6
RS
1537 "for pid %lu\n", GetLastError (), pid));
1538 errno = EINVAL;
c519b5e1 1539 rc = -1;
6cdfb6e6
RS
1540 }
1541 }
c519b5e1
GV
1542
1543 if (need_to_free)
1544 CloseHandle (proc_hand);
1545
1546 return rc;
6cdfb6e6
RS
1547}
1548
09522567 1549/* extern int report_file_error (char *, Lisp_Object); */
c519b5e1
GV
1550
1551/* The following two routines are used to manipulate stdin, stdout, and
1552 stderr of our child processes.
1553
1554 Assuming that in, out, and err are *not* inheritable, we make them
1555 stdin, stdout, and stderr of the child as follows:
1556
1557 - Save the parent's current standard handles.
1558 - Set the std handles to inheritable duplicates of the ones being passed in.
1559 (Note that _get_osfhandle() is an io.h procedure that retrieves the
1560 NT file handle for a crt file descriptor.)
1561 - Spawn the child, which inherits in, out, and err as stdin,
1562 stdout, and stderr. (see Spawnve)
1563 - Close the std handles passed to the child.
1564 - Reset the parent's standard handles to the saved handles.
1565 (see reset_standard_handles)
1566 We assume that the caller closes in, out, and err after calling us. */
1567
1568void
1569prepare_standard_handles (int in, int out, int err, HANDLE handles[3])
6cdfb6e6 1570{
c519b5e1
GV
1571 HANDLE parent;
1572 HANDLE newstdin, newstdout, newstderr;
1573
1574 parent = GetCurrentProcess ();
1575
1576 handles[0] = GetStdHandle (STD_INPUT_HANDLE);
1577 handles[1] = GetStdHandle (STD_OUTPUT_HANDLE);
1578 handles[2] = GetStdHandle (STD_ERROR_HANDLE);
1579
1580 /* make inheritable copies of the new handles */
177c0ea7 1581 if (!DuplicateHandle (parent,
c519b5e1
GV
1582 (HANDLE) _get_osfhandle (in),
1583 parent,
177c0ea7
JB
1584 &newstdin,
1585 0,
1586 TRUE,
c519b5e1
GV
1587 DUPLICATE_SAME_ACCESS))
1588 report_file_error ("Duplicating input handle for child", Qnil);
177c0ea7 1589
c519b5e1
GV
1590 if (!DuplicateHandle (parent,
1591 (HANDLE) _get_osfhandle (out),
1592 parent,
1593 &newstdout,
1594 0,
1595 TRUE,
1596 DUPLICATE_SAME_ACCESS))
1597 report_file_error ("Duplicating output handle for child", Qnil);
177c0ea7 1598
c519b5e1
GV
1599 if (!DuplicateHandle (parent,
1600 (HANDLE) _get_osfhandle (err),
1601 parent,
1602 &newstderr,
1603 0,
1604 TRUE,
1605 DUPLICATE_SAME_ACCESS))
1606 report_file_error ("Duplicating error handle for child", Qnil);
1607
1608 /* and store them as our std handles */
1609 if (!SetStdHandle (STD_INPUT_HANDLE, newstdin))
1610 report_file_error ("Changing stdin handle", Qnil);
177c0ea7 1611
c519b5e1
GV
1612 if (!SetStdHandle (STD_OUTPUT_HANDLE, newstdout))
1613 report_file_error ("Changing stdout handle", Qnil);
1614
1615 if (!SetStdHandle (STD_ERROR_HANDLE, newstderr))
1616 report_file_error ("Changing stderr handle", Qnil);
1617}
1618
1619void
1620reset_standard_handles (int in, int out, int err, HANDLE handles[3])
1621{
1622 /* close the duplicated handles passed to the child */
1623 CloseHandle (GetStdHandle (STD_INPUT_HANDLE));
1624 CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE));
1625 CloseHandle (GetStdHandle (STD_ERROR_HANDLE));
1626
1627 /* now restore parent's saved std handles */
1628 SetStdHandle (STD_INPUT_HANDLE, handles[0]);
1629 SetStdHandle (STD_OUTPUT_HANDLE, handles[1]);
1630 SetStdHandle (STD_ERROR_HANDLE, handles[2]);
6cdfb6e6 1631}
c519b5e1 1632
b2fc9f3d
GV
1633void
1634set_process_dir (char * dir)
1635{
1636 process_dir = dir;
1637}
1638
a11e68d0
RS
1639#ifdef HAVE_SOCKETS
1640
1641/* To avoid problems with winsock implementations that work over dial-up
1642 connections causing or requiring a connection to exist while Emacs is
1643 running, Emacs no longer automatically loads winsock on startup if it
1644 is present. Instead, it will be loaded when open-network-stream is
1645 first called.
1646
1647 To allow full control over when winsock is loaded, we provide these
1648 two functions to dynamically load and unload winsock. This allows
1649 dial-up users to only be connected when they actually need to use
1650 socket services. */
1651
1652/* From nt.c */
1653extern HANDLE winsock_lib;
1654extern BOOL term_winsock (void);
1655extern BOOL init_winsock (int load_now);
1656
1657extern Lisp_Object Vsystem_name;
1658
fbd6baed 1659DEFUN ("w32-has-winsock", Fw32_has_winsock, Sw32_has_winsock, 0, 1, 0,
33f09670
JR
1660 doc: /* Test for presence of the Windows socket library `winsock'.
1661Returns non-nil if winsock support is present, nil otherwise.
1662
1663If the optional argument LOAD-NOW is non-nil, the winsock library is
1664also loaded immediately if not already loaded. If winsock is loaded,
1665the winsock local hostname is returned (since this may be different from
1666the value of `system-name' and should supplant it), otherwise t is
1667returned to indicate winsock support is present. */)
a11e68d0
RS
1668 (load_now)
1669 Lisp_Object load_now;
1670{
1671 int have_winsock;
1672
1673 have_winsock = init_winsock (!NILP (load_now));
1674 if (have_winsock)
1675 {
1676 if (winsock_lib != NULL)
1677 {
1678 /* Return new value for system-name. The best way to do this
1679 is to call init_system_name, saving and restoring the
1680 original value to avoid side-effects. */
1681 Lisp_Object orig_hostname = Vsystem_name;
1682 Lisp_Object hostname;
1683
1684 init_system_name ();
1685 hostname = Vsystem_name;
1686 Vsystem_name = orig_hostname;
1687 return hostname;
1688 }
1689 return Qt;
1690 }
1691 return Qnil;
1692}
1693
fbd6baed 1694DEFUN ("w32-unload-winsock", Fw32_unload_winsock, Sw32_unload_winsock,
a11e68d0 1695 0, 0, 0,
33f09670
JR
1696 doc: /* Unload the Windows socket library `winsock' if loaded.
1697This is provided to allow dial-up socket connections to be disconnected
1698when no longer needed. Returns nil without unloading winsock if any
1699socket connections still exist. */)
a11e68d0
RS
1700 ()
1701{
1702 return term_winsock () ? Qt : Qnil;
1703}
1704
1705#endif /* HAVE_SOCKETS */
1706
93fdf2f8 1707\f
b2fc9f3d
GV
1708/* Some miscellaneous functions that are Windows specific, but not GUI
1709 specific (ie. are applicable in terminal or batch mode as well). */
1710
1711/* lifted from fileio.c */
1712#define CORRECT_DIR_SEPS(s) \
1713 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
1714 else unixtodos_filename (s); \
1715 } while (0)
1716
1717DEFUN ("w32-short-file-name", Fw32_short_file_name, Sw32_short_file_name, 1, 1, 0,
33f09670
JR
1718 doc: /* Return the short file name version (8.3) of the full path of FILENAME.
1719If FILENAME does not exist, return nil.
1720All path elements in FILENAME are converted to their short names. */)
b2fc9f3d
GV
1721 (filename)
1722 Lisp_Object filename;
1723{
1724 char shortname[MAX_PATH];
1725
b7826503 1726 CHECK_STRING (filename);
b2fc9f3d
GV
1727
1728 /* first expand it. */
1729 filename = Fexpand_file_name (filename, Qnil);
1730
1731 /* luckily, this returns the short version of each element in the path. */
d5db4077 1732 if (GetShortPathName (SDATA (filename), shortname, MAX_PATH) == 0)
b2fc9f3d
GV
1733 return Qnil;
1734
1735 CORRECT_DIR_SEPS (shortname);
1736
1737 return build_string (shortname);
1738}
1739
1740
1741DEFUN ("w32-long-file-name", Fw32_long_file_name, Sw32_long_file_name,
1742 1, 1, 0,
33f09670
JR
1743 doc: /* Return the long file name version of the full path of FILENAME.
1744If FILENAME does not exist, return nil.
1745All path elements in FILENAME are converted to their long names. */)
b2fc9f3d
GV
1746 (filename)
1747 Lisp_Object filename;
1748{
1749 char longname[ MAX_PATH ];
1750
b7826503 1751 CHECK_STRING (filename);
b2fc9f3d
GV
1752
1753 /* first expand it. */
1754 filename = Fexpand_file_name (filename, Qnil);
1755
d5db4077 1756 if (!w32_get_long_filename (SDATA (filename), longname, MAX_PATH))
b2fc9f3d
GV
1757 return Qnil;
1758
1759 CORRECT_DIR_SEPS (longname);
1760
1761 return build_string (longname);
1762}
1763
33f09670
JR
1764DEFUN ("w32-set-process-priority", Fw32_set_process_priority,
1765 Sw32_set_process_priority, 2, 2, 0,
1766 doc: /* Set the priority of PROCESS to PRIORITY.
1767If PROCESS is nil, the priority of Emacs is changed, otherwise the
1768priority of the process whose pid is PROCESS is changed.
1769PRIORITY should be one of the symbols high, normal, or low;
1770any other symbol will be interpreted as normal.
1771
1772If successful, the return value is t, otherwise nil. */)
b2fc9f3d
GV
1773 (process, priority)
1774 Lisp_Object process, priority;
1775{
1776 HANDLE proc_handle = GetCurrentProcess ();
1777 DWORD priority_class = NORMAL_PRIORITY_CLASS;
1778 Lisp_Object result = Qnil;
1779
b7826503 1780 CHECK_SYMBOL (priority);
b2fc9f3d
GV
1781
1782 if (!NILP (process))
1783 {
1784 DWORD pid;
1785 child_process *cp;
1786
b7826503 1787 CHECK_NUMBER (process);
b2fc9f3d
GV
1788
1789 /* Allow pid to be an internally generated one, or one obtained
1790 externally. This is necessary because real pids on Win95 are
1791 negative. */
1792
1793 pid = XINT (process);
1794 cp = find_child_pid (pid);
1795 if (cp != NULL)
1796 pid = cp->procinfo.dwProcessId;
1797
1798 proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
1799 }
1800
1801 if (EQ (priority, Qhigh))
1802 priority_class = HIGH_PRIORITY_CLASS;
1803 else if (EQ (priority, Qlow))
1804 priority_class = IDLE_PRIORITY_CLASS;
1805
1806 if (proc_handle != NULL)
1807 {
1808 if (SetPriorityClass (proc_handle, priority_class))
1809 result = Qt;
1810 if (!NILP (process))
1811 CloseHandle (proc_handle);
1812 }
1813
1814 return result;
1815}
1816
1817
33f09670
JR
1818DEFUN ("w32-get-locale-info", Fw32_get_locale_info,
1819 Sw32_get_locale_info, 1, 2, 0,
1820 doc: /* Return information about the Windows locale LCID.
1821By default, return a three letter locale code which encodes the default
1822language as the first two characters, and the country or regionial variant
1823as the third letter. For example, ENU refers to `English (United States)',
1824while ENC means `English (Canadian)'.
1825
1826If the optional argument LONGFORM is t, the long form of the locale
1827name is returned, e.g. `English (United States)' instead; if LONGFORM
1828is a number, it is interpreted as an LCTYPE constant and the corresponding
1829locale information is returned.
1830
1831If LCID (a 16-bit number) is not a valid locale, the result is nil. */)
b2fc9f3d
GV
1832 (lcid, longform)
1833 Lisp_Object lcid, longform;
1834{
1835 int got_abbrev;
1836 int got_full;
1837 char abbrev_name[32] = { 0 };
1838 char full_name[256] = { 0 };
1839
b7826503 1840 CHECK_NUMBER (lcid);
b2fc9f3d
GV
1841
1842 if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
1843 return Qnil;
1844
1845 if (NILP (longform))
1846 {
1847 got_abbrev = GetLocaleInfo (XINT (lcid),
1848 LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
1849 abbrev_name, sizeof (abbrev_name));
1850 if (got_abbrev)
1851 return build_string (abbrev_name);
1852 }
0eaf5926 1853 else if (EQ (longform, Qt))
b2fc9f3d
GV
1854 {
1855 got_full = GetLocaleInfo (XINT (lcid),
1856 LOCALE_SLANGUAGE | LOCALE_USE_CP_ACP,
1857 full_name, sizeof (full_name));
1858 if (got_full)
1859 return build_string (full_name);
1860 }
0eaf5926
GV
1861 else if (NUMBERP (longform))
1862 {
1863 got_full = GetLocaleInfo (XINT (lcid),
1864 XINT (longform),
1865 full_name, sizeof (full_name));
1866 if (got_full)
1867 return make_unibyte_string (full_name, got_full);
1868 }
b2fc9f3d
GV
1869
1870 return Qnil;
1871}
1872
1873
33f09670
JR
1874DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id,
1875 Sw32_get_current_locale_id, 0, 0, 0,
1876 doc: /* Return Windows locale id for current locale setting.
1877This is a numerical value; use `w32-get-locale-info' to convert to a
1878human-readable form. */)
b2fc9f3d
GV
1879 ()
1880{
1881 return make_number (GetThreadLocale ());
1882}
1883
ef79fbba
GV
1884DWORD int_from_hex (char * s)
1885{
1886 DWORD val = 0;
1887 static char hex[] = "0123456789abcdefABCDEF";
1888 char * p;
1889
1890 while (*s && (p = strchr(hex, *s)) != NULL)
1891 {
1892 unsigned digit = p - hex;
1893 if (digit > 15)
1894 digit -= 6;
1895 val = val * 16 + digit;
1896 s++;
1897 }
1898 return val;
1899}
1900
1901/* We need to build a global list, since the EnumSystemLocale callback
1902 function isn't given a context pointer. */
1903Lisp_Object Vw32_valid_locale_ids;
1904
1905BOOL CALLBACK enum_locale_fn (LPTSTR localeNum)
1906{
1907 DWORD id = int_from_hex (localeNum);
1908 Vw32_valid_locale_ids = Fcons (make_number (id), Vw32_valid_locale_ids);
1909 return TRUE;
1910}
1911
33f09670
JR
1912DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids,
1913 Sw32_get_valid_locale_ids, 0, 0, 0,
1914 doc: /* Return list of all valid Windows locale ids.
1915Each id is a numerical value; use `w32-get-locale-info' to convert to a
1916human-readable form. */)
ef79fbba
GV
1917 ()
1918{
1919 Vw32_valid_locale_ids = Qnil;
1920
1921 EnumSystemLocales (enum_locale_fn, LCID_SUPPORTED);
1922
1923 Vw32_valid_locale_ids = Fnreverse (Vw32_valid_locale_ids);
1924 return Vw32_valid_locale_ids;
1925}
1926
b2fc9f3d
GV
1927
1928DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id, Sw32_get_default_locale_id, 0, 1, 0,
33f09670
JR
1929 doc: /* Return Windows locale id for default locale setting.
1930By default, the system default locale setting is returned; if the optional
1931parameter USERP is non-nil, the user default locale setting is returned.
1932This is a numerical value; use `w32-get-locale-info' to convert to a
1933human-readable form. */)
b2fc9f3d
GV
1934 (userp)
1935 Lisp_Object userp;
1936{
1937 if (NILP (userp))
1938 return make_number (GetSystemDefaultLCID ());
1939 return make_number (GetUserDefaultLCID ());
1940}
1941
177c0ea7 1942
b2fc9f3d 1943DEFUN ("w32-set-current-locale", Fw32_set_current_locale, Sw32_set_current_locale, 1, 1, 0,
33f09670
JR
1944 doc: /* Make Windows locale LCID be the current locale setting for Emacs.
1945If successful, the new locale id is returned, otherwise nil. */)
b2fc9f3d
GV
1946 (lcid)
1947 Lisp_Object lcid;
1948{
b7826503 1949 CHECK_NUMBER (lcid);
b2fc9f3d
GV
1950
1951 if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
1952 return Qnil;
1953
1954 if (!SetThreadLocale (XINT (lcid)))
1955 return Qnil;
1956
ef79fbba
GV
1957 /* Need to set input thread locale if present. */
1958 if (dwWindowsThreadId)
1959 /* Reply is not needed. */
1960 PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0);
1961
b2fc9f3d
GV
1962 return make_number (GetThreadLocale ());
1963}
1964
0eaf5926
GV
1965
1966/* We need to build a global list, since the EnumCodePages callback
1967 function isn't given a context pointer. */
1968Lisp_Object Vw32_valid_codepages;
1969
1970BOOL CALLBACK enum_codepage_fn (LPTSTR codepageNum)
1971{
1972 DWORD id = atoi (codepageNum);
1973 Vw32_valid_codepages = Fcons (make_number (id), Vw32_valid_codepages);
1974 return TRUE;
1975}
1976
33f09670
JR
1977DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages,
1978 Sw32_get_valid_codepages, 0, 0, 0,
1979 doc: /* Return list of all valid Windows codepages. */)
0eaf5926
GV
1980 ()
1981{
1982 Vw32_valid_codepages = Qnil;
1983
1984 EnumSystemCodePages (enum_codepage_fn, CP_SUPPORTED);
1985
1986 Vw32_valid_codepages = Fnreverse (Vw32_valid_codepages);
1987 return Vw32_valid_codepages;
1988}
1989
1990
33f09670
JR
1991DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage,
1992 Sw32_get_console_codepage, 0, 0, 0,
1993 doc: /* Return current Windows codepage for console input. */)
0eaf5926
GV
1994 ()
1995{
1996 return make_number (GetConsoleCP ());
1997}
1998
177c0ea7 1999
33f09670
JR
2000DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage,
2001 Sw32_set_console_codepage, 1, 1, 0,
2002 doc: /* Make Windows codepage CP be the current codepage setting for Emacs.
2003The codepage setting affects keyboard input and display in tty mode.
2004If successful, the new CP is returned, otherwise nil. */)
0eaf5926
GV
2005 (cp)
2006 Lisp_Object cp;
2007{
b7826503 2008 CHECK_NUMBER (cp);
0eaf5926
GV
2009
2010 if (!IsValidCodePage (XINT (cp)))
2011 return Qnil;
2012
2013 if (!SetConsoleCP (XINT (cp)))
2014 return Qnil;
2015
2016 return make_number (GetConsoleCP ());
2017}
2018
2019
33f09670
JR
2020DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage,
2021 Sw32_get_console_output_codepage, 0, 0, 0,
2022 doc: /* Return current Windows codepage for console output. */)
0eaf5926
GV
2023 ()
2024{
2025 return make_number (GetConsoleOutputCP ());
2026}
2027
177c0ea7 2028
33f09670
JR
2029DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage,
2030 Sw32_set_console_output_codepage, 1, 1, 0,
2031 doc: /* Make Windows codepage CP be the current codepage setting for Emacs.
2032The codepage setting affects keyboard input and display in tty mode.
2033If successful, the new CP is returned, otherwise nil. */)
0eaf5926
GV
2034 (cp)
2035 Lisp_Object cp;
2036{
b7826503 2037 CHECK_NUMBER (cp);
0eaf5926
GV
2038
2039 if (!IsValidCodePage (XINT (cp)))
2040 return Qnil;
2041
2042 if (!SetConsoleOutputCP (XINT (cp)))
2043 return Qnil;
2044
2045 return make_number (GetConsoleOutputCP ());
2046}
2047
2048
33f09670
JR
2049DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset,
2050 Sw32_get_codepage_charset, 1, 1, 0,
2051 doc: /* Return charset of codepage CP.
2052Returns nil if the codepage is not valid. */)
0eaf5926
GV
2053 (cp)
2054 Lisp_Object cp;
2055{
2056 CHARSETINFO info;
2057
b7826503 2058 CHECK_NUMBER (cp);
0eaf5926
GV
2059
2060 if (!IsValidCodePage (XINT (cp)))
2061 return Qnil;
2062
2063 if (TranslateCharsetInfo ((DWORD *) XINT (cp), &info, TCI_SRCCODEPAGE))
2064 return make_number (info.ciCharset);
2065
2066 return Qnil;
2067}
2068
2069
33f09670
JR
2070DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts,
2071 Sw32_get_valid_keyboard_layouts, 0, 0, 0,
2072 doc: /* Return list of Windows keyboard languages and layouts.
2073The return value is a list of pairs of language id and layout id. */)
0eaf5926
GV
2074 ()
2075{
2076 int num_layouts = GetKeyboardLayoutList (0, NULL);
2077 HKL * layouts = (HKL *) alloca (num_layouts * sizeof (HKL));
2078 Lisp_Object obj = Qnil;
2079
2080 if (GetKeyboardLayoutList (num_layouts, layouts) == num_layouts)
2081 {
2082 while (--num_layouts >= 0)
2083 {
2084 DWORD kl = (DWORD) layouts[num_layouts];
2085
2086 obj = Fcons (Fcons (make_number (kl & 0xffff),
2087 make_number ((kl >> 16) & 0xffff)),
2088 obj);
2089 }
2090 }
2091
2092 return obj;
2093}
2094
2095
33f09670
JR
2096DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout,
2097 Sw32_get_keyboard_layout, 0, 0, 0,
2098 doc: /* Return current Windows keyboard language and layout.
2099The return value is the cons of the language id and the layout id. */)
0eaf5926
GV
2100 ()
2101{
2102 DWORD kl = (DWORD) GetKeyboardLayout (dwWindowsThreadId);
2103
2104 return Fcons (make_number (kl & 0xffff),
2105 make_number ((kl >> 16) & 0xffff));
2106}
2107
177c0ea7 2108
33f09670
JR
2109DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout,
2110 Sw32_set_keyboard_layout, 1, 1, 0,
2111 doc: /* Make LAYOUT be the current keyboard layout for Emacs.
2112The keyboard layout setting affects interpretation of keyboard input.
2113If successful, the new layout id is returned, otherwise nil. */)
0eaf5926
GV
2114 (layout)
2115 Lisp_Object layout;
2116{
2117 DWORD kl;
2118
b7826503 2119 CHECK_CONS (layout);
f4532092
AI
2120 CHECK_NUMBER_CAR (layout);
2121 CHECK_NUMBER_CDR (layout);
0eaf5926 2122
8e713be6
KR
2123 kl = (XINT (XCAR (layout)) & 0xffff)
2124 | (XINT (XCDR (layout)) << 16);
0eaf5926
GV
2125
2126 /* Synchronize layout with input thread. */
2127 if (dwWindowsThreadId)
2128 {
2129 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETKEYBOARDLAYOUT,
2130 (WPARAM) kl, 0))
2131 {
2132 MSG msg;
2133 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
2134
2135 if (msg.wParam == 0)
2136 return Qnil;
2137 }
2138 }
2139 else if (!ActivateKeyboardLayout ((HKL) kl, 0))
2140 return Qnil;
2141
2142 return Fw32_get_keyboard_layout ();
2143}
2144
b2fc9f3d 2145\f
93fdf2f8
RS
2146syms_of_ntproc ()
2147{
b2fc9f3d
GV
2148 Qhigh = intern ("high");
2149 Qlow = intern ("low");
af621bc3
EZ
2150 staticpro (&Qhigh);
2151 staticpro (&Qlow);
b2fc9f3d 2152
a11e68d0 2153#ifdef HAVE_SOCKETS
fbd6baed
GV
2154 defsubr (&Sw32_has_winsock);
2155 defsubr (&Sw32_unload_winsock);
a11e68d0 2156#endif
b2fc9f3d
GV
2157 defsubr (&Sw32_short_file_name);
2158 defsubr (&Sw32_long_file_name);
2159 defsubr (&Sw32_set_process_priority);
2160 defsubr (&Sw32_get_locale_info);
2161 defsubr (&Sw32_get_current_locale_id);
2162 defsubr (&Sw32_get_default_locale_id);
ef79fbba 2163 defsubr (&Sw32_get_valid_locale_ids);
b2fc9f3d 2164 defsubr (&Sw32_set_current_locale);
a11e68d0 2165
0eaf5926
GV
2166 defsubr (&Sw32_get_console_codepage);
2167 defsubr (&Sw32_set_console_codepage);
2168 defsubr (&Sw32_get_console_output_codepage);
2169 defsubr (&Sw32_set_console_output_codepage);
2170 defsubr (&Sw32_get_valid_codepages);
2171 defsubr (&Sw32_get_codepage_charset);
2172
2173 defsubr (&Sw32_get_valid_keyboard_layouts);
2174 defsubr (&Sw32_get_keyboard_layout);
2175 defsubr (&Sw32_set_keyboard_layout);
2176
fbd6baed 2177 DEFVAR_LISP ("w32-quote-process-args", &Vw32_quote_process_args,
33f09670
JR
2178 doc: /* Non-nil enables quoting of process arguments to ensure correct parsing.
2179Because Windows does not directly pass argv arrays to child processes,
2180programs have to reconstruct the argv array by parsing the command
2181line string. For an argument to contain a space, it must be enclosed
2182in double quotes or it will be parsed as multiple arguments.
2183
2184If the value is a character, that character will be used to escape any
2185quote characters that appear, otherwise a suitable escape character
2186will be chosen based on the type of the program. */);
b2fc9f3d 2187 Vw32_quote_process_args = Qt;
817abdf6 2188
fbd6baed
GV
2189 DEFVAR_LISP ("w32-start-process-show-window",
2190 &Vw32_start_process_show_window,
33f09670
JR
2191 doc: /* When nil, new child processes hide their windows.
2192When non-nil, they show their window in the method of their choice.
2193This variable doesn't affect GUI applications, which will never be hidden. */);
fbd6baed 2194 Vw32_start_process_show_window = Qnil;
0ecf7d36 2195
b2fc9f3d
GV
2196 DEFVAR_LISP ("w32-start-process-share-console",
2197 &Vw32_start_process_share_console,
33f09670
JR
2198 doc: /* When nil, new child processes are given a new console.
2199When non-nil, they share the Emacs console; this has the limitation of
804d894a 2200allowing only one DOS subprocess to run at a time (whether started directly
33f09670
JR
2201or indirectly by Emacs), and preventing Emacs from cleanly terminating the
2202subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
2203otherwise respond to interrupts from Emacs. */);
b2fc9f3d
GV
2204 Vw32_start_process_share_console = Qnil;
2205
82e7c0a9
AI
2206 DEFVAR_LISP ("w32-start-process-inherit-error-mode",
2207 &Vw32_start_process_inherit_error_mode,
33f09670
JR
2208 doc: /* When nil, new child processes revert to the default error mode.
2209When non-nil, they inherit their error mode setting from Emacs, which stops
2210them blocking when trying to access unmounted drives etc. */);
82e7c0a9
AI
2211 Vw32_start_process_inherit_error_mode = Qt;
2212
5322f50b 2213 DEFVAR_INT ("w32-pipe-read-delay", &w32_pipe_read_delay,
33f09670
JR
2214 doc: /* Forced delay before reading subprocess output.
2215This is done to improve the buffering of subprocess output, by
2216avoiding the inefficiency of frequently reading small amounts of data.
2217
2218If positive, the value is the number of milliseconds to sleep before
2219reading the subprocess output. If negative, the magnitude is the number
2220of time slices to wait (effectively boosting the priority of the child
2221process temporarily). A value of zero disables waiting entirely. */);
5322f50b 2222 w32_pipe_read_delay = 50;
0c04091e 2223
fbd6baed 2224 DEFVAR_LISP ("w32-downcase-file-names", &Vw32_downcase_file_names,
33f09670
JR
2225 doc: /* Non-nil means convert all-upper case file names to lower case.
2226This applies when performing completions and file name expansion.
2227Note that the value of this setting also affects remote file names,
2228so you probably don't want to set to non-nil if you use case-sensitive
177c0ea7 2229filesystems via ange-ftp. */);
fbd6baed 2230 Vw32_downcase_file_names = Qnil;
b2fc9f3d
GV
2231
2232#if 0
2233 DEFVAR_LISP ("w32-generate-fake-inodes", &Vw32_generate_fake_inodes,
33f09670
JR
2234 doc: /* Non-nil means attempt to fake realistic inode values.
2235This works by hashing the truename of files, and should detect
2236aliasing between long and short (8.3 DOS) names, but can have
2237false positives because of hash collisions. Note that determing
2238the truename of a file can be slow. */);
b2fc9f3d
GV
2239 Vw32_generate_fake_inodes = Qnil;
2240#endif
2241
2242 DEFVAR_LISP ("w32-get-true-file-attributes", &Vw32_get_true_file_attributes,
45de4a6f
JB
2243 doc: /* Non-nil means determine accurate link count in `file-attributes'.
2244Note that this option is only useful for files on NTFS volumes, where hard links
c7a1aae9 2245are supported. Moreover, it slows down `file-attributes' noticeably. */);
09ed9d88 2246 Vw32_get_true_file_attributes = Qt;
af621bc3
EZ
2247
2248 staticpro (&Vw32_valid_locale_ids);
2249 staticpro (&Vw32_valid_codepages);
93fdf2f8 2250}
c519b5e1 2251/* end of ntproc.c */
ab5796a9
MB
2252
2253/* arch-tag: 23d3a34c-06d2-48a1-833b-ac7609aa5250
2254 (do not change this comment) */