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