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