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