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