]> code.delx.au - gnu-emacs/blob - src/w32proc.c
a4e14965c8715a7110f79ef737bd2f8351fff463
[gnu-emacs] / src / w32proc.c
1 /* Process support for GNU Emacs on the Microsoft Windows API.
2
3 Copyright (C) 1992, 1995, 1999-2015 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
10 (at 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
2068 wfds and efds are not supported and must be NULL.
2069
2070 For simplicity, we detect the death of child processes here and
2071 synchronously call the SIGCHLD handler. Since it is possible for
2072 children to be created without a corresponding pipe handle from which
2073 to read output, we wait separately on the process handles as well as
2074 the char_avail events for each process pipe. We only call
2075 wait/reap_process when the process actually terminates.
2076
2077 To reduce the number of places in which Emacs can be hung such that
2078 C-g is not able to interrupt it, we always wait on interrupt_handle
2079 (which is signaled by the input thread when C-g is detected). If we
2080 detect that we were woken up by C-g, we return -1 with errno set to
2081 EINTR as on Unix. */
2082
2083 /* From w32console.c */
2084 extern HANDLE keyboard_handle;
2085
2086 /* From w32xfns.c */
2087 extern HANDLE interrupt_handle;
2088
2089 /* From process.c */
2090 extern int proc_buffered_char[];
2091
2092 int
2093 sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
2094 struct timespec *timeout, void *ignored)
2095 {
2096 SELECT_TYPE orfds, owfds;
2097 DWORD timeout_ms, start_time;
2098 int i, nh, nc, nr;
2099 DWORD active;
2100 child_process *cp, *cps[MAX_CHILDREN];
2101 HANDLE wait_hnd[MAXDESC + MAX_CHILDREN];
2102 int fdindex[MAXDESC]; /* mapping from wait handles back to descriptors */
2103
2104 timeout_ms =
2105 timeout ? (timeout->tv_sec * 1000 + timeout->tv_nsec / 1000000) : INFINITE;
2106
2107 /* If the descriptor sets are NULL but timeout isn't, then just Sleep. */
2108 if (rfds == NULL && wfds == NULL && efds == NULL && timeout != NULL)
2109 {
2110 Sleep (timeout_ms);
2111 return 0;
2112 }
2113
2114 /* Otherwise, we only handle rfds and wfds, so fail otherwise. */
2115 if ((rfds == NULL && wfds == NULL) || efds != NULL)
2116 {
2117 errno = EINVAL;
2118 return -1;
2119 }
2120
2121 if (rfds)
2122 {
2123 orfds = *rfds;
2124 FD_ZERO (rfds);
2125 }
2126 else
2127 FD_ZERO (&orfds);
2128 if (wfds)
2129 {
2130 owfds = *wfds;
2131 FD_ZERO (wfds);
2132 }
2133 else
2134 FD_ZERO (&owfds);
2135 nr = 0;
2136
2137 /* If interrupt_handle is available and valid, always wait on it, to
2138 detect C-g (quit). */
2139 nh = 0;
2140 if (interrupt_handle && interrupt_handle != INVALID_HANDLE_VALUE)
2141 {
2142 wait_hnd[0] = interrupt_handle;
2143 fdindex[0] = -1;
2144 nh++;
2145 }
2146
2147 /* Build a list of pipe handles to wait on. */
2148 for (i = 0; i < nfds; i++)
2149 if (FD_ISSET (i, &orfds) || FD_ISSET (i, &owfds))
2150 {
2151 if (i == 0)
2152 {
2153 if (keyboard_handle)
2154 {
2155 /* Handle stdin specially */
2156 wait_hnd[nh] = keyboard_handle;
2157 fdindex[nh] = i;
2158 nh++;
2159 }
2160
2161 /* Check for any emacs-generated input in the queue since
2162 it won't be detected in the wait */
2163 if (rfds && detect_input_pending ())
2164 {
2165 FD_SET (i, rfds);
2166 return 1;
2167 }
2168 else if (noninteractive)
2169 {
2170 if (handle_file_notifications (NULL))
2171 return 1;
2172 }
2173 }
2174 else
2175 {
2176 /* Child process and socket/comm port input. */
2177 cp = fd_info[i].cp;
2178 if (FD_ISSET (i, &owfds)
2179 && cp
2180 && (fd_info[i].flags & FILE_CONNECT) == 0)
2181 {
2182 DebPrint (("sys_select: fd %d is in wfds, but FILE_CONNECT is reset!\n", i));
2183 cp = NULL;
2184 }
2185 if (cp)
2186 {
2187 int current_status = cp->status;
2188
2189 if (current_status == STATUS_READ_ACKNOWLEDGED)
2190 {
2191 /* Tell reader thread which file handle to use. */
2192 cp->fd = i;
2193 /* Zero out the error code. */
2194 cp->errcode = 0;
2195 /* Wake up the reader thread for this process */
2196 cp->status = STATUS_READ_READY;
2197 if (!SetEvent (cp->char_consumed))
2198 DebPrint (("sys_select.SetEvent failed with "
2199 "%lu for fd %ld\n", GetLastError (), i));
2200 }
2201
2202 #ifdef CHECK_INTERLOCK
2203 /* slightly crude cross-checking of interlock between threads */
2204
2205 current_status = cp->status;
2206 if (WaitForSingleObject (cp->char_avail, 0) == WAIT_OBJECT_0)
2207 {
2208 /* char_avail has been signaled, so status (which may
2209 have changed) should indicate read has completed
2210 but has not been acknowledged. */
2211 current_status = cp->status;
2212 if (current_status != STATUS_READ_SUCCEEDED
2213 && current_status != STATUS_READ_FAILED)
2214 DebPrint (("char_avail set, but read not completed: status %d\n",
2215 current_status));
2216 }
2217 else
2218 {
2219 /* char_avail has not been signaled, so status should
2220 indicate that read is in progress; small possibility
2221 that read has completed but event wasn't yet signaled
2222 when we tested it (because a context switch occurred
2223 or if running on separate CPUs). */
2224 if (current_status != STATUS_READ_READY
2225 && current_status != STATUS_READ_IN_PROGRESS
2226 && current_status != STATUS_READ_SUCCEEDED
2227 && current_status != STATUS_READ_FAILED)
2228 DebPrint (("char_avail reset, but read status is bad: %d\n",
2229 current_status));
2230 }
2231 #endif
2232 wait_hnd[nh] = cp->char_avail;
2233 fdindex[nh] = i;
2234 if (!wait_hnd[nh]) emacs_abort ();
2235 nh++;
2236 #ifdef FULL_DEBUG
2237 DebPrint (("select waiting on child %d fd %d\n",
2238 cp-child_procs, i));
2239 #endif
2240 }
2241 else
2242 {
2243 /* Unable to find something to wait on for this fd, skip */
2244
2245 /* Note that this is not a fatal error, and can in fact
2246 happen in unusual circumstances. Specifically, if
2247 sys_spawnve fails, eg. because the program doesn't
2248 exist, and debug-on-error is t so Fsignal invokes a
2249 nested input loop, then the process output pipe is
2250 still included in input_wait_mask with no child_proc
2251 associated with it. (It is removed when the debugger
2252 exits the nested input loop and the error is thrown.) */
2253
2254 DebPrint (("sys_select: fd %ld is invalid! ignoring\n", i));
2255 }
2256 }
2257 }
2258
2259 count_children:
2260 /* Add handles of child processes. */
2261 nc = 0;
2262 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
2263 /* Some child_procs might be sockets; ignore them. Also some
2264 children may have died already, but we haven't finished reading
2265 the process output; ignore them too. */
2266 if ((CHILD_ACTIVE (cp) && cp->procinfo.hProcess)
2267 && (cp->fd < 0
2268 || (fd_info[cp->fd].flags & FILE_SEND_SIGCHLD) == 0
2269 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0)
2270 )
2271 {
2272 wait_hnd[nh + nc] = cp->procinfo.hProcess;
2273 cps[nc] = cp;
2274 nc++;
2275 }
2276
2277 /* Nothing to look for, so we didn't find anything */
2278 if (nh + nc == 0)
2279 {
2280 if (timeout)
2281 Sleep (timeout_ms);
2282 if (noninteractive)
2283 {
2284 if (handle_file_notifications (NULL))
2285 return 1;
2286 }
2287 return 0;
2288 }
2289
2290 start_time = GetTickCount ();
2291
2292 /* Wait for input or child death to be signaled. If user input is
2293 allowed, then also accept window messages. */
2294 if (FD_ISSET (0, &orfds))
2295 active = MsgWaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms,
2296 QS_ALLINPUT);
2297 else
2298 active = WaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms);
2299
2300 if (active == WAIT_FAILED)
2301 {
2302 DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n",
2303 nh + nc, timeout_ms, GetLastError ()));
2304 /* don't return EBADF - this causes wait_reading_process_output to
2305 abort; WAIT_FAILED is returned when single-stepping under
2306 Windows 95 after switching thread focus in debugger, and
2307 possibly at other times. */
2308 errno = EINTR;
2309 return -1;
2310 }
2311 else if (active == WAIT_TIMEOUT)
2312 {
2313 if (noninteractive)
2314 {
2315 if (handle_file_notifications (NULL))
2316 return 1;
2317 }
2318 return 0;
2319 }
2320 else if (active >= WAIT_OBJECT_0
2321 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
2322 {
2323 active -= WAIT_OBJECT_0;
2324 }
2325 else if (active >= WAIT_ABANDONED_0
2326 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
2327 {
2328 active -= WAIT_ABANDONED_0;
2329 }
2330 else
2331 emacs_abort ();
2332
2333 /* Loop over all handles after active (now officially documented as
2334 being the first signaled handle in the array). We do this to
2335 ensure fairness, so that all channels with data available will be
2336 processed - otherwise higher numbered channels could be starved. */
2337 do
2338 {
2339 if (active == nh + nc)
2340 {
2341 /* There are messages in the lisp thread's queue; we must
2342 drain the queue now to ensure they are processed promptly,
2343 because if we don't do so, we will not be woken again until
2344 further messages arrive.
2345
2346 NB. If ever we allow window message procedures to callback
2347 into lisp, we will need to ensure messages are dispatched
2348 at a safe time for lisp code to be run (*), and we may also
2349 want to provide some hooks in the dispatch loop to cater
2350 for modeless dialogs created by lisp (ie. to register
2351 window handles to pass to IsDialogMessage).
2352
2353 (*) Note that MsgWaitForMultipleObjects above is an
2354 internal dispatch point for messages that are sent to
2355 windows created by this thread. */
2356 if (drain_message_queue ()
2357 /* If drain_message_queue returns non-zero, that means
2358 we received a WM_EMACS_FILENOTIFY message. If this
2359 is a TTY frame, we must signal the caller that keyboard
2360 input is available, so that w32_console_read_socket
2361 will be called to pick up the notifications. If we
2362 don't do that, file notifications will only work when
2363 the Emacs TTY frame has focus. */
2364 && FRAME_TERMCAP_P (SELECTED_FRAME ())
2365 /* they asked for stdin reads */
2366 && FD_ISSET (0, &orfds)
2367 /* the stdin handle is valid */
2368 && keyboard_handle)
2369 {
2370 FD_SET (0, rfds);
2371 if (nr == 0)
2372 nr = 1;
2373 }
2374 }
2375 else if (active >= nh)
2376 {
2377 cp = cps[active - nh];
2378
2379 /* We cannot always signal SIGCHLD immediately; if we have not
2380 finished reading the process output, we must delay sending
2381 SIGCHLD until we do. */
2382
2383 if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_AT_EOF) == 0)
2384 fd_info[cp->fd].flags |= FILE_SEND_SIGCHLD;
2385 /* SIG_DFL for SIGCHLD is ignored */
2386 else if (sig_handlers[SIGCHLD] != SIG_DFL &&
2387 sig_handlers[SIGCHLD] != SIG_IGN)
2388 {
2389 #ifdef FULL_DEBUG
2390 DebPrint (("select calling SIGCHLD handler for pid %d\n",
2391 cp->pid));
2392 #endif
2393 sig_handlers[SIGCHLD] (SIGCHLD);
2394 }
2395 }
2396 else if (fdindex[active] == -1)
2397 {
2398 /* Quit (C-g) was detected. */
2399 errno = EINTR;
2400 return -1;
2401 }
2402 else if (rfds && fdindex[active] == 0)
2403 {
2404 /* Keyboard input available */
2405 FD_SET (0, rfds);
2406 nr++;
2407 }
2408 else
2409 {
2410 /* Must be a socket or pipe - read ahead should have
2411 completed, either succeeding or failing. If this handle
2412 was waiting for an async 'connect', reset the connect
2413 flag, so it could read from now on. */
2414 if (wfds && (fd_info[fdindex[active]].flags & FILE_CONNECT) != 0)
2415 {
2416 cp = fd_info[fdindex[active]].cp;
2417 if (cp)
2418 {
2419 /* Don't reset the FILE_CONNECT bit and don't
2420 acknowledge the read if the status is
2421 STATUS_CONNECT_FAILED or some other
2422 failure. That's because the thread exits in those
2423 cases, so it doesn't need the ACK, and we want to
2424 keep the FILE_CONNECT bit as evidence that the
2425 connect failed, to be checked in sys_read. */
2426 if (cp->status == STATUS_READ_SUCCEEDED)
2427 {
2428 fd_info[cp->fd].flags &= ~FILE_CONNECT;
2429 cp->status = STATUS_READ_ACKNOWLEDGED;
2430 }
2431 ResetEvent (cp->char_avail);
2432 }
2433 FD_SET (fdindex[active], wfds);
2434 }
2435 else if (rfds)
2436 FD_SET (fdindex[active], rfds);
2437 nr++;
2438 }
2439
2440 /* Even though wait_reading_process_output only reads from at most
2441 one channel, we must process all channels here so that we reap
2442 all children that have died. */
2443 while (++active < nh + nc)
2444 if (WaitForSingleObject (wait_hnd[active], 0) == WAIT_OBJECT_0)
2445 break;
2446 } while (active < nh + nc);
2447
2448 if (noninteractive)
2449 {
2450 if (handle_file_notifications (NULL))
2451 nr++;
2452 }
2453
2454 /* If no input has arrived and timeout hasn't expired, wait again. */
2455 if (nr == 0)
2456 {
2457 DWORD elapsed = GetTickCount () - start_time;
2458
2459 if (timeout_ms > elapsed) /* INFINITE is MAX_UINT */
2460 {
2461 if (timeout_ms != INFINITE)
2462 timeout_ms -= elapsed;
2463 goto count_children;
2464 }
2465 }
2466
2467 return nr;
2468 }
2469
2470 /* Substitute for certain kill () operations */
2471
2472 static BOOL CALLBACK
2473 find_child_console (HWND hwnd, LPARAM arg)
2474 {
2475 child_process * cp = (child_process *) arg;
2476 DWORD process_id;
2477
2478 GetWindowThreadProcessId (hwnd, &process_id);
2479 if (process_id == cp->procinfo.dwProcessId)
2480 {
2481 char window_class[32];
2482
2483 GetClassName (hwnd, window_class, sizeof (window_class));
2484 if (strcmp (window_class,
2485 (os_subtype == OS_9X)
2486 ? "tty"
2487 : "ConsoleWindowClass") == 0)
2488 {
2489 cp->hwnd = hwnd;
2490 return FALSE;
2491 }
2492 }
2493 /* keep looking */
2494 return TRUE;
2495 }
2496
2497 /* Emulate 'kill', but only for other processes. */
2498 int
2499 sys_kill (pid_t pid, int sig)
2500 {
2501 child_process *cp;
2502 HANDLE proc_hand;
2503 int need_to_free = 0;
2504 int rc = 0;
2505
2506 /* Each process is in its own process group. */
2507 if (pid < 0)
2508 pid = -pid;
2509
2510 /* Only handle signals that will result in the process dying */
2511 if (sig != 0
2512 && sig != SIGINT && sig != SIGKILL && sig != SIGQUIT && sig != SIGHUP)
2513 {
2514 errno = EINVAL;
2515 return -1;
2516 }
2517
2518 if (sig == 0)
2519 {
2520 /* It will take _some_ time before PID 4 or less on Windows will
2521 be Emacs... */
2522 if (pid <= 4)
2523 {
2524 errno = EPERM;
2525 return -1;
2526 }
2527 proc_hand = OpenProcess (PROCESS_QUERY_INFORMATION, 0, pid);
2528 if (proc_hand == NULL)
2529 {
2530 DWORD err = GetLastError ();
2531
2532 switch (err)
2533 {
2534 case ERROR_ACCESS_DENIED: /* existing process, but access denied */
2535 errno = EPERM;
2536 return -1;
2537 case ERROR_INVALID_PARAMETER: /* process PID does not exist */
2538 errno = ESRCH;
2539 return -1;
2540 }
2541 }
2542 else
2543 CloseHandle (proc_hand);
2544 return 0;
2545 }
2546
2547 cp = find_child_pid (pid);
2548 if (cp == NULL)
2549 {
2550 /* We were passed a PID of something other than our subprocess.
2551 If that is our own PID, we will send to ourself a message to
2552 close the selected frame, which does not necessarily
2553 terminates Emacs. But then we are not supposed to call
2554 sys_kill with our own PID. */
2555 proc_hand = OpenProcess (PROCESS_TERMINATE, 0, pid);
2556 if (proc_hand == NULL)
2557 {
2558 errno = EPERM;
2559 return -1;
2560 }
2561 need_to_free = 1;
2562 }
2563 else
2564 {
2565 proc_hand = cp->procinfo.hProcess;
2566 pid = cp->procinfo.dwProcessId;
2567
2568 /* Try to locate console window for process. */
2569 EnumWindows (find_child_console, (LPARAM) cp);
2570 }
2571
2572 if (sig == SIGINT || sig == SIGQUIT)
2573 {
2574 if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
2575 {
2576 BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0);
2577 /* Fake Ctrl-C for SIGINT, and Ctrl-Break for SIGQUIT. */
2578 BYTE vk_break_code = (sig == SIGINT) ? 'C' : VK_CANCEL;
2579 BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
2580 HWND foreground_window;
2581
2582 if (break_scan_code == 0)
2583 {
2584 /* Fake Ctrl-C for SIGQUIT if we can't manage Ctrl-Break. */
2585 vk_break_code = 'C';
2586 break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
2587 }
2588
2589 foreground_window = GetForegroundWindow ();
2590 if (foreground_window)
2591 {
2592 /* NT 5.0, and apparently also Windows 98, will not allow
2593 a Window to be set to foreground directly without the
2594 user's involvement. The workaround is to attach
2595 ourselves to the thread that owns the foreground
2596 window, since that is the only thread that can set the
2597 foreground window. */
2598 DWORD foreground_thread, child_thread;
2599 foreground_thread =
2600 GetWindowThreadProcessId (foreground_window, NULL);
2601 if (foreground_thread == GetCurrentThreadId ()
2602 || !AttachThreadInput (GetCurrentThreadId (),
2603 foreground_thread, TRUE))
2604 foreground_thread = 0;
2605
2606 child_thread = GetWindowThreadProcessId (cp->hwnd, NULL);
2607 if (child_thread == GetCurrentThreadId ()
2608 || !AttachThreadInput (GetCurrentThreadId (),
2609 child_thread, TRUE))
2610 child_thread = 0;
2611
2612 /* Set the foreground window to the child. */
2613 if (SetForegroundWindow (cp->hwnd))
2614 {
2615 /* Generate keystrokes as if user had typed Ctrl-Break or
2616 Ctrl-C. */
2617 keybd_event (VK_CONTROL, control_scan_code, 0, 0);
2618 keybd_event (vk_break_code, break_scan_code,
2619 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0);
2620 keybd_event (vk_break_code, break_scan_code,
2621 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY)
2622 | KEYEVENTF_KEYUP, 0);
2623 keybd_event (VK_CONTROL, control_scan_code,
2624 KEYEVENTF_KEYUP, 0);
2625
2626 /* Sleep for a bit to give time for Emacs frame to respond
2627 to focus change events (if Emacs was active app). */
2628 Sleep (100);
2629
2630 SetForegroundWindow (foreground_window);
2631 }
2632 /* Detach from the foreground and child threads now that
2633 the foreground switching is over. */
2634 if (foreground_thread)
2635 AttachThreadInput (GetCurrentThreadId (),
2636 foreground_thread, FALSE);
2637 if (child_thread)
2638 AttachThreadInput (GetCurrentThreadId (),
2639 child_thread, FALSE);
2640 }
2641 }
2642 /* Ctrl-Break is NT equivalent of SIGINT. */
2643 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid))
2644 {
2645 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
2646 "for pid %lu\n", GetLastError (), pid));
2647 errno = EINVAL;
2648 rc = -1;
2649 }
2650 }
2651 else
2652 {
2653 if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
2654 {
2655 #if 1
2656 if (os_subtype == OS_9X)
2657 {
2658 /*
2659 Another possibility is to try terminating the VDM out-right by
2660 calling the Shell VxD (id 0x17) V86 interface, function #4
2661 "SHELL_Destroy_VM", ie.
2662
2663 mov edx,4
2664 mov ebx,vm_handle
2665 call shellapi
2666
2667 First need to determine the current VM handle, and then arrange for
2668 the shellapi call to be made from the system vm (by using
2669 Switch_VM_and_callback).
2670
2671 Could try to invoke DestroyVM through CallVxD.
2672
2673 */
2674 #if 0
2675 /* On Windows 95, posting WM_QUIT causes the 16-bit subsystem
2676 to hang when cmdproxy is used in conjunction with
2677 command.com for an interactive shell. Posting
2678 WM_CLOSE pops up a dialog that, when Yes is selected,
2679 does the same thing. TerminateProcess is also less
2680 than ideal in that subprocesses tend to stick around
2681 until the machine is shutdown, but at least it
2682 doesn't freeze the 16-bit subsystem. */
2683 PostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
2684 #endif
2685 if (!TerminateProcess (proc_hand, 0xff))
2686 {
2687 DebPrint (("sys_kill.TerminateProcess returned %d "
2688 "for pid %lu\n", GetLastError (), pid));
2689 errno = EINVAL;
2690 rc = -1;
2691 }
2692 }
2693 else
2694 #endif
2695 PostMessage (cp->hwnd, WM_CLOSE, 0, 0);
2696 }
2697 /* Kill the process. On W32 this doesn't kill child processes
2698 so it doesn't work very well for shells which is why it's not
2699 used in every case. */
2700 else if (!TerminateProcess (proc_hand, 0xff))
2701 {
2702 DebPrint (("sys_kill.TerminateProcess returned %d "
2703 "for pid %lu\n", GetLastError (), pid));
2704 errno = EINVAL;
2705 rc = -1;
2706 }
2707 }
2708
2709 if (need_to_free)
2710 CloseHandle (proc_hand);
2711
2712 return rc;
2713 }
2714
2715 /* The following two routines are used to manipulate stdin, stdout, and
2716 stderr of our child processes.
2717
2718 Assuming that in, out, and err are *not* inheritable, we make them
2719 stdin, stdout, and stderr of the child as follows:
2720
2721 - Save the parent's current standard handles.
2722 - Set the std handles to inheritable duplicates of the ones being passed in.
2723 (Note that _get_osfhandle() is an io.h procedure that retrieves the
2724 NT file handle for a crt file descriptor.)
2725 - Spawn the child, which inherits in, out, and err as stdin,
2726 stdout, and stderr. (see Spawnve)
2727 - Close the std handles passed to the child.
2728 - Reset the parent's standard handles to the saved handles.
2729 (see reset_standard_handles)
2730 We assume that the caller closes in, out, and err after calling us. */
2731
2732 void
2733 prepare_standard_handles (int in, int out, int err, HANDLE handles[3])
2734 {
2735 HANDLE parent;
2736 HANDLE newstdin, newstdout, newstderr;
2737
2738 parent = GetCurrentProcess ();
2739
2740 handles[0] = GetStdHandle (STD_INPUT_HANDLE);
2741 handles[1] = GetStdHandle (STD_OUTPUT_HANDLE);
2742 handles[2] = GetStdHandle (STD_ERROR_HANDLE);
2743
2744 /* make inheritable copies of the new handles */
2745 if (!DuplicateHandle (parent,
2746 (HANDLE) _get_osfhandle (in),
2747 parent,
2748 &newstdin,
2749 0,
2750 TRUE,
2751 DUPLICATE_SAME_ACCESS))
2752 report_file_error ("Duplicating input handle for child", Qnil);
2753
2754 if (!DuplicateHandle (parent,
2755 (HANDLE) _get_osfhandle (out),
2756 parent,
2757 &newstdout,
2758 0,
2759 TRUE,
2760 DUPLICATE_SAME_ACCESS))
2761 report_file_error ("Duplicating output handle for child", Qnil);
2762
2763 if (!DuplicateHandle (parent,
2764 (HANDLE) _get_osfhandle (err),
2765 parent,
2766 &newstderr,
2767 0,
2768 TRUE,
2769 DUPLICATE_SAME_ACCESS))
2770 report_file_error ("Duplicating error handle for child", Qnil);
2771
2772 /* and store them as our std handles */
2773 if (!SetStdHandle (STD_INPUT_HANDLE, newstdin))
2774 report_file_error ("Changing stdin handle", Qnil);
2775
2776 if (!SetStdHandle (STD_OUTPUT_HANDLE, newstdout))
2777 report_file_error ("Changing stdout handle", Qnil);
2778
2779 if (!SetStdHandle (STD_ERROR_HANDLE, newstderr))
2780 report_file_error ("Changing stderr handle", Qnil);
2781 }
2782
2783 void
2784 reset_standard_handles (int in, int out, int err, HANDLE handles[3])
2785 {
2786 /* close the duplicated handles passed to the child */
2787 CloseHandle (GetStdHandle (STD_INPUT_HANDLE));
2788 CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE));
2789 CloseHandle (GetStdHandle (STD_ERROR_HANDLE));
2790
2791 /* now restore parent's saved std handles */
2792 SetStdHandle (STD_INPUT_HANDLE, handles[0]);
2793 SetStdHandle (STD_OUTPUT_HANDLE, handles[1]);
2794 SetStdHandle (STD_ERROR_HANDLE, handles[2]);
2795 }
2796
2797 void
2798 set_process_dir (char * dir)
2799 {
2800 process_dir = dir;
2801 }
2802
2803 /* To avoid problems with winsock implementations that work over dial-up
2804 connections causing or requiring a connection to exist while Emacs is
2805 running, Emacs no longer automatically loads winsock on startup if it
2806 is present. Instead, it will be loaded when open-network-stream is
2807 first called.
2808
2809 To allow full control over when winsock is loaded, we provide these
2810 two functions to dynamically load and unload winsock. This allows
2811 dial-up users to only be connected when they actually need to use
2812 socket services. */
2813
2814 /* From w32.c */
2815 extern HANDLE winsock_lib;
2816 extern BOOL term_winsock (void);
2817 extern BOOL init_winsock (int load_now);
2818
2819 DEFUN ("w32-has-winsock", Fw32_has_winsock, Sw32_has_winsock, 0, 1, 0,
2820 doc: /* Test for presence of the Windows socket library `winsock'.
2821 Returns non-nil if winsock support is present, nil otherwise.
2822
2823 If the optional argument LOAD-NOW is non-nil, the winsock library is
2824 also loaded immediately if not already loaded. If winsock is loaded,
2825 the winsock local hostname is returned (since this may be different from
2826 the value of `system-name' and should supplant it), otherwise t is
2827 returned to indicate winsock support is present. */)
2828 (Lisp_Object load_now)
2829 {
2830 int have_winsock;
2831
2832 have_winsock = init_winsock (!NILP (load_now));
2833 if (have_winsock)
2834 {
2835 if (winsock_lib != NULL)
2836 {
2837 /* Return new value for system-name. The best way to do this
2838 is to call init_system_name, saving and restoring the
2839 original value to avoid side-effects. */
2840 Lisp_Object orig_hostname = Vsystem_name;
2841 Lisp_Object hostname;
2842
2843 init_system_name ();
2844 hostname = Vsystem_name;
2845 Vsystem_name = orig_hostname;
2846 return hostname;
2847 }
2848 return Qt;
2849 }
2850 return Qnil;
2851 }
2852
2853 DEFUN ("w32-unload-winsock", Fw32_unload_winsock, Sw32_unload_winsock,
2854 0, 0, 0,
2855 doc: /* Unload the Windows socket library `winsock' if loaded.
2856 This is provided to allow dial-up socket connections to be disconnected
2857 when no longer needed. Returns nil without unloading winsock if any
2858 socket connections still exist. */)
2859 (void)
2860 {
2861 return term_winsock () ? Qt : Qnil;
2862 }
2863
2864 \f
2865 /* Some miscellaneous functions that are Windows specific, but not GUI
2866 specific (ie. are applicable in terminal or batch mode as well). */
2867
2868 DEFUN ("w32-short-file-name", Fw32_short_file_name, Sw32_short_file_name, 1, 1, 0,
2869 doc: /* Return the short file name version (8.3) of the full path of FILENAME.
2870 If FILENAME does not exist, return nil.
2871 All path elements in FILENAME are converted to their short names. */)
2872 (Lisp_Object filename)
2873 {
2874 char shortname[MAX_PATH];
2875
2876 CHECK_STRING (filename);
2877
2878 /* first expand it. */
2879 filename = Fexpand_file_name (filename, Qnil);
2880
2881 /* luckily, this returns the short version of each element in the path. */
2882 if (w32_get_short_filename (SSDATA (ENCODE_FILE (filename)),
2883 shortname, MAX_PATH) == 0)
2884 return Qnil;
2885
2886 dostounix_filename (shortname);
2887
2888 /* No need to DECODE_FILE, because 8.3 names are pure ASCII. */
2889 return build_string (shortname);
2890 }
2891
2892
2893 DEFUN ("w32-long-file-name", Fw32_long_file_name, Sw32_long_file_name,
2894 1, 1, 0,
2895 doc: /* Return the long file name version of the full path of FILENAME.
2896 If FILENAME does not exist, return nil.
2897 All path elements in FILENAME are converted to their long names. */)
2898 (Lisp_Object filename)
2899 {
2900 char longname[ MAX_UTF8_PATH ];
2901 int drive_only = 0;
2902
2903 CHECK_STRING (filename);
2904
2905 if (SBYTES (filename) == 2
2906 && *(SDATA (filename) + 1) == ':')
2907 drive_only = 1;
2908
2909 /* first expand it. */
2910 filename = Fexpand_file_name (filename, Qnil);
2911
2912 if (!w32_get_long_filename (SSDATA (ENCODE_FILE (filename)), longname,
2913 MAX_UTF8_PATH))
2914 return Qnil;
2915
2916 dostounix_filename (longname);
2917
2918 /* If we were passed only a drive, make sure that a slash is not appended
2919 for consistency with directories. Allow for drive mapping via SUBST
2920 in case expand-file-name is ever changed to expand those. */
2921 if (drive_only && longname[1] == ':' && longname[2] == '/' && !longname[3])
2922 longname[2] = '\0';
2923
2924 return DECODE_FILE (build_unibyte_string (longname));
2925 }
2926
2927 DEFUN ("w32-set-process-priority", Fw32_set_process_priority,
2928 Sw32_set_process_priority, 2, 2, 0,
2929 doc: /* Set the priority of PROCESS to PRIORITY.
2930 If PROCESS is nil, the priority of Emacs is changed, otherwise the
2931 priority of the process whose pid is PROCESS is changed.
2932 PRIORITY should be one of the symbols high, normal, or low;
2933 any other symbol will be interpreted as normal.
2934
2935 If successful, the return value is t, otherwise nil. */)
2936 (Lisp_Object process, Lisp_Object priority)
2937 {
2938 HANDLE proc_handle = GetCurrentProcess ();
2939 DWORD priority_class = NORMAL_PRIORITY_CLASS;
2940 Lisp_Object result = Qnil;
2941
2942 CHECK_SYMBOL (priority);
2943
2944 if (!NILP (process))
2945 {
2946 DWORD pid;
2947 child_process *cp;
2948
2949 CHECK_NUMBER (process);
2950
2951 /* Allow pid to be an internally generated one, or one obtained
2952 externally. This is necessary because real pids on Windows 95 are
2953 negative. */
2954
2955 pid = XINT (process);
2956 cp = find_child_pid (pid);
2957 if (cp != NULL)
2958 pid = cp->procinfo.dwProcessId;
2959
2960 proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
2961 }
2962
2963 if (EQ (priority, Qhigh))
2964 priority_class = HIGH_PRIORITY_CLASS;
2965 else if (EQ (priority, Qlow))
2966 priority_class = IDLE_PRIORITY_CLASS;
2967
2968 if (proc_handle != NULL)
2969 {
2970 if (SetPriorityClass (proc_handle, priority_class))
2971 result = Qt;
2972 if (!NILP (process))
2973 CloseHandle (proc_handle);
2974 }
2975
2976 return result;
2977 }
2978
2979 DEFUN ("w32-application-type", Fw32_application_type,
2980 Sw32_application_type, 1, 1, 0,
2981 doc: /* Return the type of an MS-Windows PROGRAM.
2982
2983 Knowing the type of an executable could be useful for formatting
2984 file names passed to it or for quoting its command-line arguments.
2985
2986 PROGRAM should specify an executable file, including the extension.
2987
2988 The value is one of the following:
2989
2990 `dos' -- a DOS .com program or some other non-PE executable
2991 `cygwin' -- a Cygwin program that depends on Cygwin DLL
2992 `msys' -- an MSYS 1.x or MSYS2 program
2993 `w32-native' -- a native Windows application
2994 `unknown' -- a file that doesn't exist, or cannot be open, or whose
2995 name is not encodable in the current ANSI codepage.
2996
2997 Note that for .bat and .cmd batch files the function returns the type
2998 of their command interpreter, as specified by the \"COMSPEC\"
2999 environment variable.
3000
3001 This function returns `unknown' for programs whose file names
3002 include characters not supported by the current ANSI codepage, as
3003 such programs cannot be invoked by Emacs anyway. */)
3004 (Lisp_Object program)
3005 {
3006 int is_dos_app, is_cygwin_app, is_msys_app, dummy;
3007 Lisp_Object encoded_progname;
3008 char *progname, progname_a[MAX_PATH];
3009
3010 program = Fexpand_file_name (program, Qnil);
3011 encoded_progname = ENCODE_FILE (program);
3012 progname = SSDATA (encoded_progname);
3013 unixtodos_filename (progname);
3014 filename_to_ansi (progname, progname_a);
3015 /* Reject file names that cannot be encoded in the current ANSI
3016 codepage. */
3017 if (_mbspbrk ((unsigned char *)progname_a, (const unsigned char *)"?"))
3018 return Qunknown;
3019
3020 if (w32_executable_type (progname_a, &is_dos_app, &is_cygwin_app,
3021 &is_msys_app, &dummy) != 0)
3022 return Qunknown;
3023 if (is_dos_app)
3024 return Qdos;
3025 if (is_cygwin_app)
3026 return Qcygwin;
3027 if (is_msys_app)
3028 return Qmsys;
3029 return Qw32_native;
3030 }
3031
3032 #ifdef HAVE_LANGINFO_CODESET
3033 /* Emulation of nl_langinfo. Used in fns.c:Flocale_info. */
3034 char *
3035 nl_langinfo (nl_item item)
3036 {
3037 /* Conversion of Posix item numbers to their Windows equivalents. */
3038 static const LCTYPE w32item[] = {
3039 LOCALE_IDEFAULTANSICODEPAGE,
3040 LOCALE_SDAYNAME1, LOCALE_SDAYNAME2, LOCALE_SDAYNAME3,
3041 LOCALE_SDAYNAME4, LOCALE_SDAYNAME5, LOCALE_SDAYNAME6, LOCALE_SDAYNAME7,
3042 LOCALE_SMONTHNAME1, LOCALE_SMONTHNAME2, LOCALE_SMONTHNAME3,
3043 LOCALE_SMONTHNAME4, LOCALE_SMONTHNAME5, LOCALE_SMONTHNAME6,
3044 LOCALE_SMONTHNAME7, LOCALE_SMONTHNAME8, LOCALE_SMONTHNAME9,
3045 LOCALE_SMONTHNAME10, LOCALE_SMONTHNAME11, LOCALE_SMONTHNAME12
3046 };
3047
3048 static char *nl_langinfo_buf = NULL;
3049 static int nl_langinfo_len = 0;
3050
3051 if (nl_langinfo_len <= 0)
3052 nl_langinfo_buf = xmalloc (nl_langinfo_len = 1);
3053
3054 if (item < 0 || item >= _NL_NUM)
3055 nl_langinfo_buf[0] = 0;
3056 else
3057 {
3058 LCID cloc = GetThreadLocale ();
3059 int need_len = GetLocaleInfo (cloc, w32item[item] | LOCALE_USE_CP_ACP,
3060 NULL, 0);
3061
3062 if (need_len <= 0)
3063 nl_langinfo_buf[0] = 0;
3064 else
3065 {
3066 if (item == CODESET)
3067 {
3068 need_len += 2; /* for the "cp" prefix */
3069 if (need_len < 8) /* for the case we call GetACP */
3070 need_len = 8;
3071 }
3072 if (nl_langinfo_len <= need_len)
3073 nl_langinfo_buf = xrealloc (nl_langinfo_buf,
3074 nl_langinfo_len = need_len);
3075 if (!GetLocaleInfo (cloc, w32item[item] | LOCALE_USE_CP_ACP,
3076 nl_langinfo_buf, nl_langinfo_len))
3077 nl_langinfo_buf[0] = 0;
3078 else if (item == CODESET)
3079 {
3080 if (strcmp (nl_langinfo_buf, "0") == 0 /* CP_ACP */
3081 || strcmp (nl_langinfo_buf, "1") == 0) /* CP_OEMCP */
3082 sprintf (nl_langinfo_buf, "cp%u", GetACP ());
3083 else
3084 {
3085 memmove (nl_langinfo_buf + 2, nl_langinfo_buf,
3086 strlen (nl_langinfo_buf) + 1);
3087 nl_langinfo_buf[0] = 'c';
3088 nl_langinfo_buf[1] = 'p';
3089 }
3090 }
3091 }
3092 }
3093 return nl_langinfo_buf;
3094 }
3095 #endif /* HAVE_LANGINFO_CODESET */
3096
3097 DEFUN ("w32-get-locale-info", Fw32_get_locale_info,
3098 Sw32_get_locale_info, 1, 2, 0,
3099 doc: /* Return information about the Windows locale LCID.
3100 By default, return a three letter locale code which encodes the default
3101 language as the first two characters, and the country or regional variant
3102 as the third letter. For example, ENU refers to `English (United States)',
3103 while ENC means `English (Canadian)'.
3104
3105 If the optional argument LONGFORM is t, the long form of the locale
3106 name is returned, e.g. `English (United States)' instead; if LONGFORM
3107 is a number, it is interpreted as an LCTYPE constant and the corresponding
3108 locale information is returned.
3109
3110 If LCID (a 16-bit number) is not a valid locale, the result is nil. */)
3111 (Lisp_Object lcid, Lisp_Object longform)
3112 {
3113 int got_abbrev;
3114 int got_full;
3115 char abbrev_name[32] = { 0 };
3116 char full_name[256] = { 0 };
3117
3118 CHECK_NUMBER (lcid);
3119
3120 if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
3121 return Qnil;
3122
3123 if (NILP (longform))
3124 {
3125 got_abbrev = GetLocaleInfo (XINT (lcid),
3126 LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
3127 abbrev_name, sizeof (abbrev_name));
3128 if (got_abbrev)
3129 return build_string (abbrev_name);
3130 }
3131 else if (EQ (longform, Qt))
3132 {
3133 got_full = GetLocaleInfo (XINT (lcid),
3134 LOCALE_SLANGUAGE | LOCALE_USE_CP_ACP,
3135 full_name, sizeof (full_name));
3136 if (got_full)
3137 return DECODE_SYSTEM (build_string (full_name));
3138 }
3139 else if (NUMBERP (longform))
3140 {
3141 got_full = GetLocaleInfo (XINT (lcid),
3142 XINT (longform),
3143 full_name, sizeof (full_name));
3144 /* GetLocaleInfo's return value includes the terminating null
3145 character, when the returned information is a string, whereas
3146 make_unibyte_string needs the string length without the
3147 terminating null. */
3148 if (got_full)
3149 return make_unibyte_string (full_name, got_full - 1);
3150 }
3151
3152 return Qnil;
3153 }
3154
3155
3156 DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id,
3157 Sw32_get_current_locale_id, 0, 0, 0,
3158 doc: /* Return Windows locale id for current locale setting.
3159 This is a numerical value; use `w32-get-locale-info' to convert to a
3160 human-readable form. */)
3161 (void)
3162 {
3163 return make_number (GetThreadLocale ());
3164 }
3165
3166 static DWORD
3167 int_from_hex (char * s)
3168 {
3169 DWORD val = 0;
3170 static char hex[] = "0123456789abcdefABCDEF";
3171 char * p;
3172
3173 while (*s && (p = strchr (hex, *s)) != NULL)
3174 {
3175 unsigned digit = p - hex;
3176 if (digit > 15)
3177 digit -= 6;
3178 val = val * 16 + digit;
3179 s++;
3180 }
3181 return val;
3182 }
3183
3184 /* We need to build a global list, since the EnumSystemLocale callback
3185 function isn't given a context pointer. */
3186 Lisp_Object Vw32_valid_locale_ids;
3187
3188 static BOOL CALLBACK ALIGN_STACK
3189 enum_locale_fn (LPTSTR localeNum)
3190 {
3191 DWORD id = int_from_hex (localeNum);
3192 Vw32_valid_locale_ids = Fcons (make_number (id), Vw32_valid_locale_ids);
3193 return TRUE;
3194 }
3195
3196 DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids,
3197 Sw32_get_valid_locale_ids, 0, 0, 0,
3198 doc: /* Return list of all valid Windows locale ids.
3199 Each id is a numerical value; use `w32-get-locale-info' to convert to a
3200 human-readable form. */)
3201 (void)
3202 {
3203 Vw32_valid_locale_ids = Qnil;
3204
3205 EnumSystemLocales (enum_locale_fn, LCID_SUPPORTED);
3206
3207 Vw32_valid_locale_ids = Fnreverse (Vw32_valid_locale_ids);
3208 return Vw32_valid_locale_ids;
3209 }
3210
3211
3212 DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id, Sw32_get_default_locale_id, 0, 1, 0,
3213 doc: /* Return Windows locale id for default locale setting.
3214 By default, the system default locale setting is returned; if the optional
3215 parameter USERP is non-nil, the user default locale setting is returned.
3216 This is a numerical value; use `w32-get-locale-info' to convert to a
3217 human-readable form. */)
3218 (Lisp_Object userp)
3219 {
3220 if (NILP (userp))
3221 return make_number (GetSystemDefaultLCID ());
3222 return make_number (GetUserDefaultLCID ());
3223 }
3224
3225
3226 DEFUN ("w32-set-current-locale", Fw32_set_current_locale, Sw32_set_current_locale, 1, 1, 0,
3227 doc: /* Make Windows locale LCID be the current locale setting for Emacs.
3228 If successful, the new locale id is returned, otherwise nil. */)
3229 (Lisp_Object lcid)
3230 {
3231 CHECK_NUMBER (lcid);
3232
3233 if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
3234 return Qnil;
3235
3236 if (!SetThreadLocale (XINT (lcid)))
3237 return Qnil;
3238
3239 /* Need to set input thread locale if present. */
3240 if (dwWindowsThreadId)
3241 /* Reply is not needed. */
3242 PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0);
3243
3244 return make_number (GetThreadLocale ());
3245 }
3246
3247
3248 /* We need to build a global list, since the EnumCodePages callback
3249 function isn't given a context pointer. */
3250 Lisp_Object Vw32_valid_codepages;
3251
3252 static BOOL CALLBACK ALIGN_STACK
3253 enum_codepage_fn (LPTSTR codepageNum)
3254 {
3255 DWORD id = atoi (codepageNum);
3256 Vw32_valid_codepages = Fcons (make_number (id), Vw32_valid_codepages);
3257 return TRUE;
3258 }
3259
3260 DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages,
3261 Sw32_get_valid_codepages, 0, 0, 0,
3262 doc: /* Return list of all valid Windows codepages. */)
3263 (void)
3264 {
3265 Vw32_valid_codepages = Qnil;
3266
3267 EnumSystemCodePages (enum_codepage_fn, CP_SUPPORTED);
3268
3269 Vw32_valid_codepages = Fnreverse (Vw32_valid_codepages);
3270 return Vw32_valid_codepages;
3271 }
3272
3273
3274 DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage,
3275 Sw32_get_console_codepage, 0, 0, 0,
3276 doc: /* Return current Windows codepage for console input. */)
3277 (void)
3278 {
3279 return make_number (GetConsoleCP ());
3280 }
3281
3282
3283 DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage,
3284 Sw32_set_console_codepage, 1, 1, 0,
3285 doc: /* Make Windows codepage CP be the codepage for Emacs tty keyboard input.
3286 This codepage setting affects keyboard input in tty mode.
3287 If successful, the new CP is returned, otherwise nil. */)
3288 (Lisp_Object cp)
3289 {
3290 CHECK_NUMBER (cp);
3291
3292 if (!IsValidCodePage (XINT (cp)))
3293 return Qnil;
3294
3295 if (!SetConsoleCP (XINT (cp)))
3296 return Qnil;
3297
3298 return make_number (GetConsoleCP ());
3299 }
3300
3301
3302 DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage,
3303 Sw32_get_console_output_codepage, 0, 0, 0,
3304 doc: /* Return current Windows codepage for console output. */)
3305 (void)
3306 {
3307 return make_number (GetConsoleOutputCP ());
3308 }
3309
3310
3311 DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage,
3312 Sw32_set_console_output_codepage, 1, 1, 0,
3313 doc: /* Make Windows codepage CP be the codepage for Emacs console output.
3314 This codepage setting affects display in tty mode.
3315 If successful, the new CP is returned, otherwise nil. */)
3316 (Lisp_Object cp)
3317 {
3318 CHECK_NUMBER (cp);
3319
3320 if (!IsValidCodePage (XINT (cp)))
3321 return Qnil;
3322
3323 if (!SetConsoleOutputCP (XINT (cp)))
3324 return Qnil;
3325
3326 return make_number (GetConsoleOutputCP ());
3327 }
3328
3329
3330 DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset,
3331 Sw32_get_codepage_charset, 1, 1, 0,
3332 doc: /* Return charset ID corresponding to codepage CP.
3333 Returns nil if the codepage is not valid or its charset ID could
3334 not be determined.
3335
3336 Note that this function is only guaranteed to work with ANSI
3337 codepages; most console codepages are not supported and will
3338 yield nil. */)
3339 (Lisp_Object cp)
3340 {
3341 CHARSETINFO info;
3342 DWORD_PTR dwcp;
3343
3344 CHECK_NUMBER (cp);
3345
3346 if (!IsValidCodePage (XINT (cp)))
3347 return Qnil;
3348
3349 /* Going through a temporary DWORD_PTR variable avoids compiler warning
3350 about cast to pointer from integer of different size, when
3351 building --with-wide-int or building for 64bit. */
3352 dwcp = XINT (cp);
3353 if (TranslateCharsetInfo ((DWORD *) dwcp, &info, TCI_SRCCODEPAGE))
3354 return make_number (info.ciCharset);
3355
3356 return Qnil;
3357 }
3358
3359
3360 DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts,
3361 Sw32_get_valid_keyboard_layouts, 0, 0, 0,
3362 doc: /* Return list of Windows keyboard languages and layouts.
3363 The return value is a list of pairs of language id and layout id. */)
3364 (void)
3365 {
3366 int num_layouts = GetKeyboardLayoutList (0, NULL);
3367 HKL * layouts = (HKL *) alloca (num_layouts * sizeof (HKL));
3368 Lisp_Object obj = Qnil;
3369
3370 if (GetKeyboardLayoutList (num_layouts, layouts) == num_layouts)
3371 {
3372 while (--num_layouts >= 0)
3373 {
3374 HKL kl = layouts[num_layouts];
3375
3376 obj = Fcons (Fcons (make_number (LOWORD (kl)),
3377 make_number (HIWORD (kl))),
3378 obj);
3379 }
3380 }
3381
3382 return obj;
3383 }
3384
3385
3386 DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout,
3387 Sw32_get_keyboard_layout, 0, 0, 0,
3388 doc: /* Return current Windows keyboard language and layout.
3389 The return value is the cons of the language id and the layout id. */)
3390 (void)
3391 {
3392 HKL kl = GetKeyboardLayout (dwWindowsThreadId);
3393
3394 return Fcons (make_number (LOWORD (kl)),
3395 make_number (HIWORD (kl)));
3396 }
3397
3398
3399 DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout,
3400 Sw32_set_keyboard_layout, 1, 1, 0,
3401 doc: /* Make LAYOUT be the current keyboard layout for Emacs.
3402 The keyboard layout setting affects interpretation of keyboard input.
3403 If successful, the new layout id is returned, otherwise nil. */)
3404 (Lisp_Object layout)
3405 {
3406 HKL kl;
3407
3408 CHECK_CONS (layout);
3409 CHECK_NUMBER_CAR (layout);
3410 CHECK_NUMBER_CDR (layout);
3411
3412 kl = (HKL) (UINT_PTR) ((XINT (XCAR (layout)) & 0xffff)
3413 | (XINT (XCDR (layout)) << 16));
3414
3415 /* Synchronize layout with input thread. */
3416 if (dwWindowsThreadId)
3417 {
3418 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETKEYBOARDLAYOUT,
3419 (WPARAM) kl, 0))
3420 {
3421 MSG msg;
3422 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
3423
3424 if (msg.wParam == 0)
3425 return Qnil;
3426 }
3427 }
3428 else if (!ActivateKeyboardLayout (kl, 0))
3429 return Qnil;
3430
3431 return Fw32_get_keyboard_layout ();
3432 }
3433
3434 /* Two variables to interface between get_lcid and the EnumLocales
3435 callback function below. */
3436 #ifndef LOCALE_NAME_MAX_LENGTH
3437 # define LOCALE_NAME_MAX_LENGTH 85
3438 #endif
3439 static LCID found_lcid;
3440 static char lname[3 * LOCALE_NAME_MAX_LENGTH + 1 + 1];
3441
3442 /* Callback function for EnumLocales. */
3443 static BOOL CALLBACK
3444 get_lcid_callback (LPTSTR locale_num_str)
3445 {
3446 char *endp;
3447 char locval[2 * LOCALE_NAME_MAX_LENGTH + 1 + 1];
3448 LCID try_lcid = strtoul (locale_num_str, &endp, 16);
3449
3450 if (GetLocaleInfo (try_lcid, LOCALE_SABBREVLANGNAME,
3451 locval, LOCALE_NAME_MAX_LENGTH))
3452 {
3453 size_t locval_len;
3454
3455 /* This is for when they only specify the language, as in "ENU". */
3456 if (stricmp (locval, lname) == 0)
3457 {
3458 found_lcid = try_lcid;
3459 return FALSE;
3460 }
3461 locval_len = strlen (locval);
3462 strcpy (locval + locval_len, "_");
3463 if (GetLocaleInfo (try_lcid, LOCALE_SABBREVCTRYNAME,
3464 locval + locval_len + 1, LOCALE_NAME_MAX_LENGTH))
3465 {
3466 locval_len = strlen (locval);
3467 if (strnicmp (locval, lname, locval_len) == 0
3468 && (lname[locval_len] == '.'
3469 || lname[locval_len] == '\0'))
3470 {
3471 found_lcid = try_lcid;
3472 return FALSE;
3473 }
3474 }
3475 }
3476 return TRUE;
3477 }
3478
3479 /* Return the Locale ID (LCID) number given the locale's name, a
3480 string, in LOCALE_NAME. This works by enumerating all the locales
3481 supported by the system, until we find one whose name matches
3482 LOCALE_NAME. */
3483 static LCID
3484 get_lcid (const char *locale_name)
3485 {
3486 /* A simple cache. */
3487 static LCID last_lcid;
3488 static char last_locale[1000];
3489
3490 /* The code below is not thread-safe, as it uses static variables.
3491 But this function is called only from the Lisp thread. */
3492 if (last_lcid > 0 && strcmp (locale_name, last_locale) == 0)
3493 return last_lcid;
3494
3495 strncpy (lname, locale_name, sizeof (lname) - 1);
3496 lname[sizeof (lname) - 1] = '\0';
3497 found_lcid = 0;
3498 EnumSystemLocales (get_lcid_callback, LCID_SUPPORTED);
3499 if (found_lcid > 0)
3500 {
3501 last_lcid = found_lcid;
3502 strcpy (last_locale, locale_name);
3503 }
3504 return found_lcid;
3505 }
3506
3507 #ifndef _NLSCMPERROR
3508 # define _NLSCMPERROR INT_MAX
3509 #endif
3510 #ifndef LINGUISTIC_IGNORECASE
3511 # define LINGUISTIC_IGNORECASE 0x00000010
3512 #endif
3513
3514 typedef int (WINAPI *CompareStringW_Proc)
3515 (LCID, DWORD, LPCWSTR, int, LPCWSTR, int);
3516
3517 int
3518 w32_compare_strings (const char *s1, const char *s2, char *locname,
3519 int ignore_case)
3520 {
3521 LCID lcid = GetThreadLocale ();
3522 wchar_t *string1_w, *string2_w;
3523 int val, needed;
3524 extern BOOL g_b_init_compare_string_w;
3525 static CompareStringW_Proc pCompareStringW;
3526 DWORD flags = 0;
3527
3528 USE_SAFE_ALLOCA;
3529
3530 /* The LCID machinery doesn't seem to support the "C" locale, so we
3531 need to do that by hand. */
3532 if (locname
3533 && ((locname[0] == 'C' && (locname[1] == '\0' || locname[1] == '.'))
3534 || strcmp (locname, "POSIX") == 0))
3535 return (ignore_case ? stricmp (s1, s2) : strcmp (s1, s2));
3536
3537 if (!g_b_init_compare_string_w)
3538 {
3539 if (os_subtype == OS_9X)
3540 {
3541 pCompareStringW =
3542 (CompareStringW_Proc) GetProcAddress (LoadLibrary ("Unicows.dll"),
3543 "CompareStringW");
3544 if (!pCompareStringW)
3545 {
3546 errno = EINVAL;
3547 /* This return value is compatible with wcscoll and
3548 other MS CRT functions. */
3549 return _NLSCMPERROR;
3550 }
3551 }
3552 else
3553 pCompareStringW = CompareStringW;
3554
3555 g_b_init_compare_string_w = 1;
3556 }
3557
3558 needed = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, s1, -1, NULL, 0);
3559 if (needed > 0)
3560 {
3561 SAFE_NALLOCA (string1_w, 1, needed + 1);
3562 pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, s1, -1,
3563 string1_w, needed);
3564 }
3565 else
3566 {
3567 errno = EINVAL;
3568 return _NLSCMPERROR;
3569 }
3570
3571 needed = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, s2, -1, NULL, 0);
3572 if (needed > 0)
3573 {
3574 SAFE_NALLOCA (string2_w, 1, needed + 1);
3575 pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, s2, -1,
3576 string2_w, needed);
3577 }
3578 else
3579 {
3580 SAFE_FREE ();
3581 errno = EINVAL;
3582 return _NLSCMPERROR;
3583 }
3584
3585 if (locname)
3586 {
3587 /* Convert locale name string to LCID. We don't want to use
3588 LocaleNameToLCID because (a) it is only available since
3589 Vista, and (b) it doesn't accept locale names returned by
3590 'setlocale' and 'GetLocaleInfo'. */
3591 LCID new_lcid = get_lcid (locname);
3592
3593 if (new_lcid > 0)
3594 lcid = new_lcid;
3595 else
3596 error ("Invalid locale %s: Invalid argument", locname);
3597 }
3598
3599 if (ignore_case)
3600 {
3601 /* NORM_IGNORECASE ignores any tertiary distinction, not just
3602 case variants. LINGUISTIC_IGNORECASE is more selective, and
3603 is sensitive to the locale's language, but it is not
3604 available before Vista. */
3605 if (w32_major_version >= 6)
3606 flags |= LINGUISTIC_IGNORECASE;
3607 else
3608 flags |= NORM_IGNORECASE;
3609 }
3610 /* This approximates what glibc collation functions do when the
3611 locale's codeset is UTF-8. */
3612 if (!NILP (Vw32_collate_ignore_punctuation))
3613 flags |= NORM_IGNORESYMBOLS;
3614 val = pCompareStringW (lcid, flags, string1_w, -1, string2_w, -1);
3615 SAFE_FREE ();
3616 if (!val)
3617 {
3618 errno = EINVAL;
3619 return _NLSCMPERROR;
3620 }
3621 return val - 2;
3622 }
3623
3624 \f
3625 void
3626 syms_of_ntproc (void)
3627 {
3628 DEFSYM (Qhigh, "high");
3629 DEFSYM (Qlow, "low");
3630 DEFSYM (Qcygwin, "cygwin");
3631 DEFSYM (Qmsys, "msys");
3632 DEFSYM (Qw32_native, "w32-native");
3633
3634 defsubr (&Sw32_has_winsock);
3635 defsubr (&Sw32_unload_winsock);
3636
3637 defsubr (&Sw32_short_file_name);
3638 defsubr (&Sw32_long_file_name);
3639 defsubr (&Sw32_set_process_priority);
3640 defsubr (&Sw32_application_type);
3641 defsubr (&Sw32_get_locale_info);
3642 defsubr (&Sw32_get_current_locale_id);
3643 defsubr (&Sw32_get_default_locale_id);
3644 defsubr (&Sw32_get_valid_locale_ids);
3645 defsubr (&Sw32_set_current_locale);
3646
3647 defsubr (&Sw32_get_console_codepage);
3648 defsubr (&Sw32_set_console_codepage);
3649 defsubr (&Sw32_get_console_output_codepage);
3650 defsubr (&Sw32_set_console_output_codepage);
3651 defsubr (&Sw32_get_valid_codepages);
3652 defsubr (&Sw32_get_codepage_charset);
3653
3654 defsubr (&Sw32_get_valid_keyboard_layouts);
3655 defsubr (&Sw32_get_keyboard_layout);
3656 defsubr (&Sw32_set_keyboard_layout);
3657
3658 DEFVAR_LISP ("w32-quote-process-args", Vw32_quote_process_args,
3659 doc: /* Non-nil enables quoting of process arguments to ensure correct parsing.
3660 Because Windows does not directly pass argv arrays to child processes,
3661 programs have to reconstruct the argv array by parsing the command
3662 line string. For an argument to contain a space, it must be enclosed
3663 in double quotes or it will be parsed as multiple arguments.
3664
3665 If the value is a character, that character will be used to escape any
3666 quote characters that appear, otherwise a suitable escape character
3667 will be chosen based on the type of the program. */);
3668 Vw32_quote_process_args = Qt;
3669
3670 DEFVAR_LISP ("w32-start-process-show-window",
3671 Vw32_start_process_show_window,
3672 doc: /* When nil, new child processes hide their windows.
3673 When non-nil, they show their window in the method of their choice.
3674 This variable doesn't affect GUI applications, which will never be hidden. */);
3675 Vw32_start_process_show_window = Qnil;
3676
3677 DEFVAR_LISP ("w32-start-process-share-console",
3678 Vw32_start_process_share_console,
3679 doc: /* When nil, new child processes are given a new console.
3680 When non-nil, they share the Emacs console; this has the limitation of
3681 allowing only one DOS subprocess to run at a time (whether started directly
3682 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
3683 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
3684 otherwise respond to interrupts from Emacs. */);
3685 Vw32_start_process_share_console = Qnil;
3686
3687 DEFVAR_LISP ("w32-start-process-inherit-error-mode",
3688 Vw32_start_process_inherit_error_mode,
3689 doc: /* When nil, new child processes revert to the default error mode.
3690 When non-nil, they inherit their error mode setting from Emacs, which stops
3691 them blocking when trying to access unmounted drives etc. */);
3692 Vw32_start_process_inherit_error_mode = Qt;
3693
3694 DEFVAR_INT ("w32-pipe-read-delay", w32_pipe_read_delay,
3695 doc: /* Forced delay before reading subprocess output.
3696 This is done to improve the buffering of subprocess output, by
3697 avoiding the inefficiency of frequently reading small amounts of data.
3698
3699 If positive, the value is the number of milliseconds to sleep before
3700 reading the subprocess output. If negative, the magnitude is the number
3701 of time slices to wait (effectively boosting the priority of the child
3702 process temporarily). A value of zero disables waiting entirely. */);
3703 w32_pipe_read_delay = 50;
3704
3705 DEFVAR_LISP ("w32-downcase-file-names", Vw32_downcase_file_names,
3706 doc: /* Non-nil means convert all-upper case file names to lower case.
3707 This applies when performing completions and file name expansion.
3708 Note that the value of this setting also affects remote file names,
3709 so you probably don't want to set to non-nil if you use case-sensitive
3710 filesystems via ange-ftp. */);
3711 Vw32_downcase_file_names = Qnil;
3712
3713 #if 0
3714 DEFVAR_LISP ("w32-generate-fake-inodes", Vw32_generate_fake_inodes,
3715 doc: /* Non-nil means attempt to fake realistic inode values.
3716 This works by hashing the truename of files, and should detect
3717 aliasing between long and short (8.3 DOS) names, but can have
3718 false positives because of hash collisions. Note that determining
3719 the truename of a file can be slow. */);
3720 Vw32_generate_fake_inodes = Qnil;
3721 #endif
3722
3723 DEFVAR_LISP ("w32-get-true-file-attributes", Vw32_get_true_file_attributes,
3724 doc: /* Non-nil means determine accurate file attributes in `file-attributes'.
3725 This option controls whether to issue additional system calls to determine
3726 accurate link counts, file type, and ownership information. It is more
3727 useful for files on NTFS volumes, where hard links and file security are
3728 supported, than on volumes of the FAT family.
3729
3730 Without these system calls, link count will always be reported as 1 and file
3731 ownership will be attributed to the current user.
3732 The default value `local' means only issue these system calls for files
3733 on local fixed drives. A value of nil means never issue them.
3734 Any other non-nil value means do this even on remote and removable drives
3735 where the performance impact may be noticeable even on modern hardware. */);
3736 Vw32_get_true_file_attributes = Qlocal;
3737
3738 DEFVAR_LISP ("w32-collate-ignore-punctuation",
3739 Vw32_collate_ignore_punctuation,
3740 doc: /* Non-nil causes string collation functions ignore punctuation on MS-Windows.
3741 On Posix platforms, `string-collate-lessp' and `string-collate-equalp'
3742 ignore punctuation characters when they compare strings, if the
3743 locale's codeset is UTF-8, as in \"en_US.UTF-8\". Binding this option
3744 to a non-nil value will achieve a similar effect on MS-Windows, where
3745 locales with UTF-8 codeset are not supported.
3746
3747 Note that setting this to non-nil will also ignore blanks and symbols
3748 in the strings. So do NOT use this option when comparing file names
3749 for equality, only when you need to sort them. */);
3750 Vw32_collate_ignore_punctuation = Qnil;
3751
3752 staticpro (&Vw32_valid_locale_ids);
3753 staticpro (&Vw32_valid_codepages);
3754 }
3755 /* end of w32proc.c */