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