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