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