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