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