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