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