* progmodes/compile.el (compilation-mode-hook)
[bpt/emacs.git] / src / w32proc.c
1 /* Process support for GNU Emacs on the Microsoft Windows API.
2 Copyright (C) 1992, 1995, 1999-2013 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
18
19 /*
20 Drew Bliss Oct 14, 1993
21 Adapted from alarm.c by Tim Fleehart
22 */
23
24 #include <stdio.h>
25 #include <stdlib.h>
26 #include <errno.h>
27 #include <ctype.h>
28 #include <io.h>
29 #include <fcntl.h>
30 #include <signal.h>
31 #include <sys/file.h>
32
33 /* must include CRT headers *before* config.h */
34 #include <config.h>
35
36 #undef signal
37 #undef wait
38 #undef spawnve
39 #undef select
40 #undef kill
41
42 #include <windows.h>
43 #ifdef __GNUC__
44 /* This definition is missing from mingw32 headers. */
45 extern BOOL WINAPI IsValidLocale (LCID, DWORD);
46 #endif
47
48 #ifdef HAVE_LANGINFO_CODESET
49 #include <nl_types.h>
50 #include <langinfo.h>
51 #endif
52
53 #include "lisp.h"
54 #include "w32.h"
55 #include "w32common.h"
56 #include "w32heap.h"
57 #include "systime.h"
58 #include "syswait.h"
59 #include "process.h"
60 #include "syssignal.h"
61 #include "w32term.h"
62 #include "dispextern.h" /* for xstrcasecmp */
63 #include "coding.h"
64
65 #define RVA_TO_PTR(var,section,filedata) \
66 ((void *)((section)->PointerToRawData \
67 + ((DWORD_PTR)(var) - (section)->VirtualAddress) \
68 + (filedata).file_base))
69
70 Lisp_Object Qhigh, Qlow;
71
72 /* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */
73 static signal_handler sig_handlers[NSIG];
74
75 static sigset_t sig_mask;
76
77 static CRITICAL_SECTION crit_sig;
78
79 /* Improve on the CRT 'signal' implementation so that we could record
80 the SIGCHLD handler and fake interval timers. */
81 signal_handler
82 sys_signal (int sig, signal_handler handler)
83 {
84 signal_handler old;
85
86 /* SIGCHLD is needed for supporting subprocesses, see sys_kill
87 below. SIGALRM and SIGPROF are used by setitimer. All the
88 others are the only ones supported by the MS runtime. */
89 if (!(sig == SIGCHLD || sig == SIGSEGV || sig == SIGILL
90 || sig == SIGFPE || sig == SIGABRT || sig == SIGTERM
91 || sig == SIGALRM || sig == SIGPROF))
92 {
93 errno = EINVAL;
94 return SIG_ERR;
95 }
96 old = sig_handlers[sig];
97 /* SIGABRT is treated specially because w32.c installs term_ntproc
98 as its handler, so we don't want to override that afterwards.
99 Aborting Emacs works specially anyway: either by calling
100 emacs_abort directly or through terminate_due_to_signal, which
101 calls emacs_abort through emacs_raise. */
102 if (!(sig == SIGABRT && old == term_ntproc))
103 {
104 sig_handlers[sig] = handler;
105 if (!(sig == SIGCHLD || sig == SIGALRM || sig == SIGPROF))
106 signal (sig, handler);
107 }
108 return old;
109 }
110
111 /* Emulate sigaction. */
112 int
113 sigaction (int sig, const struct sigaction *act, struct sigaction *oact)
114 {
115 signal_handler old = SIG_DFL;
116 int retval = 0;
117
118 if (act)
119 old = sys_signal (sig, act->sa_handler);
120 else if (oact)
121 old = sig_handlers[sig];
122
123 if (old == SIG_ERR)
124 {
125 errno = EINVAL;
126 retval = -1;
127 }
128 if (oact)
129 {
130 oact->sa_handler = old;
131 oact->sa_flags = 0;
132 oact->sa_mask = empty_mask;
133 }
134 return retval;
135 }
136
137 /* Emulate signal sets and blocking of signals used by timers. */
138
139 int
140 sigemptyset (sigset_t *set)
141 {
142 *set = 0;
143 return 0;
144 }
145
146 int
147 sigaddset (sigset_t *set, int signo)
148 {
149 if (!set)
150 {
151 errno = EINVAL;
152 return -1;
153 }
154 if (signo < 0 || signo >= NSIG)
155 {
156 errno = EINVAL;
157 return -1;
158 }
159
160 *set |= (1U << signo);
161
162 return 0;
163 }
164
165 int
166 sigfillset (sigset_t *set)
167 {
168 if (!set)
169 {
170 errno = EINVAL;
171 return -1;
172 }
173
174 *set = 0xFFFFFFFF;
175 return 0;
176 }
177
178 int
179 sigprocmask (int how, const sigset_t *set, sigset_t *oset)
180 {
181 if (!(how == SIG_BLOCK || how == SIG_UNBLOCK || how == SIG_SETMASK))
182 {
183 errno = EINVAL;
184 return -1;
185 }
186
187 if (oset)
188 *oset = sig_mask;
189
190 if (!set)
191 return 0;
192
193 switch (how)
194 {
195 case SIG_BLOCK:
196 sig_mask |= *set;
197 break;
198 case SIG_SETMASK:
199 sig_mask = *set;
200 break;
201 case SIG_UNBLOCK:
202 /* FIXME: Catch signals that are blocked and reissue them when
203 they are unblocked. Important for SIGALRM and SIGPROF only. */
204 sig_mask &= ~(*set);
205 break;
206 }
207
208 return 0;
209 }
210
211 int
212 pthread_sigmask (int how, const sigset_t *set, sigset_t *oset)
213 {
214 if (sigprocmask (how, set, oset) == -1)
215 return EINVAL;
216 return 0;
217 }
218
219 int
220 sigismember (const sigset_t *set, int signo)
221 {
222 if (signo < 0 || signo >= NSIG)
223 {
224 errno = EINVAL;
225 return -1;
226 }
227 if (signo > sizeof (*set) * BITS_PER_CHAR)
228 emacs_abort ();
229
230 return (*set & (1U << signo)) != 0;
231 }
232
233 pid_t
234 getpgrp (void)
235 {
236 return getpid ();
237 }
238
239 pid_t
240 tcgetpgrp (int fd)
241 {
242 return getpid ();
243 }
244
245 int
246 setpgid (pid_t pid, pid_t pgid)
247 {
248 return 0;
249 }
250
251 pid_t
252 setsid (void)
253 {
254 return getpid ();
255 }
256
257 /* Emulations of interval timers.
258
259 Limitations: only ITIMER_REAL and ITIMER_PROF are supported.
260
261 Implementation: a separate thread is started for each timer type,
262 the thread calls the appropriate signal handler when the timer
263 expires, after stopping the thread which installed the timer. */
264
265 struct itimer_data {
266 volatile ULONGLONG expire;
267 volatile ULONGLONG reload;
268 volatile int terminate;
269 int type;
270 HANDLE caller_thread;
271 HANDLE timer_thread;
272 };
273
274 static ULONGLONG ticks_now;
275 static struct itimer_data real_itimer, prof_itimer;
276 static ULONGLONG clocks_min;
277 /* If non-zero, itimers are disabled. Used during shutdown, when we
278 delete the critical sections used by the timer threads. */
279 static int disable_itimers;
280
281 static CRITICAL_SECTION crit_real, crit_prof;
282
283 /* GetThreadTimes is not available on Windows 9X and possibly also on 2K. */
284 typedef BOOL (WINAPI *GetThreadTimes_Proc) (
285 HANDLE hThread,
286 LPFILETIME lpCreationTime,
287 LPFILETIME lpExitTime,
288 LPFILETIME lpKernelTime,
289 LPFILETIME lpUserTime);
290
291 static GetThreadTimes_Proc s_pfn_Get_Thread_Times;
292
293 #define MAX_SINGLE_SLEEP 30
294 #define TIMER_TICKS_PER_SEC 1000
295
296 /* Return a suitable time value, in 1-ms units, for THREAD, a handle
297 to a thread. If THREAD is NULL or an invalid handle, return the
298 current wall-clock time since January 1, 1601 (UTC). Otherwise,
299 return the sum of kernel and user times used by THREAD since it was
300 created, plus its creation time. */
301 static ULONGLONG
302 w32_get_timer_time (HANDLE thread)
303 {
304 ULONGLONG retval;
305 int use_system_time = 1;
306 /* The functions below return times in 100-ns units. */
307 const int tscale = 10 * TIMER_TICKS_PER_SEC;
308
309 if (thread && thread != INVALID_HANDLE_VALUE
310 && s_pfn_Get_Thread_Times != NULL)
311 {
312 FILETIME creation_ftime, exit_ftime, kernel_ftime, user_ftime;
313 ULARGE_INTEGER temp_creation, temp_kernel, temp_user;
314
315 if (s_pfn_Get_Thread_Times (thread, &creation_ftime, &exit_ftime,
316 &kernel_ftime, &user_ftime))
317 {
318 use_system_time = 0;
319 temp_creation.LowPart = creation_ftime.dwLowDateTime;
320 temp_creation.HighPart = creation_ftime.dwHighDateTime;
321 temp_kernel.LowPart = kernel_ftime.dwLowDateTime;
322 temp_kernel.HighPart = kernel_ftime.dwHighDateTime;
323 temp_user.LowPart = user_ftime.dwLowDateTime;
324 temp_user.HighPart = user_ftime.dwHighDateTime;
325 retval =
326 temp_creation.QuadPart / tscale + temp_kernel.QuadPart / tscale
327 + temp_user.QuadPart / tscale;
328 }
329 else
330 DebPrint (("GetThreadTimes failed with error code %lu\n",
331 GetLastError ()));
332 }
333
334 if (use_system_time)
335 {
336 FILETIME current_ftime;
337 ULARGE_INTEGER temp;
338
339 GetSystemTimeAsFileTime (&current_ftime);
340
341 temp.LowPart = current_ftime.dwLowDateTime;
342 temp.HighPart = current_ftime.dwHighDateTime;
343
344 retval = temp.QuadPart / tscale;
345 }
346
347 return retval;
348 }
349
350 /* Thread function for a timer thread. */
351 static DWORD WINAPI
352 timer_loop (LPVOID arg)
353 {
354 struct itimer_data *itimer = (struct itimer_data *)arg;
355 int which = itimer->type;
356 int sig = (which == ITIMER_REAL) ? SIGALRM : SIGPROF;
357 CRITICAL_SECTION *crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
358 const DWORD max_sleep = MAX_SINGLE_SLEEP * 1000 / TIMER_TICKS_PER_SEC;
359 HANDLE hth = (which == ITIMER_REAL) ? NULL : itimer->caller_thread;
360
361 while (1)
362 {
363 DWORD sleep_time;
364 signal_handler handler;
365 ULONGLONG now, expire, reload;
366
367 /* Load new values if requested by setitimer. */
368 EnterCriticalSection (crit);
369 expire = itimer->expire;
370 reload = itimer->reload;
371 LeaveCriticalSection (crit);
372 if (itimer->terminate)
373 return 0;
374
375 if (expire == 0)
376 {
377 /* We are idle. */
378 Sleep (max_sleep);
379 continue;
380 }
381
382 if (expire > (now = w32_get_timer_time (hth)))
383 sleep_time = expire - now;
384 else
385 sleep_time = 0;
386 /* Don't sleep too long at a time, to be able to see the
387 termination flag without too long a delay. */
388 while (sleep_time > max_sleep)
389 {
390 if (itimer->terminate)
391 return 0;
392 Sleep (max_sleep);
393 EnterCriticalSection (crit);
394 expire = itimer->expire;
395 LeaveCriticalSection (crit);
396 sleep_time =
397 (expire > (now = w32_get_timer_time (hth))) ? expire - now : 0;
398 }
399 if (itimer->terminate)
400 return 0;
401 if (sleep_time > 0)
402 {
403 Sleep (sleep_time * 1000 / TIMER_TICKS_PER_SEC);
404 /* Always sleep past the expiration time, to make sure we
405 never call the handler _before_ the expiration time,
406 always slightly after it. Sleep(5) makes sure we don't
407 hog the CPU by calling 'w32_get_timer_time' with high
408 frequency, and also let other threads work. */
409 while (w32_get_timer_time (hth) < expire)
410 Sleep (5);
411 }
412
413 EnterCriticalSection (crit);
414 expire = itimer->expire;
415 LeaveCriticalSection (crit);
416 if (expire == 0)
417 continue;
418
419 /* Time's up. */
420 handler = sig_handlers[sig];
421 if (!(handler == SIG_DFL || handler == SIG_IGN || handler == SIG_ERR)
422 /* FIXME: Don't ignore masked signals. Instead, record that
423 they happened and reissue them when the signal is
424 unblocked. */
425 && !sigismember (&sig_mask, sig)
426 /* Simulate masking of SIGALRM and SIGPROF when processing
427 fatal signals. */
428 && !fatal_error_in_progress
429 && itimer->caller_thread)
430 {
431 /* Simulate a signal delivered to the thread which installed
432 the timer, by suspending that thread while the handler
433 runs. */
434 HANDLE th = itimer->caller_thread;
435 DWORD result = SuspendThread (th);
436
437 if (result == (DWORD)-1)
438 return 2;
439
440 handler (sig);
441 ResumeThread (th);
442 }
443
444 /* Update expiration time and loop. */
445 EnterCriticalSection (crit);
446 expire = itimer->expire;
447 if (expire == 0)
448 {
449 LeaveCriticalSection (crit);
450 continue;
451 }
452 reload = itimer->reload;
453 if (reload > 0)
454 {
455 now = w32_get_timer_time (hth);
456 if (expire <= now)
457 {
458 ULONGLONG lag = now - expire;
459
460 /* If we missed some opportunities (presumably while
461 sleeping or while the signal handler ran), skip
462 them. */
463 if (lag > reload)
464 expire = now - (lag % reload);
465
466 expire += reload;
467 }
468 }
469 else
470 expire = 0; /* become idle */
471 itimer->expire = expire;
472 LeaveCriticalSection (crit);
473 }
474 return 0;
475 }
476
477 static void
478 stop_timer_thread (int which)
479 {
480 struct itimer_data *itimer =
481 (which == ITIMER_REAL) ? &real_itimer : &prof_itimer;
482 int i;
483 DWORD err, exit_code = 255;
484 BOOL status;
485
486 /* Signal the thread that it should terminate. */
487 itimer->terminate = 1;
488
489 if (itimer->timer_thread == NULL)
490 return;
491
492 /* Wait for the timer thread to terminate voluntarily, then kill it
493 if it doesn't. This loop waits twice more than the maximum
494 amount of time a timer thread sleeps, see above. */
495 for (i = 0; i < MAX_SINGLE_SLEEP / 5; i++)
496 {
497 if (!((status = GetExitCodeThread (itimer->timer_thread, &exit_code))
498 && exit_code == STILL_ACTIVE))
499 break;
500 Sleep (10);
501 }
502 if ((status == FALSE && (err = GetLastError ()) == ERROR_INVALID_HANDLE)
503 || exit_code == STILL_ACTIVE)
504 {
505 if (!(status == FALSE && err == ERROR_INVALID_HANDLE))
506 TerminateThread (itimer->timer_thread, 0);
507 }
508
509 /* Clean up. */
510 CloseHandle (itimer->timer_thread);
511 itimer->timer_thread = NULL;
512 if (itimer->caller_thread)
513 {
514 CloseHandle (itimer->caller_thread);
515 itimer->caller_thread = NULL;
516 }
517 }
518
519 /* This is called at shutdown time from term_ntproc. */
520 void
521 term_timers (void)
522 {
523 if (real_itimer.timer_thread)
524 stop_timer_thread (ITIMER_REAL);
525 if (prof_itimer.timer_thread)
526 stop_timer_thread (ITIMER_PROF);
527
528 /* We are going to delete the critical sections, so timers cannot
529 work after this. */
530 disable_itimers = 1;
531
532 DeleteCriticalSection (&crit_real);
533 DeleteCriticalSection (&crit_prof);
534 DeleteCriticalSection (&crit_sig);
535 }
536
537 /* This is called at initialization time from init_ntproc. */
538 void
539 init_timers (void)
540 {
541 /* GetThreadTimes is not available on all versions of Windows, so
542 need to probe for its availability dynamically, and call it
543 through a pointer. */
544 s_pfn_Get_Thread_Times = NULL; /* in case dumped Emacs comes with a value */
545 if (os_subtype != OS_9X)
546 s_pfn_Get_Thread_Times =
547 (GetThreadTimes_Proc)GetProcAddress (GetModuleHandle ("kernel32.dll"),
548 "GetThreadTimes");
549
550 /* Make sure we start with zeroed out itimer structures, since
551 dumping may have left there traces of threads long dead. */
552 memset (&real_itimer, 0, sizeof real_itimer);
553 memset (&prof_itimer, 0, sizeof prof_itimer);
554
555 InitializeCriticalSection (&crit_real);
556 InitializeCriticalSection (&crit_prof);
557 InitializeCriticalSection (&crit_sig);
558
559 disable_itimers = 0;
560 }
561
562 static int
563 start_timer_thread (int which)
564 {
565 DWORD exit_code;
566 HANDLE th;
567 struct itimer_data *itimer =
568 (which == ITIMER_REAL) ? &real_itimer : &prof_itimer;
569
570 if (itimer->timer_thread
571 && GetExitCodeThread (itimer->timer_thread, &exit_code)
572 && exit_code == STILL_ACTIVE)
573 return 0;
574
575 /* Clean up after possibly exited thread. */
576 if (itimer->timer_thread)
577 {
578 CloseHandle (itimer->timer_thread);
579 itimer->timer_thread = NULL;
580 }
581 if (itimer->caller_thread)
582 {
583 CloseHandle (itimer->caller_thread);
584 itimer->caller_thread = NULL;
585 }
586
587 /* Start a new thread. */
588 if (!DuplicateHandle (GetCurrentProcess (), GetCurrentThread (),
589 GetCurrentProcess (), &th, 0, FALSE,
590 DUPLICATE_SAME_ACCESS))
591 {
592 errno = ESRCH;
593 return -1;
594 }
595 itimer->terminate = 0;
596 itimer->type = which;
597 itimer->caller_thread = th;
598 /* Request that no more than 64KB of stack be reserved for this
599 thread, to avoid reserving too much memory, which would get in
600 the way of threads we start to wait for subprocesses. See also
601 new_child below. */
602 itimer->timer_thread = CreateThread (NULL, 64 * 1024, timer_loop,
603 (void *)itimer, 0x00010000, NULL);
604
605 if (!itimer->timer_thread)
606 {
607 CloseHandle (itimer->caller_thread);
608 itimer->caller_thread = NULL;
609 errno = EAGAIN;
610 return -1;
611 }
612
613 /* This is needed to make sure that the timer thread running for
614 profiling gets CPU as soon as the Sleep call terminates. */
615 if (which == ITIMER_PROF)
616 SetThreadPriority (itimer->timer_thread, THREAD_PRIORITY_TIME_CRITICAL);
617
618 return 0;
619 }
620
621 /* Most of the code of getitimer and setitimer (but not of their
622 subroutines) was shamelessly stolen from itimer.c in the DJGPP
623 library, see www.delorie.com/djgpp. */
624 int
625 getitimer (int which, struct itimerval *value)
626 {
627 volatile ULONGLONG *t_expire;
628 volatile ULONGLONG *t_reload;
629 ULONGLONG expire, reload;
630 __int64 usecs;
631 CRITICAL_SECTION *crit;
632 struct itimer_data *itimer;
633
634 if (disable_itimers)
635 return -1;
636
637 if (!value)
638 {
639 errno = EFAULT;
640 return -1;
641 }
642
643 if (which != ITIMER_REAL && which != ITIMER_PROF)
644 {
645 errno = EINVAL;
646 return -1;
647 }
648
649 itimer = (which == ITIMER_REAL) ? &real_itimer : &prof_itimer;
650
651 ticks_now = w32_get_timer_time ((which == ITIMER_REAL)
652 ? NULL
653 : GetCurrentThread ());
654
655 t_expire = &itimer->expire;
656 t_reload = &itimer->reload;
657 crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
658
659 EnterCriticalSection (crit);
660 reload = *t_reload;
661 expire = *t_expire;
662 LeaveCriticalSection (crit);
663
664 if (expire)
665 expire -= ticks_now;
666
667 value->it_value.tv_sec = expire / TIMER_TICKS_PER_SEC;
668 usecs =
669 (expire % TIMER_TICKS_PER_SEC) * (__int64)1000000 / TIMER_TICKS_PER_SEC;
670 value->it_value.tv_usec = usecs;
671 value->it_interval.tv_sec = reload / TIMER_TICKS_PER_SEC;
672 usecs =
673 (reload % TIMER_TICKS_PER_SEC) * (__int64)1000000 / TIMER_TICKS_PER_SEC;
674 value->it_interval.tv_usec= usecs;
675
676 return 0;
677 }
678
679 int
680 setitimer(int which, struct itimerval *value, struct itimerval *ovalue)
681 {
682 volatile ULONGLONG *t_expire, *t_reload;
683 ULONGLONG expire, reload, expire_old, reload_old;
684 __int64 usecs;
685 CRITICAL_SECTION *crit;
686 struct itimerval tem, *ptem;
687
688 if (disable_itimers)
689 return -1;
690
691 /* Posix systems expect timer values smaller than the resolution of
692 the system clock be rounded up to the clock resolution. First
693 time we are called, measure the clock tick resolution. */
694 if (!clocks_min)
695 {
696 ULONGLONG t1, t2;
697
698 for (t1 = w32_get_timer_time (NULL);
699 (t2 = w32_get_timer_time (NULL)) == t1; )
700 ;
701 clocks_min = t2 - t1;
702 }
703
704 if (ovalue)
705 ptem = ovalue;
706 else
707 ptem = &tem;
708
709 if (getitimer (which, ptem)) /* also sets ticks_now */
710 return -1; /* errno already set */
711
712 t_expire =
713 (which == ITIMER_REAL) ? &real_itimer.expire : &prof_itimer.expire;
714 t_reload =
715 (which == ITIMER_REAL) ? &real_itimer.reload : &prof_itimer.reload;
716
717 crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
718
719 if (!value
720 || (value->it_value.tv_sec == 0 && value->it_value.tv_usec == 0))
721 {
722 EnterCriticalSection (crit);
723 /* Disable the timer. */
724 *t_expire = 0;
725 *t_reload = 0;
726 LeaveCriticalSection (crit);
727 return 0;
728 }
729
730 reload = value->it_interval.tv_sec * TIMER_TICKS_PER_SEC;
731
732 usecs = value->it_interval.tv_usec;
733 if (value->it_interval.tv_sec == 0
734 && usecs && usecs * TIMER_TICKS_PER_SEC < clocks_min * 1000000)
735 reload = clocks_min;
736 else
737 {
738 usecs *= TIMER_TICKS_PER_SEC;
739 reload += usecs / 1000000;
740 }
741
742 expire = value->it_value.tv_sec * TIMER_TICKS_PER_SEC;
743 usecs = value->it_value.tv_usec;
744 if (value->it_value.tv_sec == 0
745 && usecs * TIMER_TICKS_PER_SEC < clocks_min * 1000000)
746 expire = clocks_min;
747 else
748 {
749 usecs *= TIMER_TICKS_PER_SEC;
750 expire += usecs / 1000000;
751 }
752
753 expire += ticks_now;
754
755 EnterCriticalSection (crit);
756 expire_old = *t_expire;
757 reload_old = *t_reload;
758 if (!(expire == expire_old && reload == reload_old))
759 {
760 *t_reload = reload;
761 *t_expire = expire;
762 }
763 LeaveCriticalSection (crit);
764
765 return start_timer_thread (which);
766 }
767
768 int
769 alarm (int seconds)
770 {
771 #ifdef HAVE_SETITIMER
772 struct itimerval new_values, old_values;
773
774 new_values.it_value.tv_sec = seconds;
775 new_values.it_value.tv_usec = 0;
776 new_values.it_interval.tv_sec = new_values.it_interval.tv_usec = 0;
777
778 if (setitimer (ITIMER_REAL, &new_values, &old_values) < 0)
779 return 0;
780 return old_values.it_value.tv_sec;
781 #else
782 return seconds;
783 #endif
784 }
785
786 /* Defined in <process.h> which conflicts with the local copy */
787 #define _P_NOWAIT 1
788
789 /* Child process management list. */
790 int child_proc_count = 0;
791 child_process child_procs[ MAX_CHILDREN ];
792
793 static DWORD WINAPI reader_thread (void *arg);
794
795 /* Find an unused process slot. */
796 child_process *
797 new_child (void)
798 {
799 child_process *cp;
800 DWORD id;
801
802 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
803 if (!CHILD_ACTIVE (cp) && cp->procinfo.hProcess == NULL)
804 goto Initialize;
805 if (child_proc_count == MAX_CHILDREN)
806 return NULL;
807 cp = &child_procs[child_proc_count++];
808
809 Initialize:
810 memset (cp, 0, sizeof (*cp));
811 cp->fd = -1;
812 cp->pid = -1;
813 cp->procinfo.hProcess = NULL;
814 cp->status = STATUS_READ_ERROR;
815 cp->input_file = NULL;
816 cp->pending_deletion = 0;
817
818 /* use manual reset event so that select() will function properly */
819 cp->char_avail = CreateEvent (NULL, TRUE, FALSE, NULL);
820 if (cp->char_avail)
821 {
822 cp->char_consumed = CreateEvent (NULL, FALSE, FALSE, NULL);
823 if (cp->char_consumed)
824 {
825 /* The 0x00010000 flag is STACK_SIZE_PARAM_IS_A_RESERVATION.
826 It means that the 64K stack we are requesting in the 2nd
827 argument is how much memory should be reserved for the
828 stack. If we don't use this flag, the memory requested
829 by the 2nd argument is the amount actually _committed_,
830 but Windows reserves 8MB of memory for each thread's
831 stack. (The 8MB figure comes from the -stack
832 command-line argument we pass to the linker when building
833 Emacs, but that's because we need a large stack for
834 Emacs's main thread.) Since we request 2GB of reserved
835 memory at startup (see w32heap.c), which is close to the
836 maximum memory available for a 32-bit process on Windows,
837 the 8MB reservation for each thread causes failures in
838 starting subprocesses, because we create a thread running
839 reader_thread for each subprocess. As 8MB of stack is
840 way too much for reader_thread, forcing Windows to
841 reserve less wins the day. */
842 cp->thrd = CreateThread (NULL, 64 * 1024, reader_thread, cp,
843 0x00010000, &id);
844 if (cp->thrd)
845 return cp;
846 }
847 }
848 delete_child (cp);
849 return NULL;
850 }
851
852 void
853 delete_child (child_process *cp)
854 {
855 int i;
856
857 /* Should not be deleting a child that is still needed. */
858 for (i = 0; i < MAXDESC; i++)
859 if (fd_info[i].cp == cp)
860 emacs_abort ();
861
862 if (!CHILD_ACTIVE (cp) && cp->procinfo.hProcess == NULL)
863 return;
864
865 /* Delete the child's temporary input file, if any, that is pending
866 deletion. */
867 if (cp->input_file)
868 {
869 if (cp->pending_deletion)
870 {
871 if (unlink (cp->input_file))
872 DebPrint (("delete_child.unlink (%s) failed, errno: %d\n",
873 cp->input_file, errno));
874 cp->pending_deletion = 0;
875 }
876 xfree (cp->input_file);
877 cp->input_file = NULL;
878 }
879
880 /* reap thread if necessary */
881 if (cp->thrd)
882 {
883 DWORD rc;
884
885 if (GetExitCodeThread (cp->thrd, &rc) && rc == STILL_ACTIVE)
886 {
887 /* let the thread exit cleanly if possible */
888 cp->status = STATUS_READ_ERROR;
889 SetEvent (cp->char_consumed);
890 #if 0
891 /* We used to forcibly terminate the thread here, but it
892 is normally unnecessary, and in abnormal cases, the worst that
893 will happen is we have an extra idle thread hanging around
894 waiting for the zombie process. */
895 if (WaitForSingleObject (cp->thrd, 1000) != WAIT_OBJECT_0)
896 {
897 DebPrint (("delete_child.WaitForSingleObject (thread) failed "
898 "with %lu for fd %ld\n", GetLastError (), cp->fd));
899 TerminateThread (cp->thrd, 0);
900 }
901 #endif
902 }
903 CloseHandle (cp->thrd);
904 cp->thrd = NULL;
905 }
906 if (cp->char_avail)
907 {
908 CloseHandle (cp->char_avail);
909 cp->char_avail = NULL;
910 }
911 if (cp->char_consumed)
912 {
913 CloseHandle (cp->char_consumed);
914 cp->char_consumed = NULL;
915 }
916
917 /* update child_proc_count (highest numbered slot in use plus one) */
918 if (cp == child_procs + child_proc_count - 1)
919 {
920 for (i = child_proc_count-1; i >= 0; i--)
921 if (CHILD_ACTIVE (&child_procs[i])
922 || child_procs[i].procinfo.hProcess != NULL)
923 {
924 child_proc_count = i + 1;
925 break;
926 }
927 }
928 if (i < 0)
929 child_proc_count = 0;
930 }
931
932 /* Find a child by pid. */
933 static child_process *
934 find_child_pid (DWORD pid)
935 {
936 child_process *cp;
937
938 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
939 if ((CHILD_ACTIVE (cp) || cp->procinfo.hProcess != NULL)
940 && pid == cp->pid)
941 return cp;
942 return NULL;
943 }
944
945
946 /* Thread proc for child process and socket reader threads. Each thread
947 is normally blocked until woken by select() to check for input by
948 reading one char. When the read completes, char_avail is signaled
949 to wake up the select emulator and the thread blocks itself again. */
950 static DWORD WINAPI
951 reader_thread (void *arg)
952 {
953 child_process *cp;
954
955 /* Our identity */
956 cp = (child_process *)arg;
957
958 /* We have to wait for the go-ahead before we can start */
959 if (cp == NULL
960 || WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0
961 || cp->fd < 0)
962 return 1;
963
964 for (;;)
965 {
966 int rc;
967
968 if (cp->fd >= 0 && fd_info[cp->fd].flags & FILE_LISTEN)
969 rc = _sys_wait_accept (cp->fd);
970 else
971 rc = _sys_read_ahead (cp->fd);
972
973 /* Don't bother waiting for the event if we already have been
974 told to exit by delete_child. */
975 if (cp->status == STATUS_READ_ERROR || !cp->char_avail)
976 break;
977
978 /* The name char_avail is a misnomer - it really just means the
979 read-ahead has completed, whether successfully or not. */
980 if (!SetEvent (cp->char_avail))
981 {
982 DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld\n",
983 GetLastError (), cp->fd));
984 return 1;
985 }
986
987 if (rc == STATUS_READ_ERROR)
988 return 1;
989
990 /* If the read died, the child has died so let the thread die */
991 if (rc == STATUS_READ_FAILED)
992 break;
993
994 /* Don't bother waiting for the acknowledge if we already have
995 been told to exit by delete_child. */
996 if (cp->status == STATUS_READ_ERROR || !cp->char_consumed)
997 break;
998
999 /* Wait until our input is acknowledged before reading again */
1000 if (WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0)
1001 {
1002 DebPrint (("reader_thread.WaitForSingleObject failed with "
1003 "%lu for fd %ld\n", GetLastError (), cp->fd));
1004 break;
1005 }
1006 /* delete_child sets status to STATUS_READ_ERROR when it wants
1007 us to exit. */
1008 if (cp->status == STATUS_READ_ERROR)
1009 break;
1010 }
1011 return 0;
1012 }
1013
1014 /* To avoid Emacs changing directory, we just record here the directory
1015 the new process should start in. This is set just before calling
1016 sys_spawnve, and is not generally valid at any other time. */
1017 static char * process_dir;
1018
1019 static BOOL
1020 create_child (char *exe, char *cmdline, char *env, int is_gui_app,
1021 int * pPid, child_process *cp)
1022 {
1023 STARTUPINFO start;
1024 SECURITY_ATTRIBUTES sec_attrs;
1025 #if 0
1026 SECURITY_DESCRIPTOR sec_desc;
1027 #endif
1028 DWORD flags;
1029 char dir[ MAXPATHLEN ];
1030
1031 if (cp == NULL) emacs_abort ();
1032
1033 memset (&start, 0, sizeof (start));
1034 start.cb = sizeof (start);
1035
1036 #ifdef HAVE_NTGUI
1037 if (NILP (Vw32_start_process_show_window) && !is_gui_app)
1038 start.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW;
1039 else
1040 start.dwFlags = STARTF_USESTDHANDLES;
1041 start.wShowWindow = SW_HIDE;
1042
1043 start.hStdInput = GetStdHandle (STD_INPUT_HANDLE);
1044 start.hStdOutput = GetStdHandle (STD_OUTPUT_HANDLE);
1045 start.hStdError = GetStdHandle (STD_ERROR_HANDLE);
1046 #endif /* HAVE_NTGUI */
1047
1048 #if 0
1049 /* Explicitly specify no security */
1050 if (!InitializeSecurityDescriptor (&sec_desc, SECURITY_DESCRIPTOR_REVISION))
1051 goto EH_Fail;
1052 if (!SetSecurityDescriptorDacl (&sec_desc, TRUE, NULL, FALSE))
1053 goto EH_Fail;
1054 #endif
1055 sec_attrs.nLength = sizeof (sec_attrs);
1056 sec_attrs.lpSecurityDescriptor = NULL /* &sec_desc */;
1057 sec_attrs.bInheritHandle = FALSE;
1058
1059 strcpy (dir, process_dir);
1060 unixtodos_filename (dir);
1061
1062 flags = (!NILP (Vw32_start_process_share_console)
1063 ? CREATE_NEW_PROCESS_GROUP
1064 : CREATE_NEW_CONSOLE);
1065 if (NILP (Vw32_start_process_inherit_error_mode))
1066 flags |= CREATE_DEFAULT_ERROR_MODE;
1067 if (!CreateProcess (exe, cmdline, &sec_attrs, NULL, TRUE,
1068 flags, env, dir, &start, &cp->procinfo))
1069 goto EH_Fail;
1070
1071 cp->pid = (int) cp->procinfo.dwProcessId;
1072
1073 /* Hack for Windows 95, which assigns large (ie negative) pids */
1074 if (cp->pid < 0)
1075 cp->pid = -cp->pid;
1076
1077 *pPid = cp->pid;
1078
1079 return TRUE;
1080
1081 EH_Fail:
1082 DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError ()););
1083 return FALSE;
1084 }
1085
1086 /* create_child doesn't know what emacs' file handle will be for waiting
1087 on output from the child, so we need to make this additional call
1088 to register the handle with the process
1089 This way the select emulator knows how to match file handles with
1090 entries in child_procs. */
1091 void
1092 register_child (pid_t pid, int fd)
1093 {
1094 child_process *cp;
1095
1096 cp = find_child_pid ((DWORD)pid);
1097 if (cp == NULL)
1098 {
1099 DebPrint (("register_child unable to find pid %lu\n", pid));
1100 return;
1101 }
1102
1103 #ifdef FULL_DEBUG
1104 DebPrint (("register_child registered fd %d with pid %lu\n", fd, pid));
1105 #endif
1106
1107 cp->fd = fd;
1108
1109 /* thread is initially blocked until select is called; set status so
1110 that select will release thread */
1111 cp->status = STATUS_READ_ACKNOWLEDGED;
1112
1113 /* attach child_process to fd_info */
1114 if (fd_info[fd].cp != NULL)
1115 {
1116 DebPrint (("register_child: fd_info[%d] apparently in use!\n", fd));
1117 emacs_abort ();
1118 }
1119
1120 fd_info[fd].cp = cp;
1121 }
1122
1123 /* Record INFILE as an input file for process PID. */
1124 void
1125 record_infile (pid_t pid, char *infile)
1126 {
1127 child_process *cp;
1128
1129 /* INFILE should never be NULL, since xstrdup would have signaled
1130 memory full condition in that case, see callproc.c where this
1131 function is called. */
1132 eassert (infile);
1133
1134 cp = find_child_pid ((DWORD)pid);
1135 if (cp == NULL)
1136 {
1137 DebPrint (("record_infile is unable to find pid %lu\n", pid));
1138 return;
1139 }
1140
1141 cp->input_file = infile;
1142 }
1143
1144 /* Mark the input file INFILE of the corresponding subprocess as
1145 temporary, to be deleted when the subprocess exits. */
1146 void
1147 record_pending_deletion (char *infile)
1148 {
1149 child_process *cp;
1150
1151 eassert (infile);
1152
1153 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
1154 if (CHILD_ACTIVE (cp)
1155 && cp->input_file && xstrcasecmp (cp->input_file, infile) == 0)
1156 {
1157 cp->pending_deletion = 1;
1158 break;
1159 }
1160 }
1161
1162 /* Called from waitpid when a process exits. */
1163 static void
1164 reap_subprocess (child_process *cp)
1165 {
1166 if (cp->procinfo.hProcess)
1167 {
1168 /* Reap the process */
1169 #ifdef FULL_DEBUG
1170 /* Process should have already died before we are called. */
1171 if (WaitForSingleObject (cp->procinfo.hProcess, 0) != WAIT_OBJECT_0)
1172 DebPrint (("reap_subprocess: child for fd %d has not died yet!", cp->fd));
1173 #endif
1174 CloseHandle (cp->procinfo.hProcess);
1175 cp->procinfo.hProcess = NULL;
1176 CloseHandle (cp->procinfo.hThread);
1177 cp->procinfo.hThread = NULL;
1178 }
1179
1180 /* If cp->fd was not closed yet, we might be still reading the
1181 process output, so don't free its resources just yet. The call
1182 to delete_child on behalf of this subprocess will be made by
1183 sys_read when the subprocess output is fully read. */
1184 if (cp->fd < 0)
1185 delete_child (cp);
1186 }
1187
1188 /* Wait for a child process specified by PID, or for any of our
1189 existing child processes (if PID is nonpositive) to die. When it
1190 does, close its handle. Return the pid of the process that died
1191 and fill in STATUS if non-NULL. */
1192
1193 pid_t
1194 waitpid (pid_t pid, int *status, int options)
1195 {
1196 DWORD active, retval;
1197 int nh;
1198 child_process *cp, *cps[MAX_CHILDREN];
1199 HANDLE wait_hnd[MAX_CHILDREN];
1200 DWORD timeout_ms;
1201 int dont_wait = (options & WNOHANG) != 0;
1202
1203 nh = 0;
1204 /* According to Posix:
1205
1206 PID = -1 means status is requested for any child process.
1207
1208 PID > 0 means status is requested for a single child process
1209 whose pid is PID.
1210
1211 PID = 0 means status is requested for any child process whose
1212 process group ID is equal to that of the calling process. But
1213 since Windows has only a limited support for process groups (only
1214 for console processes and only for the purposes of passing
1215 Ctrl-BREAK signal to them), and since we have no documented way
1216 of determining whether a given process belongs to our group, we
1217 treat 0 as -1.
1218
1219 PID < -1 means status is requested for any child process whose
1220 process group ID is equal to the absolute value of PID. Again,
1221 since we don't support process groups, we treat that as -1. */
1222 if (pid > 0)
1223 {
1224 int our_child = 0;
1225
1226 /* We are requested to wait for a specific child. */
1227 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
1228 {
1229 /* Some child_procs might be sockets; ignore them. Also
1230 ignore subprocesses whose output is not yet completely
1231 read. */
1232 if (CHILD_ACTIVE (cp)
1233 && cp->procinfo.hProcess
1234 && cp->pid == pid)
1235 {
1236 our_child = 1;
1237 break;
1238 }
1239 }
1240 if (our_child)
1241 {
1242 if (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0)
1243 {
1244 wait_hnd[nh] = cp->procinfo.hProcess;
1245 cps[nh] = cp;
1246 nh++;
1247 }
1248 else if (dont_wait)
1249 {
1250 /* PID specifies our subprocess, but its status is not
1251 yet available. */
1252 return 0;
1253 }
1254 }
1255 if (nh == 0)
1256 {
1257 /* No such child process, or nothing to wait for, so fail. */
1258 errno = ECHILD;
1259 return -1;
1260 }
1261 }
1262 else
1263 {
1264 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
1265 {
1266 if (CHILD_ACTIVE (cp)
1267 && cp->procinfo.hProcess
1268 && (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0))
1269 {
1270 wait_hnd[nh] = cp->procinfo.hProcess;
1271 cps[nh] = cp;
1272 nh++;
1273 }
1274 }
1275 if (nh == 0)
1276 {
1277 /* Nothing to wait on, so fail. */
1278 errno = ECHILD;
1279 return -1;
1280 }
1281 }
1282
1283 if (dont_wait)
1284 timeout_ms = 0;
1285 else
1286 timeout_ms = 1000; /* check for quit about once a second. */
1287
1288 do
1289 {
1290 QUIT;
1291 active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms);
1292 } while (active == WAIT_TIMEOUT && !dont_wait);
1293
1294 if (active == WAIT_FAILED)
1295 {
1296 errno = EBADF;
1297 return -1;
1298 }
1299 else if (active == WAIT_TIMEOUT && dont_wait)
1300 {
1301 /* PID specifies our subprocess, but it didn't exit yet, so its
1302 status is not yet available. */
1303 #ifdef FULL_DEBUG
1304 DebPrint (("Wait: PID %d not reap yet\n", cp->pid));
1305 #endif
1306 return 0;
1307 }
1308 else if (active >= WAIT_OBJECT_0
1309 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
1310 {
1311 active -= WAIT_OBJECT_0;
1312 }
1313 else if (active >= WAIT_ABANDONED_0
1314 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
1315 {
1316 active -= WAIT_ABANDONED_0;
1317 }
1318 else
1319 emacs_abort ();
1320
1321 if (!GetExitCodeProcess (wait_hnd[active], &retval))
1322 {
1323 DebPrint (("Wait.GetExitCodeProcess failed with %lu\n",
1324 GetLastError ()));
1325 retval = 1;
1326 }
1327 if (retval == STILL_ACTIVE)
1328 {
1329 /* Should never happen. */
1330 DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
1331 if (pid > 0 && dont_wait)
1332 return 0;
1333 errno = EINVAL;
1334 return -1;
1335 }
1336
1337 /* Massage the exit code from the process to match the format expected
1338 by the WIFSTOPPED et al macros in syswait.h. Only WIFSIGNALED and
1339 WIFEXITED are supported; WIFSTOPPED doesn't make sense under NT. */
1340
1341 if (retval == STATUS_CONTROL_C_EXIT)
1342 retval = SIGINT;
1343 else
1344 retval <<= 8;
1345
1346 if (pid > 0 && active != 0)
1347 emacs_abort ();
1348 cp = cps[active];
1349 pid = cp->pid;
1350 #ifdef FULL_DEBUG
1351 DebPrint (("Wait signaled with process pid %d\n", cp->pid));
1352 #endif
1353
1354 if (status)
1355 *status = retval;
1356 reap_subprocess (cp);
1357
1358 return pid;
1359 }
1360
1361 /* Old versions of w32api headers don't have separate 32-bit and
1362 64-bit defines, but the one they have matches the 32-bit variety. */
1363 #ifndef IMAGE_NT_OPTIONAL_HDR32_MAGIC
1364 # define IMAGE_NT_OPTIONAL_HDR32_MAGIC IMAGE_NT_OPTIONAL_HDR_MAGIC
1365 # define IMAGE_OPTIONAL_HEADER32 IMAGE_OPTIONAL_HEADER
1366 #endif
1367
1368 static void
1369 w32_executable_type (char * filename,
1370 int * is_dos_app,
1371 int * is_cygnus_app,
1372 int * is_gui_app)
1373 {
1374 file_data executable;
1375 char * p;
1376
1377 /* Default values in case we can't tell for sure. */
1378 *is_dos_app = FALSE;
1379 *is_cygnus_app = FALSE;
1380 *is_gui_app = FALSE;
1381
1382 if (!open_input_file (&executable, filename))
1383 return;
1384
1385 p = strrchr (filename, '.');
1386
1387 /* We can only identify DOS .com programs from the extension. */
1388 if (p && xstrcasecmp (p, ".com") == 0)
1389 *is_dos_app = TRUE;
1390 else if (p && (xstrcasecmp (p, ".bat") == 0
1391 || xstrcasecmp (p, ".cmd") == 0))
1392 {
1393 /* A DOS shell script - it appears that CreateProcess is happy to
1394 accept this (somewhat surprisingly); presumably it looks at
1395 COMSPEC to determine what executable to actually invoke.
1396 Therefore, we have to do the same here as well. */
1397 /* Actually, I think it uses the program association for that
1398 extension, which is defined in the registry. */
1399 p = egetenv ("COMSPEC");
1400 if (p)
1401 w32_executable_type (p, is_dos_app, is_cygnus_app, is_gui_app);
1402 }
1403 else
1404 {
1405 /* Look for DOS .exe signature - if found, we must also check that
1406 it isn't really a 16- or 32-bit Windows exe, since both formats
1407 start with a DOS program stub. Note that 16-bit Windows
1408 executables use the OS/2 1.x format. */
1409
1410 IMAGE_DOS_HEADER * dos_header;
1411 IMAGE_NT_HEADERS * nt_header;
1412
1413 dos_header = (PIMAGE_DOS_HEADER) executable.file_base;
1414 if (dos_header->e_magic != IMAGE_DOS_SIGNATURE)
1415 goto unwind;
1416
1417 nt_header = (PIMAGE_NT_HEADERS) ((unsigned char *) dos_header + dos_header->e_lfanew);
1418
1419 if ((char *) nt_header > (char *) dos_header + executable.size)
1420 {
1421 /* Some dos headers (pkunzip) have bogus e_lfanew fields. */
1422 *is_dos_app = TRUE;
1423 }
1424 else if (nt_header->Signature != IMAGE_NT_SIGNATURE
1425 && LOWORD (nt_header->Signature) != IMAGE_OS2_SIGNATURE)
1426 {
1427 *is_dos_app = TRUE;
1428 }
1429 else if (nt_header->Signature == IMAGE_NT_SIGNATURE)
1430 {
1431 IMAGE_DATA_DIRECTORY *data_dir = NULL;
1432 if (nt_header->OptionalHeader.Magic == IMAGE_NT_OPTIONAL_HDR32_MAGIC)
1433 {
1434 /* Ensure we are using the 32 bit structure. */
1435 IMAGE_OPTIONAL_HEADER32 *opt
1436 = (IMAGE_OPTIONAL_HEADER32*) &(nt_header->OptionalHeader);
1437 data_dir = opt->DataDirectory;
1438 *is_gui_app = (opt->Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
1439 }
1440 /* MingW 3.12 has the required 64 bit structs, but in case older
1441 versions don't, only check 64 bit exes if we know how. */
1442 #ifdef IMAGE_NT_OPTIONAL_HDR64_MAGIC
1443 else if (nt_header->OptionalHeader.Magic
1444 == IMAGE_NT_OPTIONAL_HDR64_MAGIC)
1445 {
1446 IMAGE_OPTIONAL_HEADER64 *opt
1447 = (IMAGE_OPTIONAL_HEADER64*) &(nt_header->OptionalHeader);
1448 data_dir = opt->DataDirectory;
1449 *is_gui_app = (opt->Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
1450 }
1451 #endif
1452 if (data_dir)
1453 {
1454 /* Look for cygwin.dll in DLL import list. */
1455 IMAGE_DATA_DIRECTORY import_dir =
1456 data_dir[IMAGE_DIRECTORY_ENTRY_IMPORT];
1457 IMAGE_IMPORT_DESCRIPTOR * imports;
1458 IMAGE_SECTION_HEADER * section;
1459
1460 section = rva_to_section (import_dir.VirtualAddress, nt_header);
1461 imports = RVA_TO_PTR (import_dir.VirtualAddress, section,
1462 executable);
1463
1464 for ( ; imports->Name; imports++)
1465 {
1466 char * dllname = RVA_TO_PTR (imports->Name, section,
1467 executable);
1468
1469 /* The exact name of the cygwin dll has changed with
1470 various releases, but hopefully this will be reasonably
1471 future proof. */
1472 if (strncmp (dllname, "cygwin", 6) == 0)
1473 {
1474 *is_cygnus_app = TRUE;
1475 break;
1476 }
1477 }
1478 }
1479 }
1480 }
1481
1482 unwind:
1483 close_file_data (&executable);
1484 }
1485
1486 static int
1487 compare_env (const void *strp1, const void *strp2)
1488 {
1489 const char *str1 = *(const char **)strp1, *str2 = *(const char **)strp2;
1490
1491 while (*str1 && *str2 && *str1 != '=' && *str2 != '=')
1492 {
1493 /* Sort order in command.com/cmd.exe is based on uppercasing
1494 names, so do the same here. */
1495 if (toupper (*str1) > toupper (*str2))
1496 return 1;
1497 else if (toupper (*str1) < toupper (*str2))
1498 return -1;
1499 str1++, str2++;
1500 }
1501
1502 if (*str1 == '=' && *str2 == '=')
1503 return 0;
1504 else if (*str1 == '=')
1505 return -1;
1506 else
1507 return 1;
1508 }
1509
1510 static void
1511 merge_and_sort_env (char **envp1, char **envp2, char **new_envp)
1512 {
1513 char **optr, **nptr;
1514 int num;
1515
1516 nptr = new_envp;
1517 optr = envp1;
1518 while (*optr)
1519 *nptr++ = *optr++;
1520 num = optr - envp1;
1521
1522 optr = envp2;
1523 while (*optr)
1524 *nptr++ = *optr++;
1525 num += optr - envp2;
1526
1527 qsort (new_envp, num, sizeof (char *), compare_env);
1528
1529 *nptr = NULL;
1530 }
1531
1532 /* When a new child process is created we need to register it in our list,
1533 so intercept spawn requests. */
1534 int
1535 sys_spawnve (int mode, char *cmdname, char **argv, char **envp)
1536 {
1537 Lisp_Object program, full;
1538 char *cmdline, *env, *parg, **targ;
1539 int arglen, numenv;
1540 pid_t pid;
1541 child_process *cp;
1542 int is_dos_app, is_cygnus_app, is_gui_app;
1543 int do_quoting = 0;
1544 /* We pass our process ID to our children by setting up an environment
1545 variable in their environment. */
1546 char ppid_env_var_buffer[64];
1547 char *extra_env[] = {ppid_env_var_buffer, NULL};
1548 /* These are the characters that cause an argument to need quoting.
1549 Arguments with whitespace characters need quoting to prevent the
1550 argument being split into two or more. Arguments with wildcards
1551 are also quoted, for consistency with posix platforms, where wildcards
1552 are not expanded if we run the program directly without a shell.
1553 Some extra whitespace characters need quoting in Cygwin programs,
1554 so this list is conditionally modified below. */
1555 char *sepchars = " \t*?";
1556 /* This is for native w32 apps; modified below for Cygwin apps. */
1557 char escape_char = '\\';
1558
1559 /* We don't care about the other modes */
1560 if (mode != _P_NOWAIT)
1561 {
1562 errno = EINVAL;
1563 return -1;
1564 }
1565
1566 /* Handle executable names without an executable suffix. */
1567 program = build_string (cmdname);
1568 if (NILP (Ffile_executable_p (program)))
1569 {
1570 struct gcpro gcpro1;
1571
1572 full = Qnil;
1573 GCPRO1 (program);
1574 openp (Vexec_path, program, Vexec_suffixes, &full, make_number (X_OK));
1575 UNGCPRO;
1576 if (NILP (full))
1577 {
1578 errno = EINVAL;
1579 return -1;
1580 }
1581 program = full;
1582 }
1583
1584 /* make sure argv[0] and cmdname are both in DOS format */
1585 cmdname = SDATA (program);
1586 unixtodos_filename (cmdname);
1587 argv[0] = cmdname;
1588
1589 /* Determine whether program is a 16-bit DOS executable, or a 32-bit Windows
1590 executable that is implicitly linked to the Cygnus dll (implying it
1591 was compiled with the Cygnus GNU toolchain and hence relies on
1592 cygwin.dll to parse the command line - we use this to decide how to
1593 escape quote chars in command line args that must be quoted).
1594
1595 Also determine whether it is a GUI app, so that we don't hide its
1596 initial window unless specifically requested. */
1597 w32_executable_type (cmdname, &is_dos_app, &is_cygnus_app, &is_gui_app);
1598
1599 /* On Windows 95, if cmdname is a DOS app, we invoke a helper
1600 application to start it by specifying the helper app as cmdname,
1601 while leaving the real app name as argv[0]. */
1602 if (is_dos_app)
1603 {
1604 cmdname = alloca (MAXPATHLEN);
1605 if (egetenv ("CMDPROXY"))
1606 strcpy (cmdname, egetenv ("CMDPROXY"));
1607 else
1608 {
1609 strcpy (cmdname, SDATA (Vinvocation_directory));
1610 strcat (cmdname, "cmdproxy.exe");
1611 }
1612 unixtodos_filename (cmdname);
1613 }
1614
1615 /* we have to do some conjuring here to put argv and envp into the
1616 form CreateProcess wants... argv needs to be a space separated/null
1617 terminated list of parameters, and envp is a null
1618 separated/double-null terminated list of parameters.
1619
1620 Additionally, zero-length args and args containing whitespace or
1621 quote chars need to be wrapped in double quotes - for this to work,
1622 embedded quotes need to be escaped as well. The aim is to ensure
1623 the child process reconstructs the argv array we start with
1624 exactly, so we treat quotes at the beginning and end of arguments
1625 as embedded quotes.
1626
1627 The w32 GNU-based library from Cygnus doubles quotes to escape
1628 them, while MSVC uses backslash for escaping. (Actually the MSVC
1629 startup code does attempt to recognize doubled quotes and accept
1630 them, but gets it wrong and ends up requiring three quotes to get a
1631 single embedded quote!) So by default we decide whether to use
1632 quote or backslash as the escape character based on whether the
1633 binary is apparently a Cygnus compiled app.
1634
1635 Note that using backslash to escape embedded quotes requires
1636 additional special handling if an embedded quote is already
1637 preceded by backslash, or if an arg requiring quoting ends with
1638 backslash. In such cases, the run of escape characters needs to be
1639 doubled. For consistency, we apply this special handling as long
1640 as the escape character is not quote.
1641
1642 Since we have no idea how large argv and envp are likely to be we
1643 figure out list lengths on the fly and allocate them. */
1644
1645 if (!NILP (Vw32_quote_process_args))
1646 {
1647 do_quoting = 1;
1648 /* Override escape char by binding w32-quote-process-args to
1649 desired character, or use t for auto-selection. */
1650 if (INTEGERP (Vw32_quote_process_args))
1651 escape_char = XINT (Vw32_quote_process_args);
1652 else
1653 escape_char = is_cygnus_app ? '"' : '\\';
1654 }
1655
1656 /* Cygwin apps needs quoting a bit more often. */
1657 if (escape_char == '"')
1658 sepchars = "\r\n\t\f '";
1659
1660 /* do argv... */
1661 arglen = 0;
1662 targ = argv;
1663 while (*targ)
1664 {
1665 char * p = *targ;
1666 int need_quotes = 0;
1667 int escape_char_run = 0;
1668
1669 if (*p == 0)
1670 need_quotes = 1;
1671 for ( ; *p; p++)
1672 {
1673 if (escape_char == '"' && *p == '\\')
1674 /* If it's a Cygwin app, \ needs to be escaped. */
1675 arglen++;
1676 else if (*p == '"')
1677 {
1678 /* allow for embedded quotes to be escaped */
1679 arglen++;
1680 need_quotes = 1;
1681 /* handle the case where the embedded quote is already escaped */
1682 if (escape_char_run > 0)
1683 {
1684 /* To preserve the arg exactly, we need to double the
1685 preceding escape characters (plus adding one to
1686 escape the quote character itself). */
1687 arglen += escape_char_run;
1688 }
1689 }
1690 else if (strchr (sepchars, *p) != NULL)
1691 {
1692 need_quotes = 1;
1693 }
1694
1695 if (*p == escape_char && escape_char != '"')
1696 escape_char_run++;
1697 else
1698 escape_char_run = 0;
1699 }
1700 if (need_quotes)
1701 {
1702 arglen += 2;
1703 /* handle the case where the arg ends with an escape char - we
1704 must not let the enclosing quote be escaped. */
1705 if (escape_char_run > 0)
1706 arglen += escape_char_run;
1707 }
1708 arglen += strlen (*targ++) + 1;
1709 }
1710 cmdline = alloca (arglen);
1711 targ = argv;
1712 parg = cmdline;
1713 while (*targ)
1714 {
1715 char * p = *targ;
1716 int need_quotes = 0;
1717
1718 if (*p == 0)
1719 need_quotes = 1;
1720
1721 if (do_quoting)
1722 {
1723 for ( ; *p; p++)
1724 if ((strchr (sepchars, *p) != NULL) || *p == '"')
1725 need_quotes = 1;
1726 }
1727 if (need_quotes)
1728 {
1729 int escape_char_run = 0;
1730 char * first;
1731 char * last;
1732
1733 p = *targ;
1734 first = p;
1735 last = p + strlen (p) - 1;
1736 *parg++ = '"';
1737 #if 0
1738 /* This version does not escape quotes if they occur at the
1739 beginning or end of the arg - this could lead to incorrect
1740 behavior when the arg itself represents a command line
1741 containing quoted args. I believe this was originally done
1742 as a hack to make some things work, before
1743 `w32-quote-process-args' was added. */
1744 while (*p)
1745 {
1746 if (*p == '"' && p > first && p < last)
1747 *parg++ = escape_char; /* escape embedded quotes */
1748 *parg++ = *p++;
1749 }
1750 #else
1751 for ( ; *p; p++)
1752 {
1753 if (*p == '"')
1754 {
1755 /* double preceding escape chars if any */
1756 while (escape_char_run > 0)
1757 {
1758 *parg++ = escape_char;
1759 escape_char_run--;
1760 }
1761 /* escape all quote chars, even at beginning or end */
1762 *parg++ = escape_char;
1763 }
1764 else if (escape_char == '"' && *p == '\\')
1765 *parg++ = '\\';
1766 *parg++ = *p;
1767
1768 if (*p == escape_char && escape_char != '"')
1769 escape_char_run++;
1770 else
1771 escape_char_run = 0;
1772 }
1773 /* double escape chars before enclosing quote */
1774 while (escape_char_run > 0)
1775 {
1776 *parg++ = escape_char;
1777 escape_char_run--;
1778 }
1779 #endif
1780 *parg++ = '"';
1781 }
1782 else
1783 {
1784 strcpy (parg, *targ);
1785 parg += strlen (*targ);
1786 }
1787 *parg++ = ' ';
1788 targ++;
1789 }
1790 *--parg = '\0';
1791
1792 /* and envp... */
1793 arglen = 1;
1794 targ = envp;
1795 numenv = 1; /* for end null */
1796 while (*targ)
1797 {
1798 arglen += strlen (*targ++) + 1;
1799 numenv++;
1800 }
1801 /* extra env vars... */
1802 sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%lu",
1803 GetCurrentProcessId ());
1804 arglen += strlen (ppid_env_var_buffer) + 1;
1805 numenv++;
1806
1807 /* merge env passed in and extra env into one, and sort it. */
1808 targ = (char **) alloca (numenv * sizeof (char *));
1809 merge_and_sort_env (envp, extra_env, targ);
1810
1811 /* concatenate env entries. */
1812 env = alloca (arglen);
1813 parg = env;
1814 while (*targ)
1815 {
1816 strcpy (parg, *targ);
1817 parg += strlen (*targ++);
1818 *parg++ = '\0';
1819 }
1820 *parg++ = '\0';
1821 *parg = '\0';
1822
1823 cp = new_child ();
1824 if (cp == NULL)
1825 {
1826 errno = EAGAIN;
1827 return -1;
1828 }
1829
1830 /* Now create the process. */
1831 if (!create_child (cmdname, cmdline, env, is_gui_app, &pid, cp))
1832 {
1833 delete_child (cp);
1834 errno = ENOEXEC;
1835 return -1;
1836 }
1837
1838 return pid;
1839 }
1840
1841 /* Emulate the select call
1842 Wait for available input on any of the given rfds, or timeout if
1843 a timeout is given and no input is detected
1844 wfds and efds are not supported and must be NULL.
1845
1846 For simplicity, we detect the death of child processes here and
1847 synchronously call the SIGCHLD handler. Since it is possible for
1848 children to be created without a corresponding pipe handle from which
1849 to read output, we wait separately on the process handles as well as
1850 the char_avail events for each process pipe. We only call
1851 wait/reap_process when the process actually terminates.
1852
1853 To reduce the number of places in which Emacs can be hung such that
1854 C-g is not able to interrupt it, we always wait on interrupt_handle
1855 (which is signaled by the input thread when C-g is detected). If we
1856 detect that we were woken up by C-g, we return -1 with errno set to
1857 EINTR as on Unix. */
1858
1859 /* From w32console.c */
1860 extern HANDLE keyboard_handle;
1861
1862 /* From w32xfns.c */
1863 extern HANDLE interrupt_handle;
1864
1865 /* From process.c */
1866 extern int proc_buffered_char[];
1867
1868 int
1869 sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
1870 EMACS_TIME *timeout, void *ignored)
1871 {
1872 SELECT_TYPE orfds;
1873 DWORD timeout_ms, start_time;
1874 int i, nh, nc, nr;
1875 DWORD active;
1876 child_process *cp, *cps[MAX_CHILDREN];
1877 HANDLE wait_hnd[MAXDESC + MAX_CHILDREN];
1878 int fdindex[MAXDESC]; /* mapping from wait handles back to descriptors */
1879
1880 timeout_ms =
1881 timeout ? (timeout->tv_sec * 1000 + timeout->tv_nsec / 1000000) : INFINITE;
1882
1883 /* If the descriptor sets are NULL but timeout isn't, then just Sleep. */
1884 if (rfds == NULL && wfds == NULL && efds == NULL && timeout != NULL)
1885 {
1886 Sleep (timeout_ms);
1887 return 0;
1888 }
1889
1890 /* Otherwise, we only handle rfds, so fail otherwise. */
1891 if (rfds == NULL || wfds != NULL || efds != NULL)
1892 {
1893 errno = EINVAL;
1894 return -1;
1895 }
1896
1897 orfds = *rfds;
1898 FD_ZERO (rfds);
1899 nr = 0;
1900
1901 /* Always wait on interrupt_handle, to detect C-g (quit). */
1902 wait_hnd[0] = interrupt_handle;
1903 fdindex[0] = -1;
1904
1905 /* Build a list of pipe handles to wait on. */
1906 nh = 1;
1907 for (i = 0; i < nfds; i++)
1908 if (FD_ISSET (i, &orfds))
1909 {
1910 if (i == 0)
1911 {
1912 if (keyboard_handle)
1913 {
1914 /* Handle stdin specially */
1915 wait_hnd[nh] = keyboard_handle;
1916 fdindex[nh] = i;
1917 nh++;
1918 }
1919
1920 /* Check for any emacs-generated input in the queue since
1921 it won't be detected in the wait */
1922 if (detect_input_pending ())
1923 {
1924 FD_SET (i, rfds);
1925 return 1;
1926 }
1927 }
1928 else
1929 {
1930 /* Child process and socket/comm port input. */
1931 cp = fd_info[i].cp;
1932 if (cp)
1933 {
1934 int current_status = cp->status;
1935
1936 if (current_status == STATUS_READ_ACKNOWLEDGED)
1937 {
1938 /* Tell reader thread which file handle to use. */
1939 cp->fd = i;
1940 /* Wake up the reader thread for this process */
1941 cp->status = STATUS_READ_READY;
1942 if (!SetEvent (cp->char_consumed))
1943 DebPrint (("sys_select.SetEvent failed with "
1944 "%lu for fd %ld\n", GetLastError (), i));
1945 }
1946
1947 #ifdef CHECK_INTERLOCK
1948 /* slightly crude cross-checking of interlock between threads */
1949
1950 current_status = cp->status;
1951 if (WaitForSingleObject (cp->char_avail, 0) == WAIT_OBJECT_0)
1952 {
1953 /* char_avail has been signaled, so status (which may
1954 have changed) should indicate read has completed
1955 but has not been acknowledged. */
1956 current_status = cp->status;
1957 if (current_status != STATUS_READ_SUCCEEDED
1958 && current_status != STATUS_READ_FAILED)
1959 DebPrint (("char_avail set, but read not completed: status %d\n",
1960 current_status));
1961 }
1962 else
1963 {
1964 /* char_avail has not been signaled, so status should
1965 indicate that read is in progress; small possibility
1966 that read has completed but event wasn't yet signaled
1967 when we tested it (because a context switch occurred
1968 or if running on separate CPUs). */
1969 if (current_status != STATUS_READ_READY
1970 && current_status != STATUS_READ_IN_PROGRESS
1971 && current_status != STATUS_READ_SUCCEEDED
1972 && current_status != STATUS_READ_FAILED)
1973 DebPrint (("char_avail reset, but read status is bad: %d\n",
1974 current_status));
1975 }
1976 #endif
1977 wait_hnd[nh] = cp->char_avail;
1978 fdindex[nh] = i;
1979 if (!wait_hnd[nh]) emacs_abort ();
1980 nh++;
1981 #ifdef FULL_DEBUG
1982 DebPrint (("select waiting on child %d fd %d\n",
1983 cp-child_procs, i));
1984 #endif
1985 }
1986 else
1987 {
1988 /* Unable to find something to wait on for this fd, skip */
1989
1990 /* Note that this is not a fatal error, and can in fact
1991 happen in unusual circumstances. Specifically, if
1992 sys_spawnve fails, eg. because the program doesn't
1993 exist, and debug-on-error is t so Fsignal invokes a
1994 nested input loop, then the process output pipe is
1995 still included in input_wait_mask with no child_proc
1996 associated with it. (It is removed when the debugger
1997 exits the nested input loop and the error is thrown.) */
1998
1999 DebPrint (("sys_select: fd %ld is invalid! ignoring\n", i));
2000 }
2001 }
2002 }
2003
2004 count_children:
2005 /* Add handles of child processes. */
2006 nc = 0;
2007 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
2008 /* Some child_procs might be sockets; ignore them. Also some
2009 children may have died already, but we haven't finished reading
2010 the process output; ignore them too. */
2011 if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess
2012 && (cp->fd < 0
2013 || (fd_info[cp->fd].flags & FILE_SEND_SIGCHLD) == 0
2014 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0)
2015 )
2016 {
2017 wait_hnd[nh + nc] = cp->procinfo.hProcess;
2018 cps[nc] = cp;
2019 nc++;
2020 }
2021
2022 /* Nothing to look for, so we didn't find anything */
2023 if (nh + nc == 0)
2024 {
2025 if (timeout)
2026 Sleep (timeout_ms);
2027 return 0;
2028 }
2029
2030 start_time = GetTickCount ();
2031
2032 /* Wait for input or child death to be signaled. If user input is
2033 allowed, then also accept window messages. */
2034 if (FD_ISSET (0, &orfds))
2035 active = MsgWaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms,
2036 QS_ALLINPUT);
2037 else
2038 active = WaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms);
2039
2040 if (active == WAIT_FAILED)
2041 {
2042 DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n",
2043 nh + nc, timeout_ms, GetLastError ()));
2044 /* don't return EBADF - this causes wait_reading_process_output to
2045 abort; WAIT_FAILED is returned when single-stepping under
2046 Windows 95 after switching thread focus in debugger, and
2047 possibly at other times. */
2048 errno = EINTR;
2049 return -1;
2050 }
2051 else if (active == WAIT_TIMEOUT)
2052 {
2053 return 0;
2054 }
2055 else if (active >= WAIT_OBJECT_0
2056 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
2057 {
2058 active -= WAIT_OBJECT_0;
2059 }
2060 else if (active >= WAIT_ABANDONED_0
2061 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
2062 {
2063 active -= WAIT_ABANDONED_0;
2064 }
2065 else
2066 emacs_abort ();
2067
2068 /* Loop over all handles after active (now officially documented as
2069 being the first signaled handle in the array). We do this to
2070 ensure fairness, so that all channels with data available will be
2071 processed - otherwise higher numbered channels could be starved. */
2072 do
2073 {
2074 if (active == nh + nc)
2075 {
2076 /* There are messages in the lisp thread's queue; we must
2077 drain the queue now to ensure they are processed promptly,
2078 because if we don't do so, we will not be woken again until
2079 further messages arrive.
2080
2081 NB. If ever we allow window message procedures to callback
2082 into lisp, we will need to ensure messages are dispatched
2083 at a safe time for lisp code to be run (*), and we may also
2084 want to provide some hooks in the dispatch loop to cater
2085 for modeless dialogs created by lisp (ie. to register
2086 window handles to pass to IsDialogMessage).
2087
2088 (*) Note that MsgWaitForMultipleObjects above is an
2089 internal dispatch point for messages that are sent to
2090 windows created by this thread. */
2091 if (drain_message_queue ()
2092 /* If drain_message_queue returns non-zero, that means
2093 we received a WM_EMACS_FILENOTIFY message. If this
2094 is a TTY frame, we must signal the caller that keyboard
2095 input is available, so that w32_console_read_socket
2096 will be called to pick up the notifications. If we
2097 don't do that, file notifications will only work when
2098 the Emacs TTY frame has focus. */
2099 && FRAME_TERMCAP_P (SELECTED_FRAME ())
2100 /* they asked for stdin reads */
2101 && FD_ISSET (0, &orfds)
2102 /* the stdin handle is valid */
2103 && keyboard_handle)
2104 {
2105 FD_SET (0, rfds);
2106 if (nr == 0)
2107 nr = 1;
2108 }
2109 }
2110 else if (active >= nh)
2111 {
2112 cp = cps[active - nh];
2113
2114 /* We cannot always signal SIGCHLD immediately; if we have not
2115 finished reading the process output, we must delay sending
2116 SIGCHLD until we do. */
2117
2118 if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_AT_EOF) == 0)
2119 fd_info[cp->fd].flags |= FILE_SEND_SIGCHLD;
2120 /* SIG_DFL for SIGCHLD is ignore */
2121 else if (sig_handlers[SIGCHLD] != SIG_DFL &&
2122 sig_handlers[SIGCHLD] != SIG_IGN)
2123 {
2124 #ifdef FULL_DEBUG
2125 DebPrint (("select calling SIGCHLD handler for pid %d\n",
2126 cp->pid));
2127 #endif
2128 sig_handlers[SIGCHLD] (SIGCHLD);
2129 }
2130 }
2131 else if (fdindex[active] == -1)
2132 {
2133 /* Quit (C-g) was detected. */
2134 errno = EINTR;
2135 return -1;
2136 }
2137 else if (fdindex[active] == 0)
2138 {
2139 /* Keyboard input available */
2140 FD_SET (0, rfds);
2141 nr++;
2142 }
2143 else
2144 {
2145 /* must be a socket or pipe - read ahead should have
2146 completed, either succeeding or failing. */
2147 FD_SET (fdindex[active], rfds);
2148 nr++;
2149 }
2150
2151 /* Even though wait_reading_process_output only reads from at most
2152 one channel, we must process all channels here so that we reap
2153 all children that have died. */
2154 while (++active < nh + nc)
2155 if (WaitForSingleObject (wait_hnd[active], 0) == WAIT_OBJECT_0)
2156 break;
2157 } while (active < nh + nc);
2158
2159 /* If no input has arrived and timeout hasn't expired, wait again. */
2160 if (nr == 0)
2161 {
2162 DWORD elapsed = GetTickCount () - start_time;
2163
2164 if (timeout_ms > elapsed) /* INFINITE is MAX_UINT */
2165 {
2166 if (timeout_ms != INFINITE)
2167 timeout_ms -= elapsed;
2168 goto count_children;
2169 }
2170 }
2171
2172 return nr;
2173 }
2174
2175 /* Substitute for certain kill () operations */
2176
2177 static BOOL CALLBACK
2178 find_child_console (HWND hwnd, LPARAM arg)
2179 {
2180 child_process * cp = (child_process *) arg;
2181 DWORD thread_id;
2182 DWORD process_id;
2183
2184 thread_id = GetWindowThreadProcessId (hwnd, &process_id);
2185 if (process_id == cp->procinfo.dwProcessId)
2186 {
2187 char window_class[32];
2188
2189 GetClassName (hwnd, window_class, sizeof (window_class));
2190 if (strcmp (window_class,
2191 (os_subtype == OS_9X)
2192 ? "tty"
2193 : "ConsoleWindowClass") == 0)
2194 {
2195 cp->hwnd = hwnd;
2196 return FALSE;
2197 }
2198 }
2199 /* keep looking */
2200 return TRUE;
2201 }
2202
2203 /* Emulate 'kill', but only for other processes. */
2204 int
2205 sys_kill (pid_t pid, int sig)
2206 {
2207 child_process *cp;
2208 HANDLE proc_hand;
2209 int need_to_free = 0;
2210 int rc = 0;
2211
2212 /* Each process is in its own process group. */
2213 if (pid < 0)
2214 pid = -pid;
2215
2216 /* Only handle signals that will result in the process dying */
2217 if (sig != SIGINT && sig != SIGKILL && sig != SIGQUIT && sig != SIGHUP)
2218 {
2219 errno = EINVAL;
2220 return -1;
2221 }
2222
2223 cp = find_child_pid (pid);
2224 if (cp == NULL)
2225 {
2226 /* We were passed a PID of something other than our subprocess.
2227 If that is our own PID, we will send to ourself a message to
2228 close the selected frame, which does not necessarily
2229 terminates Emacs. But then we are not supposed to call
2230 sys_kill with our own PID. */
2231 proc_hand = OpenProcess (PROCESS_TERMINATE, 0, pid);
2232 if (proc_hand == NULL)
2233 {
2234 errno = EPERM;
2235 return -1;
2236 }
2237 need_to_free = 1;
2238 }
2239 else
2240 {
2241 proc_hand = cp->procinfo.hProcess;
2242 pid = cp->procinfo.dwProcessId;
2243
2244 /* Try to locate console window for process. */
2245 EnumWindows (find_child_console, (LPARAM) cp);
2246 }
2247
2248 if (sig == SIGINT || sig == SIGQUIT)
2249 {
2250 if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
2251 {
2252 BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0);
2253 /* Fake Ctrl-C for SIGINT, and Ctrl-Break for SIGQUIT. */
2254 BYTE vk_break_code = (sig == SIGINT) ? 'C' : VK_CANCEL;
2255 BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
2256 HWND foreground_window;
2257
2258 if (break_scan_code == 0)
2259 {
2260 /* Fake Ctrl-C for SIGQUIT if we can't manage Ctrl-Break. */
2261 vk_break_code = 'C';
2262 break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
2263 }
2264
2265 foreground_window = GetForegroundWindow ();
2266 if (foreground_window)
2267 {
2268 /* NT 5.0, and apparently also Windows 98, will not allow
2269 a Window to be set to foreground directly without the
2270 user's involvement. The workaround is to attach
2271 ourselves to the thread that owns the foreground
2272 window, since that is the only thread that can set the
2273 foreground window. */
2274 DWORD foreground_thread, child_thread;
2275 foreground_thread =
2276 GetWindowThreadProcessId (foreground_window, NULL);
2277 if (foreground_thread == GetCurrentThreadId ()
2278 || !AttachThreadInput (GetCurrentThreadId (),
2279 foreground_thread, TRUE))
2280 foreground_thread = 0;
2281
2282 child_thread = GetWindowThreadProcessId (cp->hwnd, NULL);
2283 if (child_thread == GetCurrentThreadId ()
2284 || !AttachThreadInput (GetCurrentThreadId (),
2285 child_thread, TRUE))
2286 child_thread = 0;
2287
2288 /* Set the foreground window to the child. */
2289 if (SetForegroundWindow (cp->hwnd))
2290 {
2291 /* Generate keystrokes as if user had typed Ctrl-Break or
2292 Ctrl-C. */
2293 keybd_event (VK_CONTROL, control_scan_code, 0, 0);
2294 keybd_event (vk_break_code, break_scan_code,
2295 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0);
2296 keybd_event (vk_break_code, break_scan_code,
2297 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY)
2298 | KEYEVENTF_KEYUP, 0);
2299 keybd_event (VK_CONTROL, control_scan_code,
2300 KEYEVENTF_KEYUP, 0);
2301
2302 /* Sleep for a bit to give time for Emacs frame to respond
2303 to focus change events (if Emacs was active app). */
2304 Sleep (100);
2305
2306 SetForegroundWindow (foreground_window);
2307 }
2308 /* Detach from the foreground and child threads now that
2309 the foreground switching is over. */
2310 if (foreground_thread)
2311 AttachThreadInput (GetCurrentThreadId (),
2312 foreground_thread, FALSE);
2313 if (child_thread)
2314 AttachThreadInput (GetCurrentThreadId (),
2315 child_thread, FALSE);
2316 }
2317 }
2318 /* Ctrl-Break is NT equivalent of SIGINT. */
2319 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid))
2320 {
2321 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
2322 "for pid %lu\n", GetLastError (), pid));
2323 errno = EINVAL;
2324 rc = -1;
2325 }
2326 }
2327 else
2328 {
2329 if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
2330 {
2331 #if 1
2332 if (os_subtype == OS_9X)
2333 {
2334 /*
2335 Another possibility is to try terminating the VDM out-right by
2336 calling the Shell VxD (id 0x17) V86 interface, function #4
2337 "SHELL_Destroy_VM", ie.
2338
2339 mov edx,4
2340 mov ebx,vm_handle
2341 call shellapi
2342
2343 First need to determine the current VM handle, and then arrange for
2344 the shellapi call to be made from the system vm (by using
2345 Switch_VM_and_callback).
2346
2347 Could try to invoke DestroyVM through CallVxD.
2348
2349 */
2350 #if 0
2351 /* On Windows 95, posting WM_QUIT causes the 16-bit subsystem
2352 to hang when cmdproxy is used in conjunction with
2353 command.com for an interactive shell. Posting
2354 WM_CLOSE pops up a dialog that, when Yes is selected,
2355 does the same thing. TerminateProcess is also less
2356 than ideal in that subprocesses tend to stick around
2357 until the machine is shutdown, but at least it
2358 doesn't freeze the 16-bit subsystem. */
2359 PostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
2360 #endif
2361 if (!TerminateProcess (proc_hand, 0xff))
2362 {
2363 DebPrint (("sys_kill.TerminateProcess returned %d "
2364 "for pid %lu\n", GetLastError (), pid));
2365 errno = EINVAL;
2366 rc = -1;
2367 }
2368 }
2369 else
2370 #endif
2371 PostMessage (cp->hwnd, WM_CLOSE, 0, 0);
2372 }
2373 /* Kill the process. On W32 this doesn't kill child processes
2374 so it doesn't work very well for shells which is why it's not
2375 used in every case. */
2376 else if (!TerminateProcess (proc_hand, 0xff))
2377 {
2378 DebPrint (("sys_kill.TerminateProcess returned %d "
2379 "for pid %lu\n", GetLastError (), pid));
2380 errno = EINVAL;
2381 rc = -1;
2382 }
2383 }
2384
2385 if (need_to_free)
2386 CloseHandle (proc_hand);
2387
2388 return rc;
2389 }
2390
2391 /* The following two routines are used to manipulate stdin, stdout, and
2392 stderr of our child processes.
2393
2394 Assuming that in, out, and err are *not* inheritable, we make them
2395 stdin, stdout, and stderr of the child as follows:
2396
2397 - Save the parent's current standard handles.
2398 - Set the std handles to inheritable duplicates of the ones being passed in.
2399 (Note that _get_osfhandle() is an io.h procedure that retrieves the
2400 NT file handle for a crt file descriptor.)
2401 - Spawn the child, which inherits in, out, and err as stdin,
2402 stdout, and stderr. (see Spawnve)
2403 - Close the std handles passed to the child.
2404 - Reset the parent's standard handles to the saved handles.
2405 (see reset_standard_handles)
2406 We assume that the caller closes in, out, and err after calling us. */
2407
2408 void
2409 prepare_standard_handles (int in, int out, int err, HANDLE handles[3])
2410 {
2411 HANDLE parent;
2412 HANDLE newstdin, newstdout, newstderr;
2413
2414 parent = GetCurrentProcess ();
2415
2416 handles[0] = GetStdHandle (STD_INPUT_HANDLE);
2417 handles[1] = GetStdHandle (STD_OUTPUT_HANDLE);
2418 handles[2] = GetStdHandle (STD_ERROR_HANDLE);
2419
2420 /* make inheritable copies of the new handles */
2421 if (!DuplicateHandle (parent,
2422 (HANDLE) _get_osfhandle (in),
2423 parent,
2424 &newstdin,
2425 0,
2426 TRUE,
2427 DUPLICATE_SAME_ACCESS))
2428 report_file_error ("Duplicating input handle for child", Qnil);
2429
2430 if (!DuplicateHandle (parent,
2431 (HANDLE) _get_osfhandle (out),
2432 parent,
2433 &newstdout,
2434 0,
2435 TRUE,
2436 DUPLICATE_SAME_ACCESS))
2437 report_file_error ("Duplicating output handle for child", Qnil);
2438
2439 if (!DuplicateHandle (parent,
2440 (HANDLE) _get_osfhandle (err),
2441 parent,
2442 &newstderr,
2443 0,
2444 TRUE,
2445 DUPLICATE_SAME_ACCESS))
2446 report_file_error ("Duplicating error handle for child", Qnil);
2447
2448 /* and store them as our std handles */
2449 if (!SetStdHandle (STD_INPUT_HANDLE, newstdin))
2450 report_file_error ("Changing stdin handle", Qnil);
2451
2452 if (!SetStdHandle (STD_OUTPUT_HANDLE, newstdout))
2453 report_file_error ("Changing stdout handle", Qnil);
2454
2455 if (!SetStdHandle (STD_ERROR_HANDLE, newstderr))
2456 report_file_error ("Changing stderr handle", Qnil);
2457 }
2458
2459 void
2460 reset_standard_handles (int in, int out, int err, HANDLE handles[3])
2461 {
2462 /* close the duplicated handles passed to the child */
2463 CloseHandle (GetStdHandle (STD_INPUT_HANDLE));
2464 CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE));
2465 CloseHandle (GetStdHandle (STD_ERROR_HANDLE));
2466
2467 /* now restore parent's saved std handles */
2468 SetStdHandle (STD_INPUT_HANDLE, handles[0]);
2469 SetStdHandle (STD_OUTPUT_HANDLE, handles[1]);
2470 SetStdHandle (STD_ERROR_HANDLE, handles[2]);
2471 }
2472
2473 void
2474 set_process_dir (char * dir)
2475 {
2476 process_dir = dir;
2477 }
2478
2479 /* To avoid problems with winsock implementations that work over dial-up
2480 connections causing or requiring a connection to exist while Emacs is
2481 running, Emacs no longer automatically loads winsock on startup if it
2482 is present. Instead, it will be loaded when open-network-stream is
2483 first called.
2484
2485 To allow full control over when winsock is loaded, we provide these
2486 two functions to dynamically load and unload winsock. This allows
2487 dial-up users to only be connected when they actually need to use
2488 socket services. */
2489
2490 /* From w32.c */
2491 extern HANDLE winsock_lib;
2492 extern BOOL term_winsock (void);
2493 extern BOOL init_winsock (int load_now);
2494
2495 DEFUN ("w32-has-winsock", Fw32_has_winsock, Sw32_has_winsock, 0, 1, 0,
2496 doc: /* Test for presence of the Windows socket library `winsock'.
2497 Returns non-nil if winsock support is present, nil otherwise.
2498
2499 If the optional argument LOAD-NOW is non-nil, the winsock library is
2500 also loaded immediately if not already loaded. If winsock is loaded,
2501 the winsock local hostname is returned (since this may be different from
2502 the value of `system-name' and should supplant it), otherwise t is
2503 returned to indicate winsock support is present. */)
2504 (Lisp_Object load_now)
2505 {
2506 int have_winsock;
2507
2508 have_winsock = init_winsock (!NILP (load_now));
2509 if (have_winsock)
2510 {
2511 if (winsock_lib != NULL)
2512 {
2513 /* Return new value for system-name. The best way to do this
2514 is to call init_system_name, saving and restoring the
2515 original value to avoid side-effects. */
2516 Lisp_Object orig_hostname = Vsystem_name;
2517 Lisp_Object hostname;
2518
2519 init_system_name ();
2520 hostname = Vsystem_name;
2521 Vsystem_name = orig_hostname;
2522 return hostname;
2523 }
2524 return Qt;
2525 }
2526 return Qnil;
2527 }
2528
2529 DEFUN ("w32-unload-winsock", Fw32_unload_winsock, Sw32_unload_winsock,
2530 0, 0, 0,
2531 doc: /* Unload the Windows socket library `winsock' if loaded.
2532 This is provided to allow dial-up socket connections to be disconnected
2533 when no longer needed. Returns nil without unloading winsock if any
2534 socket connections still exist. */)
2535 (void)
2536 {
2537 return term_winsock () ? Qt : Qnil;
2538 }
2539
2540 \f
2541 /* Some miscellaneous functions that are Windows specific, but not GUI
2542 specific (ie. are applicable in terminal or batch mode as well). */
2543
2544 DEFUN ("w32-short-file-name", Fw32_short_file_name, Sw32_short_file_name, 1, 1, 0,
2545 doc: /* Return the short file name version (8.3) of the full path of FILENAME.
2546 If FILENAME does not exist, return nil.
2547 All path elements in FILENAME are converted to their short names. */)
2548 (Lisp_Object filename)
2549 {
2550 char shortname[MAX_PATH];
2551
2552 CHECK_STRING (filename);
2553
2554 /* first expand it. */
2555 filename = Fexpand_file_name (filename, Qnil);
2556
2557 /* luckily, this returns the short version of each element in the path. */
2558 if (GetShortPathName (SDATA (ENCODE_FILE (filename)), shortname, MAX_PATH) == 0)
2559 return Qnil;
2560
2561 dostounix_filename (shortname);
2562
2563 return build_string (shortname);
2564 }
2565
2566
2567 DEFUN ("w32-long-file-name", Fw32_long_file_name, Sw32_long_file_name,
2568 1, 1, 0,
2569 doc: /* Return the long file name version of the full path of FILENAME.
2570 If FILENAME does not exist, return nil.
2571 All path elements in FILENAME are converted to their long names. */)
2572 (Lisp_Object filename)
2573 {
2574 char longname[ MAX_PATH ];
2575 int drive_only = 0;
2576
2577 CHECK_STRING (filename);
2578
2579 if (SBYTES (filename) == 2
2580 && *(SDATA (filename) + 1) == ':')
2581 drive_only = 1;
2582
2583 /* first expand it. */
2584 filename = Fexpand_file_name (filename, Qnil);
2585
2586 if (!w32_get_long_filename (SDATA (ENCODE_FILE (filename)), longname, MAX_PATH))
2587 return Qnil;
2588
2589 dostounix_filename (longname);
2590
2591 /* If we were passed only a drive, make sure that a slash is not appended
2592 for consistency with directories. Allow for drive mapping via SUBST
2593 in case expand-file-name is ever changed to expand those. */
2594 if (drive_only && longname[1] == ':' && longname[2] == '/' && !longname[3])
2595 longname[2] = '\0';
2596
2597 return DECODE_FILE (build_string (longname));
2598 }
2599
2600 DEFUN ("w32-set-process-priority", Fw32_set_process_priority,
2601 Sw32_set_process_priority, 2, 2, 0,
2602 doc: /* Set the priority of PROCESS to PRIORITY.
2603 If PROCESS is nil, the priority of Emacs is changed, otherwise the
2604 priority of the process whose pid is PROCESS is changed.
2605 PRIORITY should be one of the symbols high, normal, or low;
2606 any other symbol will be interpreted as normal.
2607
2608 If successful, the return value is t, otherwise nil. */)
2609 (Lisp_Object process, Lisp_Object priority)
2610 {
2611 HANDLE proc_handle = GetCurrentProcess ();
2612 DWORD priority_class = NORMAL_PRIORITY_CLASS;
2613 Lisp_Object result = Qnil;
2614
2615 CHECK_SYMBOL (priority);
2616
2617 if (!NILP (process))
2618 {
2619 DWORD pid;
2620 child_process *cp;
2621
2622 CHECK_NUMBER (process);
2623
2624 /* Allow pid to be an internally generated one, or one obtained
2625 externally. This is necessary because real pids on Windows 95 are
2626 negative. */
2627
2628 pid = XINT (process);
2629 cp = find_child_pid (pid);
2630 if (cp != NULL)
2631 pid = cp->procinfo.dwProcessId;
2632
2633 proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
2634 }
2635
2636 if (EQ (priority, Qhigh))
2637 priority_class = HIGH_PRIORITY_CLASS;
2638 else if (EQ (priority, Qlow))
2639 priority_class = IDLE_PRIORITY_CLASS;
2640
2641 if (proc_handle != NULL)
2642 {
2643 if (SetPriorityClass (proc_handle, priority_class))
2644 result = Qt;
2645 if (!NILP (process))
2646 CloseHandle (proc_handle);
2647 }
2648
2649 return result;
2650 }
2651
2652 #ifdef HAVE_LANGINFO_CODESET
2653 /* Emulation of nl_langinfo. Used in fns.c:Flocale_info. */
2654 char *
2655 nl_langinfo (nl_item item)
2656 {
2657 /* Conversion of Posix item numbers to their Windows equivalents. */
2658 static const LCTYPE w32item[] = {
2659 LOCALE_IDEFAULTANSICODEPAGE,
2660 LOCALE_SDAYNAME1, LOCALE_SDAYNAME2, LOCALE_SDAYNAME3,
2661 LOCALE_SDAYNAME4, LOCALE_SDAYNAME5, LOCALE_SDAYNAME6, LOCALE_SDAYNAME7,
2662 LOCALE_SMONTHNAME1, LOCALE_SMONTHNAME2, LOCALE_SMONTHNAME3,
2663 LOCALE_SMONTHNAME4, LOCALE_SMONTHNAME5, LOCALE_SMONTHNAME6,
2664 LOCALE_SMONTHNAME7, LOCALE_SMONTHNAME8, LOCALE_SMONTHNAME9,
2665 LOCALE_SMONTHNAME10, LOCALE_SMONTHNAME11, LOCALE_SMONTHNAME12
2666 };
2667
2668 static char *nl_langinfo_buf = NULL;
2669 static int nl_langinfo_len = 0;
2670
2671 if (nl_langinfo_len <= 0)
2672 nl_langinfo_buf = xmalloc (nl_langinfo_len = 1);
2673
2674 if (item < 0 || item >= _NL_NUM)
2675 nl_langinfo_buf[0] = 0;
2676 else
2677 {
2678 LCID cloc = GetThreadLocale ();
2679 int need_len = GetLocaleInfo (cloc, w32item[item] | LOCALE_USE_CP_ACP,
2680 NULL, 0);
2681
2682 if (need_len <= 0)
2683 nl_langinfo_buf[0] = 0;
2684 else
2685 {
2686 if (item == CODESET)
2687 {
2688 need_len += 2; /* for the "cp" prefix */
2689 if (need_len < 8) /* for the case we call GetACP */
2690 need_len = 8;
2691 }
2692 if (nl_langinfo_len <= need_len)
2693 nl_langinfo_buf = xrealloc (nl_langinfo_buf,
2694 nl_langinfo_len = need_len);
2695 if (!GetLocaleInfo (cloc, w32item[item] | LOCALE_USE_CP_ACP,
2696 nl_langinfo_buf, nl_langinfo_len))
2697 nl_langinfo_buf[0] = 0;
2698 else if (item == CODESET)
2699 {
2700 if (strcmp (nl_langinfo_buf, "0") == 0 /* CP_ACP */
2701 || strcmp (nl_langinfo_buf, "1") == 0) /* CP_OEMCP */
2702 sprintf (nl_langinfo_buf, "cp%u", GetACP ());
2703 else
2704 {
2705 memmove (nl_langinfo_buf + 2, nl_langinfo_buf,
2706 strlen (nl_langinfo_buf) + 1);
2707 nl_langinfo_buf[0] = 'c';
2708 nl_langinfo_buf[1] = 'p';
2709 }
2710 }
2711 }
2712 }
2713 return nl_langinfo_buf;
2714 }
2715 #endif /* HAVE_LANGINFO_CODESET */
2716
2717 DEFUN ("w32-get-locale-info", Fw32_get_locale_info,
2718 Sw32_get_locale_info, 1, 2, 0,
2719 doc: /* Return information about the Windows locale LCID.
2720 By default, return a three letter locale code which encodes the default
2721 language as the first two characters, and the country or regional variant
2722 as the third letter. For example, ENU refers to `English (United States)',
2723 while ENC means `English (Canadian)'.
2724
2725 If the optional argument LONGFORM is t, the long form of the locale
2726 name is returned, e.g. `English (United States)' instead; if LONGFORM
2727 is a number, it is interpreted as an LCTYPE constant and the corresponding
2728 locale information is returned.
2729
2730 If LCID (a 16-bit number) is not a valid locale, the result is nil. */)
2731 (Lisp_Object lcid, Lisp_Object longform)
2732 {
2733 int got_abbrev;
2734 int got_full;
2735 char abbrev_name[32] = { 0 };
2736 char full_name[256] = { 0 };
2737
2738 CHECK_NUMBER (lcid);
2739
2740 if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
2741 return Qnil;
2742
2743 if (NILP (longform))
2744 {
2745 got_abbrev = GetLocaleInfo (XINT (lcid),
2746 LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
2747 abbrev_name, sizeof (abbrev_name));
2748 if (got_abbrev)
2749 return build_string (abbrev_name);
2750 }
2751 else if (EQ (longform, Qt))
2752 {
2753 got_full = GetLocaleInfo (XINT (lcid),
2754 LOCALE_SLANGUAGE | LOCALE_USE_CP_ACP,
2755 full_name, sizeof (full_name));
2756 if (got_full)
2757 return DECODE_SYSTEM (build_string (full_name));
2758 }
2759 else if (NUMBERP (longform))
2760 {
2761 got_full = GetLocaleInfo (XINT (lcid),
2762 XINT (longform),
2763 full_name, sizeof (full_name));
2764 /* GetLocaleInfo's return value includes the terminating null
2765 character, when the returned information is a string, whereas
2766 make_unibyte_string needs the string length without the
2767 terminating null. */
2768 if (got_full)
2769 return make_unibyte_string (full_name, got_full - 1);
2770 }
2771
2772 return Qnil;
2773 }
2774
2775
2776 DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id,
2777 Sw32_get_current_locale_id, 0, 0, 0,
2778 doc: /* Return Windows locale id for current locale setting.
2779 This is a numerical value; use `w32-get-locale-info' to convert to a
2780 human-readable form. */)
2781 (void)
2782 {
2783 return make_number (GetThreadLocale ());
2784 }
2785
2786 static DWORD
2787 int_from_hex (char * s)
2788 {
2789 DWORD val = 0;
2790 static char hex[] = "0123456789abcdefABCDEF";
2791 char * p;
2792
2793 while (*s && (p = strchr (hex, *s)) != NULL)
2794 {
2795 unsigned digit = p - hex;
2796 if (digit > 15)
2797 digit -= 6;
2798 val = val * 16 + digit;
2799 s++;
2800 }
2801 return val;
2802 }
2803
2804 /* We need to build a global list, since the EnumSystemLocale callback
2805 function isn't given a context pointer. */
2806 Lisp_Object Vw32_valid_locale_ids;
2807
2808 static BOOL CALLBACK
2809 enum_locale_fn (LPTSTR localeNum)
2810 {
2811 DWORD id = int_from_hex (localeNum);
2812 Vw32_valid_locale_ids = Fcons (make_number (id), Vw32_valid_locale_ids);
2813 return TRUE;
2814 }
2815
2816 DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids,
2817 Sw32_get_valid_locale_ids, 0, 0, 0,
2818 doc: /* Return list of all valid Windows locale ids.
2819 Each id is a numerical value; use `w32-get-locale-info' to convert to a
2820 human-readable form. */)
2821 (void)
2822 {
2823 Vw32_valid_locale_ids = Qnil;
2824
2825 EnumSystemLocales (enum_locale_fn, LCID_SUPPORTED);
2826
2827 Vw32_valid_locale_ids = Fnreverse (Vw32_valid_locale_ids);
2828 return Vw32_valid_locale_ids;
2829 }
2830
2831
2832 DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id, Sw32_get_default_locale_id, 0, 1, 0,
2833 doc: /* Return Windows locale id for default locale setting.
2834 By default, the system default locale setting is returned; if the optional
2835 parameter USERP is non-nil, the user default locale setting is returned.
2836 This is a numerical value; use `w32-get-locale-info' to convert to a
2837 human-readable form. */)
2838 (Lisp_Object userp)
2839 {
2840 if (NILP (userp))
2841 return make_number (GetSystemDefaultLCID ());
2842 return make_number (GetUserDefaultLCID ());
2843 }
2844
2845
2846 DEFUN ("w32-set-current-locale", Fw32_set_current_locale, Sw32_set_current_locale, 1, 1, 0,
2847 doc: /* Make Windows locale LCID be the current locale setting for Emacs.
2848 If successful, the new locale id is returned, otherwise nil. */)
2849 (Lisp_Object lcid)
2850 {
2851 CHECK_NUMBER (lcid);
2852
2853 if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
2854 return Qnil;
2855
2856 if (!SetThreadLocale (XINT (lcid)))
2857 return Qnil;
2858
2859 /* Need to set input thread locale if present. */
2860 if (dwWindowsThreadId)
2861 /* Reply is not needed. */
2862 PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0);
2863
2864 return make_number (GetThreadLocale ());
2865 }
2866
2867
2868 /* We need to build a global list, since the EnumCodePages callback
2869 function isn't given a context pointer. */
2870 Lisp_Object Vw32_valid_codepages;
2871
2872 static BOOL CALLBACK
2873 enum_codepage_fn (LPTSTR codepageNum)
2874 {
2875 DWORD id = atoi (codepageNum);
2876 Vw32_valid_codepages = Fcons (make_number (id), Vw32_valid_codepages);
2877 return TRUE;
2878 }
2879
2880 DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages,
2881 Sw32_get_valid_codepages, 0, 0, 0,
2882 doc: /* Return list of all valid Windows codepages. */)
2883 (void)
2884 {
2885 Vw32_valid_codepages = Qnil;
2886
2887 EnumSystemCodePages (enum_codepage_fn, CP_SUPPORTED);
2888
2889 Vw32_valid_codepages = Fnreverse (Vw32_valid_codepages);
2890 return Vw32_valid_codepages;
2891 }
2892
2893
2894 DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage,
2895 Sw32_get_console_codepage, 0, 0, 0,
2896 doc: /* Return current Windows codepage for console input. */)
2897 (void)
2898 {
2899 return make_number (GetConsoleCP ());
2900 }
2901
2902
2903 DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage,
2904 Sw32_set_console_codepage, 1, 1, 0,
2905 doc: /* Make Windows codepage CP be the codepage for Emacs tty keyboard input.
2906 This codepage setting affects keyboard input in tty mode.
2907 If successful, the new CP is returned, otherwise nil. */)
2908 (Lisp_Object cp)
2909 {
2910 CHECK_NUMBER (cp);
2911
2912 if (!IsValidCodePage (XINT (cp)))
2913 return Qnil;
2914
2915 if (!SetConsoleCP (XINT (cp)))
2916 return Qnil;
2917
2918 return make_number (GetConsoleCP ());
2919 }
2920
2921
2922 DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage,
2923 Sw32_get_console_output_codepage, 0, 0, 0,
2924 doc: /* Return current Windows codepage for console output. */)
2925 (void)
2926 {
2927 return make_number (GetConsoleOutputCP ());
2928 }
2929
2930
2931 DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage,
2932 Sw32_set_console_output_codepage, 1, 1, 0,
2933 doc: /* Make Windows codepage CP be the codepage for Emacs console output.
2934 This codepage setting affects display in tty mode.
2935 If successful, the new CP is returned, otherwise nil. */)
2936 (Lisp_Object cp)
2937 {
2938 CHECK_NUMBER (cp);
2939
2940 if (!IsValidCodePage (XINT (cp)))
2941 return Qnil;
2942
2943 if (!SetConsoleOutputCP (XINT (cp)))
2944 return Qnil;
2945
2946 return make_number (GetConsoleOutputCP ());
2947 }
2948
2949
2950 DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset,
2951 Sw32_get_codepage_charset, 1, 1, 0,
2952 doc: /* Return charset ID corresponding to codepage CP.
2953 Returns nil if the codepage is not valid. */)
2954 (Lisp_Object cp)
2955 {
2956 CHARSETINFO info;
2957
2958 CHECK_NUMBER (cp);
2959
2960 if (!IsValidCodePage (XINT (cp)))
2961 return Qnil;
2962
2963 if (TranslateCharsetInfo ((DWORD *) XINT (cp), &info, TCI_SRCCODEPAGE))
2964 return make_number (info.ciCharset);
2965
2966 return Qnil;
2967 }
2968
2969
2970 DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts,
2971 Sw32_get_valid_keyboard_layouts, 0, 0, 0,
2972 doc: /* Return list of Windows keyboard languages and layouts.
2973 The return value is a list of pairs of language id and layout id. */)
2974 (void)
2975 {
2976 int num_layouts = GetKeyboardLayoutList (0, NULL);
2977 HKL * layouts = (HKL *) alloca (num_layouts * sizeof (HKL));
2978 Lisp_Object obj = Qnil;
2979
2980 if (GetKeyboardLayoutList (num_layouts, layouts) == num_layouts)
2981 {
2982 while (--num_layouts >= 0)
2983 {
2984 DWORD kl = (DWORD) layouts[num_layouts];
2985
2986 obj = Fcons (Fcons (make_number (kl & 0xffff),
2987 make_number ((kl >> 16) & 0xffff)),
2988 obj);
2989 }
2990 }
2991
2992 return obj;
2993 }
2994
2995
2996 DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout,
2997 Sw32_get_keyboard_layout, 0, 0, 0,
2998 doc: /* Return current Windows keyboard language and layout.
2999 The return value is the cons of the language id and the layout id. */)
3000 (void)
3001 {
3002 DWORD kl = (DWORD) GetKeyboardLayout (dwWindowsThreadId);
3003
3004 return Fcons (make_number (kl & 0xffff),
3005 make_number ((kl >> 16) & 0xffff));
3006 }
3007
3008
3009 DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout,
3010 Sw32_set_keyboard_layout, 1, 1, 0,
3011 doc: /* Make LAYOUT be the current keyboard layout for Emacs.
3012 The keyboard layout setting affects interpretation of keyboard input.
3013 If successful, the new layout id is returned, otherwise nil. */)
3014 (Lisp_Object layout)
3015 {
3016 DWORD kl;
3017
3018 CHECK_CONS (layout);
3019 CHECK_NUMBER_CAR (layout);
3020 CHECK_NUMBER_CDR (layout);
3021
3022 kl = (XINT (XCAR (layout)) & 0xffff)
3023 | (XINT (XCDR (layout)) << 16);
3024
3025 /* Synchronize layout with input thread. */
3026 if (dwWindowsThreadId)
3027 {
3028 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETKEYBOARDLAYOUT,
3029 (WPARAM) kl, 0))
3030 {
3031 MSG msg;
3032 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
3033
3034 if (msg.wParam == 0)
3035 return Qnil;
3036 }
3037 }
3038 else if (!ActivateKeyboardLayout ((HKL) kl, 0))
3039 return Qnil;
3040
3041 return Fw32_get_keyboard_layout ();
3042 }
3043
3044 \f
3045 void
3046 syms_of_ntproc (void)
3047 {
3048 DEFSYM (Qhigh, "high");
3049 DEFSYM (Qlow, "low");
3050
3051 defsubr (&Sw32_has_winsock);
3052 defsubr (&Sw32_unload_winsock);
3053
3054 defsubr (&Sw32_short_file_name);
3055 defsubr (&Sw32_long_file_name);
3056 defsubr (&Sw32_set_process_priority);
3057 defsubr (&Sw32_get_locale_info);
3058 defsubr (&Sw32_get_current_locale_id);
3059 defsubr (&Sw32_get_default_locale_id);
3060 defsubr (&Sw32_get_valid_locale_ids);
3061 defsubr (&Sw32_set_current_locale);
3062
3063 defsubr (&Sw32_get_console_codepage);
3064 defsubr (&Sw32_set_console_codepage);
3065 defsubr (&Sw32_get_console_output_codepage);
3066 defsubr (&Sw32_set_console_output_codepage);
3067 defsubr (&Sw32_get_valid_codepages);
3068 defsubr (&Sw32_get_codepage_charset);
3069
3070 defsubr (&Sw32_get_valid_keyboard_layouts);
3071 defsubr (&Sw32_get_keyboard_layout);
3072 defsubr (&Sw32_set_keyboard_layout);
3073
3074 DEFVAR_LISP ("w32-quote-process-args", Vw32_quote_process_args,
3075 doc: /* Non-nil enables quoting of process arguments to ensure correct parsing.
3076 Because Windows does not directly pass argv arrays to child processes,
3077 programs have to reconstruct the argv array by parsing the command
3078 line string. For an argument to contain a space, it must be enclosed
3079 in double quotes or it will be parsed as multiple arguments.
3080
3081 If the value is a character, that character will be used to escape any
3082 quote characters that appear, otherwise a suitable escape character
3083 will be chosen based on the type of the program. */);
3084 Vw32_quote_process_args = Qt;
3085
3086 DEFVAR_LISP ("w32-start-process-show-window",
3087 Vw32_start_process_show_window,
3088 doc: /* When nil, new child processes hide their windows.
3089 When non-nil, they show their window in the method of their choice.
3090 This variable doesn't affect GUI applications, which will never be hidden. */);
3091 Vw32_start_process_show_window = Qnil;
3092
3093 DEFVAR_LISP ("w32-start-process-share-console",
3094 Vw32_start_process_share_console,
3095 doc: /* When nil, new child processes are given a new console.
3096 When non-nil, they share the Emacs console; this has the limitation of
3097 allowing only one DOS subprocess to run at a time (whether started directly
3098 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
3099 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
3100 otherwise respond to interrupts from Emacs. */);
3101 Vw32_start_process_share_console = Qnil;
3102
3103 DEFVAR_LISP ("w32-start-process-inherit-error-mode",
3104 Vw32_start_process_inherit_error_mode,
3105 doc: /* When nil, new child processes revert to the default error mode.
3106 When non-nil, they inherit their error mode setting from Emacs, which stops
3107 them blocking when trying to access unmounted drives etc. */);
3108 Vw32_start_process_inherit_error_mode = Qt;
3109
3110 DEFVAR_INT ("w32-pipe-read-delay", w32_pipe_read_delay,
3111 doc: /* Forced delay before reading subprocess output.
3112 This is done to improve the buffering of subprocess output, by
3113 avoiding the inefficiency of frequently reading small amounts of data.
3114
3115 If positive, the value is the number of milliseconds to sleep before
3116 reading the subprocess output. If negative, the magnitude is the number
3117 of time slices to wait (effectively boosting the priority of the child
3118 process temporarily). A value of zero disables waiting entirely. */);
3119 w32_pipe_read_delay = 50;
3120
3121 DEFVAR_LISP ("w32-downcase-file-names", Vw32_downcase_file_names,
3122 doc: /* Non-nil means convert all-upper case file names to lower case.
3123 This applies when performing completions and file name expansion.
3124 Note that the value of this setting also affects remote file names,
3125 so you probably don't want to set to non-nil if you use case-sensitive
3126 filesystems via ange-ftp. */);
3127 Vw32_downcase_file_names = Qnil;
3128
3129 #if 0
3130 DEFVAR_LISP ("w32-generate-fake-inodes", Vw32_generate_fake_inodes,
3131 doc: /* Non-nil means attempt to fake realistic inode values.
3132 This works by hashing the truename of files, and should detect
3133 aliasing between long and short (8.3 DOS) names, but can have
3134 false positives because of hash collisions. Note that determining
3135 the truename of a file can be slow. */);
3136 Vw32_generate_fake_inodes = Qnil;
3137 #endif
3138
3139 DEFVAR_LISP ("w32-get-true-file-attributes", Vw32_get_true_file_attributes,
3140 doc: /* Non-nil means determine accurate file attributes in `file-attributes'.
3141 This option controls whether to issue additional system calls to determine
3142 accurate link counts, file type, and ownership information. It is more
3143 useful for files on NTFS volumes, where hard links and file security are
3144 supported, than on volumes of the FAT family.
3145
3146 Without these system calls, link count will always be reported as 1 and file
3147 ownership will be attributed to the current user.
3148 The default value `local' means only issue these system calls for files
3149 on local fixed drives. A value of nil means never issue them.
3150 Any other non-nil value means do this even on remote and removable drives
3151 where the performance impact may be noticeable even on modern hardware. */);
3152 Vw32_get_true_file_attributes = Qlocal;
3153
3154 staticpro (&Vw32_valid_locale_ids);
3155 staticpro (&Vw32_valid_codepages);
3156 }
3157 /* end of w32proc.c */