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