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