Fix wording of comments in w32fns.c.
[emacs.git] / src / w32proc.c
blob7d0039d0d5eaae7fe7b4fcd2260dd3fbc48a91f6
1 /* Process support for GNU Emacs on the Microsoft Windows API.
2 Copyright (C) 1992, 1995, 1999-2012 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 Drew Bliss Oct 14, 1993
21 Adapted from alarm.c by Tim Fleehart
24 #include <stdio.h>
25 #include <stdlib.h>
26 #include <errno.h>
27 #include <io.h>
28 #include <fcntl.h>
29 #include <signal.h>
30 #include <sys/file.h>
32 /* must include CRT headers *before* config.h */
33 #include <config.h>
35 #undef signal
36 #undef wait
37 #undef spawnve
38 #undef select
39 #undef kill
41 #include <windows.h>
42 #ifdef __GNUC__
43 /* This definition is missing from mingw32 headers. */
44 extern BOOL WINAPI IsValidLocale (LCID, DWORD);
45 #endif
47 #ifdef HAVE_LANGINFO_CODESET
48 #include <nl_types.h>
49 #include <langinfo.h>
50 #endif
52 #include "lisp.h"
53 #include "w32.h"
54 #include "w32heap.h"
55 #include "systime.h"
56 #include "syswait.h"
57 #include "process.h"
58 #include "syssignal.h"
59 #include "w32term.h"
60 #include "dispextern.h" /* for xstrcasecmp */
61 #include "coding.h"
63 #define RVA_TO_PTR(var,section,filedata) \
64 ((void *)((section)->PointerToRawData \
65 + ((DWORD_PTR)(var) - (section)->VirtualAddress) \
66 + (filedata).file_base))
68 Lisp_Object Qhigh, Qlow;
70 typedef void (_CALLBACK_ *signal_handler) (int);
72 /* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */
73 static signal_handler sig_handlers[NSIG];
75 static sigset_t sig_mask;
77 static CRITICAL_SECTION crit_sig;
79 /* Improve on the CRT 'signal' implementation so that we could record
80 the SIGCHLD handler and fake interval timers. */
81 signal_handler
82 sys_signal (int sig, signal_handler handler)
84 signal_handler old;
86 /* SIGCHLD is needed for supporting subprocesses, see sys_kill
87 below. SIGALRM and SIGPROF are used by setitimer. All the
88 others are the only ones supported by the MS runtime. */
89 if (!(sig == SIGCHLD || sig == SIGSEGV || sig == SIGILL
90 || sig == SIGFPE || sig == SIGABRT || sig == SIGTERM
91 || sig == SIGALRM || sig == SIGPROF))
93 errno = EINVAL;
94 return SIG_ERR;
96 old = sig_handlers[sig];
97 /* SIGABRT is treated specially because w32.c installs term_ntproc
98 as its handler, so we don't want to override that afterwards.
99 Aborting Emacs works specially anyway: either by calling
100 emacs_abort directly or through terminate_due_to_signal, which
101 calls emacs_abort through emacs_raise. */
102 if (!(sig == SIGABRT && old == term_ntproc))
104 sig_handlers[sig] = handler;
105 if (!(sig == SIGCHLD || sig == SIGALRM || sig == SIGPROF))
106 signal (sig, handler);
108 return old;
111 /* Emulate sigaction. */
113 sigaction (int sig, const struct sigaction *act, struct sigaction *oact)
115 signal_handler old = SIG_DFL;
116 int retval = 0;
118 if (act)
119 old = sys_signal (sig, act->sa_handler);
120 else if (oact)
121 old = sig_handlers[sig];
123 if (old == SIG_ERR)
125 errno = EINVAL;
126 retval = -1;
128 if (oact)
130 oact->sa_handler = old;
131 oact->sa_flags = 0;
132 oact->sa_mask = empty_mask;
134 return retval;
137 /* Emulate signal sets and blocking of signals used by timers. */
140 sigemptyset (sigset_t *set)
142 *set = 0;
143 return 0;
147 sigaddset (sigset_t *set, int signo)
149 if (!set)
151 errno = EINVAL;
152 return -1;
154 if (signo < 0 || signo >= NSIG)
156 errno = EINVAL;
157 return -1;
160 *set |= (1U << signo);
162 return 0;
166 sigfillset (sigset_t *set)
168 if (!set)
170 errno = EINVAL;
171 return -1;
174 *set = 0xFFFFFFFF;
175 return 0;
179 sigprocmask (int how, const sigset_t *set, sigset_t *oset)
181 if (!(how == SIG_BLOCK || how == SIG_UNBLOCK || how == SIG_SETMASK))
183 errno = EINVAL;
184 return -1;
187 if (oset)
188 *oset = sig_mask;
190 if (!set)
191 return 0;
193 switch (how)
195 case SIG_BLOCK:
196 sig_mask |= *set;
197 break;
198 case SIG_SETMASK:
199 sig_mask = *set;
200 break;
201 case SIG_UNBLOCK:
202 /* FIXME: Catch signals that are blocked and reissue them when
203 they are unblocked. Important for SIGALRM and SIGPROF only. */
204 sig_mask &= ~(*set);
205 break;
208 return 0;
212 pthread_sigmask (int how, const sigset_t *set, sigset_t *oset)
214 if (sigprocmask (how, set, oset) == -1)
215 return EINVAL;
216 return 0;
220 sigismember (const sigset_t *set, int signo)
222 if (signo < 0 || signo >= NSIG)
224 errno = EINVAL;
225 return -1;
227 if (signo > sizeof (*set) * BITS_PER_CHAR)
228 emacs_abort ();
230 return (*set & (1U << signo)) != 0;
234 setpgrp (int pid, int gid)
236 return 0;
239 /* Emulations of interval timers.
241 Limitations: only ITIMER_REAL and ITIMER_PROF are supported.
243 Implementation: a separate thread is started for each timer type,
244 the thread calls the appropriate signal handler when the timer
245 expires, after stopping the thread which installed the timer. */
247 /* FIXME: clock_t counts overflow after 49 days, need to handle the
248 wrap-around. */
249 struct itimer_data {
250 clock_t expire;
251 clock_t reload;
252 int terminate;
253 int type;
254 HANDLE caller_thread;
255 HANDLE timer_thread;
258 static clock_t ticks_now;
259 static struct itimer_data real_itimer, prof_itimer;
260 static clock_t clocks_min;
261 /* If non-zero, itimers are disabled. Used during shutdown, when we
262 delete the critical sections used by the timer threads. */
263 static int disable_itimers;
265 static CRITICAL_SECTION crit_real, crit_prof;
267 #define MAX_SINGLE_SLEEP 30
269 static DWORD WINAPI
270 timer_loop (LPVOID arg)
272 struct itimer_data *itimer = (struct itimer_data *)arg;
273 int which = itimer->type;
274 int sig = (which == ITIMER_REAL) ? SIGALRM : SIGPROF;
275 CRITICAL_SECTION *crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
276 const DWORD max_sleep = MAX_SINGLE_SLEEP * 1000 / CLOCKS_PER_SEC;
277 int new_count = 0;
279 while (1)
281 DWORD sleep_time;
282 signal_handler handler;
283 clock_t now, expire, reload;
285 /* Load new values if requested by setitimer. */
286 EnterCriticalSection (crit);
287 expire = itimer->expire;
288 reload = itimer->reload;
289 LeaveCriticalSection (crit);
290 if (itimer->terminate)
291 return 0;
293 if (itimer->expire == 0)
295 /* We are idle. */
296 Sleep (max_sleep);
297 continue;
300 expire = itimer->expire;
301 if (expire > (now = clock ()))
302 sleep_time = expire - now;
303 else
304 sleep_time = 0;
305 /* Don't sleep too long at a time, to be able to see the
306 termination flag without too long a delay. */
307 while (sleep_time > max_sleep)
309 if (itimer->terminate)
310 return 0;
311 Sleep (max_sleep);
312 expire = itimer->expire;
313 sleep_time = (expire > (now = clock ())) ? expire - now : 0;
315 if (itimer->terminate)
316 return 0;
317 if (sleep_time > 0)
319 Sleep (sleep_time * 1000 / CLOCKS_PER_SEC);
320 /* Always sleep past the expiration time, to make sure we
321 never call the handler _before_ the expiration time,
322 always slightly after it. Sleep(5) makes sure we don't
323 hog the CPU by calling 'clock' with high frequency, and
324 also let other threads work. */
325 while (clock () < expire)
326 Sleep (5);
329 if (itimer->expire == 0)
330 continue;
332 /* Time's up. */
333 handler = sig_handlers[sig];
334 if (!(handler == SIG_DFL || handler == SIG_IGN || handler == SIG_ERR)
335 /* FIXME: Don't ignore masked signals. Instead, record that
336 they happened and reissue them when the signal is
337 unblocked. */
338 && !sigismember (&sig_mask, sig)
339 /* Simulate masking of SIGALRM and SIGPROF when processing
340 fatal signals. */
341 && !fatal_error_in_progress
342 && itimer->caller_thread)
344 /* Simulate a signal delivered to the thread which installed
345 the timer, by suspending that thread while the handler
346 runs. */
347 DWORD result = SuspendThread (itimer->caller_thread);
349 if (result == (DWORD)-1)
350 return 2;
352 handler (sig);
353 ResumeThread (itimer->caller_thread);
356 if (itimer->expire == 0)
357 continue;
359 /* Update expiration time and loop. */
360 EnterCriticalSection (crit);
361 expire = itimer->expire;
362 reload = itimer->reload;
363 if (reload > 0)
365 now = clock ();
366 if (expire <= now)
368 clock_t lag = now - expire;
370 /* If we missed some opportunities (presumably while
371 sleeping or while the signal handler ran), skip
372 them. */
373 if (lag > reload)
374 expire = now - (lag % reload);
376 expire += reload;
379 else
380 expire = 0; /* become idle */
381 itimer->expire = expire;
382 LeaveCriticalSection (crit);
384 return 0;
387 static void
388 stop_timer_thread (int which)
390 struct itimer_data *itimer =
391 (which == ITIMER_REAL) ? &real_itimer : &prof_itimer;
392 int i;
393 DWORD err, exit_code = 255;
394 BOOL status;
396 /* Signal the thread that it should terminate. */
397 itimer->terminate = 1;
399 if (itimer->timer_thread == NULL)
400 return;
402 /* Wait for the timer thread to terminate voluntarily, then kill it
403 if it doesn't. This loop waits twice more than the maximum
404 amount of time a timer thread sleeps, see above. */
405 for (i = 0; i < MAX_SINGLE_SLEEP / 5; i++)
407 if (!((status = GetExitCodeThread (itimer->timer_thread, &exit_code))
408 && exit_code == STILL_ACTIVE))
409 break;
410 Sleep (10);
412 if ((status == FALSE && (err = GetLastError ()) == ERROR_INVALID_HANDLE)
413 || exit_code == STILL_ACTIVE)
415 if (!(status == FALSE && err == ERROR_INVALID_HANDLE))
416 TerminateThread (itimer->timer_thread, 0);
419 /* Clean up. */
420 CloseHandle (itimer->timer_thread);
421 itimer->timer_thread = NULL;
422 if (itimer->caller_thread)
424 CloseHandle (itimer->caller_thread);
425 itimer->caller_thread = NULL;
429 /* This is called at shutdown time from term_ntproc. */
430 void
431 term_timers (void)
433 if (real_itimer.timer_thread)
434 stop_timer_thread (ITIMER_REAL);
435 if (prof_itimer.timer_thread)
436 stop_timer_thread (ITIMER_PROF);
438 /* We are going to delete the critical sections, so timers cannot
439 work after this. */
440 disable_itimers = 1;
442 DeleteCriticalSection (&crit_real);
443 DeleteCriticalSection (&crit_prof);
444 DeleteCriticalSection (&crit_sig);
447 /* This is called at initialization time from init_ntproc. */
448 void
449 init_timers (void)
451 /* Make sure we start with zeroed out itimer structures, since
452 dumping may have left there traces of threads long dead. */
453 memset (&real_itimer, 0, sizeof real_itimer);
454 memset (&prof_itimer, 0, sizeof prof_itimer);
456 InitializeCriticalSection (&crit_real);
457 InitializeCriticalSection (&crit_prof);
458 InitializeCriticalSection (&crit_sig);
460 disable_itimers = 0;
463 static int
464 start_timer_thread (int which)
466 DWORD exit_code;
467 struct itimer_data *itimer =
468 (which == ITIMER_REAL) ? &real_itimer : &prof_itimer;
470 if (itimer->timer_thread
471 && GetExitCodeThread (itimer->timer_thread, &exit_code)
472 && exit_code == STILL_ACTIVE)
473 return 0;
475 /* Start a new thread. */
476 if (!DuplicateHandle (GetCurrentProcess (), GetCurrentThread (),
477 GetCurrentProcess (), &itimer->caller_thread, 0,
478 FALSE, DUPLICATE_SAME_ACCESS))
480 errno = ESRCH;
481 return -1;
484 itimer->terminate = 0;
485 itimer->type = which;
486 /* Request that no more than 64KB of stack be reserved for this
487 thread, to avoid reserving too much memory, which would get in
488 the way of threads we start to wait for subprocesses. See also
489 new_child below. */
490 itimer->timer_thread = CreateThread (NULL, 64 * 1024, timer_loop,
491 (void *)itimer, 0x00010000, NULL);
493 if (!itimer->timer_thread)
495 CloseHandle (itimer->caller_thread);
496 itimer->caller_thread = NULL;
497 errno = EAGAIN;
498 return -1;
501 /* This is needed to make sure that the timer thread running for
502 profiling gets CPU as soon as the Sleep call terminates. */
503 if (which == ITIMER_PROF)
504 SetThreadPriority (itimer->caller_thread, THREAD_PRIORITY_TIME_CRITICAL);
506 return 0;
509 /* Most of the code of getitimer and setitimer (but not of their
510 subroutines) was shamelessly stolen from itimer.c in the DJGPP
511 library, see www.delorie.com/djgpp. */
513 getitimer (int which, struct itimerval *value)
515 volatile clock_t *t_expire;
516 volatile clock_t *t_reload;
517 clock_t expire, reload;
518 __int64 usecs;
519 CRITICAL_SECTION *crit;
521 if (disable_itimers)
522 return -1;
524 ticks_now = clock ();
526 if (!value)
528 errno = EFAULT;
529 return -1;
532 if (which != ITIMER_REAL && which != ITIMER_PROF)
534 errno = EINVAL;
535 return -1;
538 t_expire = (which == ITIMER_REAL) ? &real_itimer.expire: &prof_itimer.expire;
539 t_reload = (which == ITIMER_REAL) ? &real_itimer.reload: &prof_itimer.reload;
540 crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
542 EnterCriticalSection (crit);
543 reload = *t_reload;
544 expire = *t_expire;
545 LeaveCriticalSection (crit);
547 if (expire)
548 expire -= ticks_now;
550 value->it_value.tv_sec = expire / CLOCKS_PER_SEC;
551 usecs = (expire % CLOCKS_PER_SEC) * (__int64)1000000 / CLOCKS_PER_SEC;
552 value->it_value.tv_usec = usecs;
553 value->it_interval.tv_sec = reload / CLOCKS_PER_SEC;
554 usecs = (reload % CLOCKS_PER_SEC) * (__int64)1000000 / CLOCKS_PER_SEC;
555 value->it_interval.tv_usec= usecs;
557 return 0;
561 setitimer(int which, struct itimerval *value, struct itimerval *ovalue)
563 volatile clock_t *t_expire, *t_reload;
564 clock_t expire, reload, expire_old, reload_old;
565 __int64 usecs;
566 CRITICAL_SECTION *crit;
568 if (disable_itimers)
569 return -1;
571 /* Posix systems expect timer values smaller than the resolution of
572 the system clock be rounded up to the clock resolution. First
573 time we are called, measure the clock tick resolution. */
574 if (!clocks_min)
576 clock_t t1, t2;
578 for (t1 = clock (); (t2 = clock ()) == t1; )
580 clocks_min = t2 - t1;
583 if (ovalue)
585 if (getitimer (which, ovalue)) /* also sets ticks_now */
586 return -1; /* errno already set */
588 else
589 ticks_now = clock ();
591 if (which != ITIMER_REAL && which != ITIMER_PROF)
593 errno = EINVAL;
594 return -1;
597 t_expire =
598 (which == ITIMER_REAL) ? &real_itimer.expire : &prof_itimer.expire;
599 t_reload =
600 (which == ITIMER_REAL) ? &real_itimer.reload : &prof_itimer.reload;
602 crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
604 if (!value
605 || (value->it_value.tv_sec == 0 && value->it_value.tv_usec == 0))
607 EnterCriticalSection (crit);
608 /* Disable the timer. */
609 *t_expire = 0;
610 *t_reload = 0;
611 LeaveCriticalSection (crit);
612 return 0;
615 reload = value->it_interval.tv_sec * CLOCKS_PER_SEC;
617 usecs = value->it_interval.tv_usec;
618 if (value->it_interval.tv_sec == 0
619 && usecs && usecs * CLOCKS_PER_SEC < clocks_min * 1000000)
620 reload = clocks_min;
621 else
623 usecs *= CLOCKS_PER_SEC;
624 reload += usecs / 1000000;
627 expire = value->it_value.tv_sec * CLOCKS_PER_SEC;
628 usecs = value->it_value.tv_usec;
629 if (value->it_value.tv_sec == 0
630 && usecs * CLOCKS_PER_SEC < clocks_min * 1000000)
631 expire = clocks_min;
632 else
634 usecs *= CLOCKS_PER_SEC;
635 expire += usecs / 1000000;
638 expire += ticks_now;
640 EnterCriticalSection (crit);
641 expire_old = *t_expire;
642 reload_old = *t_reload;
643 if (!(expire == expire_old && reload == reload_old))
645 *t_reload = reload;
646 *t_expire = expire;
648 LeaveCriticalSection (crit);
650 return start_timer_thread (which);
654 alarm (int seconds)
656 #ifdef HAVE_SETITIMER
657 struct itimerval new_values, old_values;
659 new_values.it_value.tv_sec = seconds;
660 new_values.it_value.tv_usec = 0;
661 new_values.it_interval.tv_sec = new_values.it_interval.tv_usec = 0;
663 if (setitimer (ITIMER_REAL, &new_values, &old_values) < 0)
664 return 0;
665 return old_values.it_value.tv_sec;
666 #else
667 return seconds;
668 #endif
671 /* Defined in <process.h> which conflicts with the local copy */
672 #define _P_NOWAIT 1
674 /* Child process management list. */
675 int child_proc_count = 0;
676 child_process child_procs[ MAX_CHILDREN ];
677 child_process *dead_child = NULL;
679 static DWORD WINAPI reader_thread (void *arg);
681 /* Find an unused process slot. */
682 child_process *
683 new_child (void)
685 child_process *cp;
686 DWORD id;
688 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
689 if (!CHILD_ACTIVE (cp))
690 goto Initialize;
691 if (child_proc_count == MAX_CHILDREN)
692 return NULL;
693 cp = &child_procs[child_proc_count++];
695 Initialize:
696 memset (cp, 0, sizeof (*cp));
697 cp->fd = -1;
698 cp->pid = -1;
699 cp->procinfo.hProcess = NULL;
700 cp->status = STATUS_READ_ERROR;
702 /* use manual reset event so that select() will function properly */
703 cp->char_avail = CreateEvent (NULL, TRUE, FALSE, NULL);
704 if (cp->char_avail)
706 cp->char_consumed = CreateEvent (NULL, FALSE, FALSE, NULL);
707 if (cp->char_consumed)
709 /* The 0x00010000 flag is STACK_SIZE_PARAM_IS_A_RESERVATION.
710 It means that the 64K stack we are requesting in the 2nd
711 argument is how much memory should be reserved for the
712 stack. If we don't use this flag, the memory requested
713 by the 2nd argument is the amount actually _committed_,
714 but Windows reserves 8MB of memory for each thread's
715 stack. (The 8MB figure comes from the -stack
716 command-line argument we pass to the linker when building
717 Emacs, but that's because we need a large stack for
718 Emacs's main thread.) Since we request 2GB of reserved
719 memory at startup (see w32heap.c), which is close to the
720 maximum memory available for a 32-bit process on Windows,
721 the 8MB reservation for each thread causes failures in
722 starting subprocesses, because we create a thread running
723 reader_thread for each subprocess. As 8MB of stack is
724 way too much for reader_thread, forcing Windows to
725 reserve less wins the day. */
726 cp->thrd = CreateThread (NULL, 64 * 1024, reader_thread, cp,
727 0x00010000, &id);
728 if (cp->thrd)
729 return cp;
732 delete_child (cp);
733 return NULL;
736 void
737 delete_child (child_process *cp)
739 int i;
741 /* Should not be deleting a child that is still needed. */
742 for (i = 0; i < MAXDESC; i++)
743 if (fd_info[i].cp == cp)
744 emacs_abort ();
746 if (!CHILD_ACTIVE (cp))
747 return;
749 /* reap thread if necessary */
750 if (cp->thrd)
752 DWORD rc;
754 if (GetExitCodeThread (cp->thrd, &rc) && rc == STILL_ACTIVE)
756 /* let the thread exit cleanly if possible */
757 cp->status = STATUS_READ_ERROR;
758 SetEvent (cp->char_consumed);
759 #if 0
760 /* We used to forcibly terminate the thread here, but it
761 is normally unnecessary, and in abnormal cases, the worst that
762 will happen is we have an extra idle thread hanging around
763 waiting for the zombie process. */
764 if (WaitForSingleObject (cp->thrd, 1000) != WAIT_OBJECT_0)
766 DebPrint (("delete_child.WaitForSingleObject (thread) failed "
767 "with %lu for fd %ld\n", GetLastError (), cp->fd));
768 TerminateThread (cp->thrd, 0);
770 #endif
772 CloseHandle (cp->thrd);
773 cp->thrd = NULL;
775 if (cp->char_avail)
777 CloseHandle (cp->char_avail);
778 cp->char_avail = NULL;
780 if (cp->char_consumed)
782 CloseHandle (cp->char_consumed);
783 cp->char_consumed = NULL;
786 /* update child_proc_count (highest numbered slot in use plus one) */
787 if (cp == child_procs + child_proc_count - 1)
789 for (i = child_proc_count-1; i >= 0; i--)
790 if (CHILD_ACTIVE (&child_procs[i]))
792 child_proc_count = i + 1;
793 break;
796 if (i < 0)
797 child_proc_count = 0;
800 /* Find a child by pid. */
801 static child_process *
802 find_child_pid (DWORD pid)
804 child_process *cp;
806 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
807 if (CHILD_ACTIVE (cp) && pid == cp->pid)
808 return cp;
809 return NULL;
813 /* Thread proc for child process and socket reader threads. Each thread
814 is normally blocked until woken by select() to check for input by
815 reading one char. When the read completes, char_avail is signaled
816 to wake up the select emulator and the thread blocks itself again. */
817 static DWORD WINAPI
818 reader_thread (void *arg)
820 child_process *cp;
822 /* Our identity */
823 cp = (child_process *)arg;
825 /* We have to wait for the go-ahead before we can start */
826 if (cp == NULL
827 || WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0
828 || cp->fd < 0)
829 return 1;
831 for (;;)
833 int rc;
835 if (fd_info[cp->fd].flags & FILE_LISTEN)
836 rc = _sys_wait_accept (cp->fd);
837 else
838 rc = _sys_read_ahead (cp->fd);
840 /* The name char_avail is a misnomer - it really just means the
841 read-ahead has completed, whether successfully or not. */
842 if (!SetEvent (cp->char_avail))
844 DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld\n",
845 GetLastError (), cp->fd));
846 return 1;
849 if (rc == STATUS_READ_ERROR)
850 return 1;
852 /* If the read died, the child has died so let the thread die */
853 if (rc == STATUS_READ_FAILED)
854 break;
856 /* Wait until our input is acknowledged before reading again */
857 if (WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0)
859 DebPrint (("reader_thread.WaitForSingleObject failed with "
860 "%lu for fd %ld\n", GetLastError (), cp->fd));
861 break;
864 return 0;
867 /* To avoid Emacs changing directory, we just record here the directory
868 the new process should start in. This is set just before calling
869 sys_spawnve, and is not generally valid at any other time. */
870 static char * process_dir;
872 static BOOL
873 create_child (char *exe, char *cmdline, char *env, int is_gui_app,
874 int * pPid, child_process *cp)
876 STARTUPINFO start;
877 SECURITY_ATTRIBUTES sec_attrs;
878 #if 0
879 SECURITY_DESCRIPTOR sec_desc;
880 #endif
881 DWORD flags;
882 char dir[ MAXPATHLEN ];
884 if (cp == NULL) emacs_abort ();
886 memset (&start, 0, sizeof (start));
887 start.cb = sizeof (start);
889 #ifdef HAVE_NTGUI
890 if (NILP (Vw32_start_process_show_window) && !is_gui_app)
891 start.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW;
892 else
893 start.dwFlags = STARTF_USESTDHANDLES;
894 start.wShowWindow = SW_HIDE;
896 start.hStdInput = GetStdHandle (STD_INPUT_HANDLE);
897 start.hStdOutput = GetStdHandle (STD_OUTPUT_HANDLE);
898 start.hStdError = GetStdHandle (STD_ERROR_HANDLE);
899 #endif /* HAVE_NTGUI */
901 #if 0
902 /* Explicitly specify no security */
903 if (!InitializeSecurityDescriptor (&sec_desc, SECURITY_DESCRIPTOR_REVISION))
904 goto EH_Fail;
905 if (!SetSecurityDescriptorDacl (&sec_desc, TRUE, NULL, FALSE))
906 goto EH_Fail;
907 #endif
908 sec_attrs.nLength = sizeof (sec_attrs);
909 sec_attrs.lpSecurityDescriptor = NULL /* &sec_desc */;
910 sec_attrs.bInheritHandle = FALSE;
912 strcpy (dir, process_dir);
913 unixtodos_filename (dir);
915 flags = (!NILP (Vw32_start_process_share_console)
916 ? CREATE_NEW_PROCESS_GROUP
917 : CREATE_NEW_CONSOLE);
918 if (NILP (Vw32_start_process_inherit_error_mode))
919 flags |= CREATE_DEFAULT_ERROR_MODE;
920 if (!CreateProcess (exe, cmdline, &sec_attrs, NULL, TRUE,
921 flags, env, dir, &start, &cp->procinfo))
922 goto EH_Fail;
924 cp->pid = (int) cp->procinfo.dwProcessId;
926 /* Hack for Windows 95, which assigns large (ie negative) pids */
927 if (cp->pid < 0)
928 cp->pid = -cp->pid;
930 /* pid must fit in a Lisp_Int */
931 cp->pid = cp->pid & INTMASK;
933 *pPid = cp->pid;
935 return TRUE;
937 EH_Fail:
938 DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError ()););
939 return FALSE;
942 /* create_child doesn't know what emacs' file handle will be for waiting
943 on output from the child, so we need to make this additional call
944 to register the handle with the process
945 This way the select emulator knows how to match file handles with
946 entries in child_procs. */
947 void
948 register_child (int pid, int fd)
950 child_process *cp;
952 cp = find_child_pid (pid);
953 if (cp == NULL)
955 DebPrint (("register_child unable to find pid %lu\n", pid));
956 return;
959 #ifdef FULL_DEBUG
960 DebPrint (("register_child registered fd %d with pid %lu\n", fd, pid));
961 #endif
963 cp->fd = fd;
965 /* thread is initially blocked until select is called; set status so
966 that select will release thread */
967 cp->status = STATUS_READ_ACKNOWLEDGED;
969 /* attach child_process to fd_info */
970 if (fd_info[fd].cp != NULL)
972 DebPrint (("register_child: fd_info[%d] apparently in use!\n", fd));
973 emacs_abort ();
976 fd_info[fd].cp = cp;
979 /* When a process dies its pipe will break so the reader thread will
980 signal failure to the select emulator.
981 The select emulator then calls this routine to clean up.
982 Since the thread signaled failure we can assume it is exiting. */
983 static void
984 reap_subprocess (child_process *cp)
986 if (cp->procinfo.hProcess)
988 /* Reap the process */
989 #ifdef FULL_DEBUG
990 /* Process should have already died before we are called. */
991 if (WaitForSingleObject (cp->procinfo.hProcess, 0) != WAIT_OBJECT_0)
992 DebPrint (("reap_subprocess: child fpr fd %d has not died yet!", cp->fd));
993 #endif
994 CloseHandle (cp->procinfo.hProcess);
995 cp->procinfo.hProcess = NULL;
996 CloseHandle (cp->procinfo.hThread);
997 cp->procinfo.hThread = NULL;
1000 /* For asynchronous children, the child_proc resources will be freed
1001 when the last pipe read descriptor is closed; for synchronous
1002 children, we must explicitly free the resources now because
1003 register_child has not been called. */
1004 if (cp->fd == -1)
1005 delete_child (cp);
1008 /* Wait for any of our existing child processes to die
1009 When it does, close its handle
1010 Return the pid and fill in the status if non-NULL. */
1013 sys_wait (int *status)
1015 DWORD active, retval;
1016 int nh;
1017 int pid;
1018 child_process *cp, *cps[MAX_CHILDREN];
1019 HANDLE wait_hnd[MAX_CHILDREN];
1021 nh = 0;
1022 if (dead_child != NULL)
1024 /* We want to wait for a specific child */
1025 wait_hnd[nh] = dead_child->procinfo.hProcess;
1026 cps[nh] = dead_child;
1027 if (!wait_hnd[nh]) emacs_abort ();
1028 nh++;
1029 active = 0;
1030 goto get_result;
1032 else
1034 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
1035 /* some child_procs might be sockets; ignore them */
1036 if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess
1037 && (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0))
1039 wait_hnd[nh] = cp->procinfo.hProcess;
1040 cps[nh] = cp;
1041 nh++;
1045 if (nh == 0)
1047 /* Nothing to wait on, so fail */
1048 errno = ECHILD;
1049 return -1;
1054 /* Check for quit about once a second. */
1055 QUIT;
1056 active = WaitForMultipleObjects (nh, wait_hnd, FALSE, 1000);
1057 } while (active == WAIT_TIMEOUT);
1059 if (active == WAIT_FAILED)
1061 errno = EBADF;
1062 return -1;
1064 else if (active >= WAIT_OBJECT_0
1065 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
1067 active -= WAIT_OBJECT_0;
1069 else if (active >= WAIT_ABANDONED_0
1070 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
1072 active -= WAIT_ABANDONED_0;
1074 else
1075 emacs_abort ();
1077 get_result:
1078 if (!GetExitCodeProcess (wait_hnd[active], &retval))
1080 DebPrint (("Wait.GetExitCodeProcess failed with %lu\n",
1081 GetLastError ()));
1082 retval = 1;
1084 if (retval == STILL_ACTIVE)
1086 /* Should never happen */
1087 DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
1088 errno = EINVAL;
1089 return -1;
1092 /* Massage the exit code from the process to match the format expected
1093 by the WIFSTOPPED et al macros in syswait.h. Only WIFSIGNALED and
1094 WIFEXITED are supported; WIFSTOPPED doesn't make sense under NT. */
1096 if (retval == STATUS_CONTROL_C_EXIT)
1097 retval = SIGINT;
1098 else
1099 retval <<= 8;
1101 cp = cps[active];
1102 pid = cp->pid;
1103 #ifdef FULL_DEBUG
1104 DebPrint (("Wait signaled with process pid %d\n", cp->pid));
1105 #endif
1107 if (status)
1109 *status = retval;
1111 else if (synch_process_alive)
1113 synch_process_alive = 0;
1115 /* Report the status of the synchronous process. */
1116 if (WIFEXITED (retval))
1117 synch_process_retcode = WEXITSTATUS (retval);
1118 else if (WIFSIGNALED (retval))
1120 int code = WTERMSIG (retval);
1121 const char *signame;
1123 synchronize_system_messages_locale ();
1124 signame = strsignal (code);
1126 if (signame == 0)
1127 signame = "unknown";
1129 synch_process_death = signame;
1132 reap_subprocess (cp);
1135 reap_subprocess (cp);
1137 return pid;
1140 /* Old versions of w32api headers don't have separate 32-bit and
1141 64-bit defines, but the one they have matches the 32-bit variety. */
1142 #ifndef IMAGE_NT_OPTIONAL_HDR32_MAGIC
1143 # define IMAGE_NT_OPTIONAL_HDR32_MAGIC IMAGE_NT_OPTIONAL_HDR_MAGIC
1144 # define IMAGE_OPTIONAL_HEADER32 IMAGE_OPTIONAL_HEADER
1145 #endif
1147 static void
1148 w32_executable_type (char * filename,
1149 int * is_dos_app,
1150 int * is_cygnus_app,
1151 int * is_gui_app)
1153 file_data executable;
1154 char * p;
1156 /* Default values in case we can't tell for sure. */
1157 *is_dos_app = FALSE;
1158 *is_cygnus_app = FALSE;
1159 *is_gui_app = FALSE;
1161 if (!open_input_file (&executable, filename))
1162 return;
1164 p = strrchr (filename, '.');
1166 /* We can only identify DOS .com programs from the extension. */
1167 if (p && xstrcasecmp (p, ".com") == 0)
1168 *is_dos_app = TRUE;
1169 else if (p && (xstrcasecmp (p, ".bat") == 0
1170 || xstrcasecmp (p, ".cmd") == 0))
1172 /* A DOS shell script - it appears that CreateProcess is happy to
1173 accept this (somewhat surprisingly); presumably it looks at
1174 COMSPEC to determine what executable to actually invoke.
1175 Therefore, we have to do the same here as well. */
1176 /* Actually, I think it uses the program association for that
1177 extension, which is defined in the registry. */
1178 p = egetenv ("COMSPEC");
1179 if (p)
1180 w32_executable_type (p, is_dos_app, is_cygnus_app, is_gui_app);
1182 else
1184 /* Look for DOS .exe signature - if found, we must also check that
1185 it isn't really a 16- or 32-bit Windows exe, since both formats
1186 start with a DOS program stub. Note that 16-bit Windows
1187 executables use the OS/2 1.x format. */
1189 IMAGE_DOS_HEADER * dos_header;
1190 IMAGE_NT_HEADERS * nt_header;
1192 dos_header = (PIMAGE_DOS_HEADER) executable.file_base;
1193 if (dos_header->e_magic != IMAGE_DOS_SIGNATURE)
1194 goto unwind;
1196 nt_header = (PIMAGE_NT_HEADERS) ((unsigned char *) dos_header + dos_header->e_lfanew);
1198 if ((char *) nt_header > (char *) dos_header + executable.size)
1200 /* Some dos headers (pkunzip) have bogus e_lfanew fields. */
1201 *is_dos_app = TRUE;
1203 else if (nt_header->Signature != IMAGE_NT_SIGNATURE
1204 && LOWORD (nt_header->Signature) != IMAGE_OS2_SIGNATURE)
1206 *is_dos_app = TRUE;
1208 else if (nt_header->Signature == IMAGE_NT_SIGNATURE)
1210 IMAGE_DATA_DIRECTORY *data_dir = NULL;
1211 if (nt_header->OptionalHeader.Magic == IMAGE_NT_OPTIONAL_HDR32_MAGIC)
1213 /* Ensure we are using the 32 bit structure. */
1214 IMAGE_OPTIONAL_HEADER32 *opt
1215 = (IMAGE_OPTIONAL_HEADER32*) &(nt_header->OptionalHeader);
1216 data_dir = opt->DataDirectory;
1217 *is_gui_app = (opt->Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
1219 /* MingW 3.12 has the required 64 bit structs, but in case older
1220 versions don't, only check 64 bit exes if we know how. */
1221 #ifdef IMAGE_NT_OPTIONAL_HDR64_MAGIC
1222 else if (nt_header->OptionalHeader.Magic
1223 == IMAGE_NT_OPTIONAL_HDR64_MAGIC)
1225 IMAGE_OPTIONAL_HEADER64 *opt
1226 = (IMAGE_OPTIONAL_HEADER64*) &(nt_header->OptionalHeader);
1227 data_dir = opt->DataDirectory;
1228 *is_gui_app = (opt->Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
1230 #endif
1231 if (data_dir)
1233 /* Look for cygwin.dll in DLL import list. */
1234 IMAGE_DATA_DIRECTORY import_dir =
1235 data_dir[IMAGE_DIRECTORY_ENTRY_IMPORT];
1236 IMAGE_IMPORT_DESCRIPTOR * imports;
1237 IMAGE_SECTION_HEADER * section;
1239 section = rva_to_section (import_dir.VirtualAddress, nt_header);
1240 imports = RVA_TO_PTR (import_dir.VirtualAddress, section,
1241 executable);
1243 for ( ; imports->Name; imports++)
1245 char * dllname = RVA_TO_PTR (imports->Name, section,
1246 executable);
1248 /* The exact name of the cygwin dll has changed with
1249 various releases, but hopefully this will be reasonably
1250 future proof. */
1251 if (strncmp (dllname, "cygwin", 6) == 0)
1253 *is_cygnus_app = TRUE;
1254 break;
1261 unwind:
1262 close_file_data (&executable);
1265 static int
1266 compare_env (const void *strp1, const void *strp2)
1268 const char *str1 = *(const char **)strp1, *str2 = *(const char **)strp2;
1270 while (*str1 && *str2 && *str1 != '=' && *str2 != '=')
1272 /* Sort order in command.com/cmd.exe is based on uppercasing
1273 names, so do the same here. */
1274 if (toupper (*str1) > toupper (*str2))
1275 return 1;
1276 else if (toupper (*str1) < toupper (*str2))
1277 return -1;
1278 str1++, str2++;
1281 if (*str1 == '=' && *str2 == '=')
1282 return 0;
1283 else if (*str1 == '=')
1284 return -1;
1285 else
1286 return 1;
1289 static void
1290 merge_and_sort_env (char **envp1, char **envp2, char **new_envp)
1292 char **optr, **nptr;
1293 int num;
1295 nptr = new_envp;
1296 optr = envp1;
1297 while (*optr)
1298 *nptr++ = *optr++;
1299 num = optr - envp1;
1301 optr = envp2;
1302 while (*optr)
1303 *nptr++ = *optr++;
1304 num += optr - envp2;
1306 qsort (new_envp, num, sizeof (char *), compare_env);
1308 *nptr = NULL;
1311 /* When a new child process is created we need to register it in our list,
1312 so intercept spawn requests. */
1314 sys_spawnve (int mode, char *cmdname, char **argv, char **envp)
1316 Lisp_Object program, full;
1317 char *cmdline, *env, *parg, **targ;
1318 int arglen, numenv;
1319 int pid;
1320 child_process *cp;
1321 int is_dos_app, is_cygnus_app, is_gui_app;
1322 int do_quoting = 0;
1323 char escape_char;
1324 /* We pass our process ID to our children by setting up an environment
1325 variable in their environment. */
1326 char ppid_env_var_buffer[64];
1327 char *extra_env[] = {ppid_env_var_buffer, NULL};
1328 /* These are the characters that cause an argument to need quoting.
1329 Arguments with whitespace characters need quoting to prevent the
1330 argument being split into two or more. Arguments with wildcards
1331 are also quoted, for consistency with posix platforms, where wildcards
1332 are not expanded if we run the program directly without a shell.
1333 Some extra whitespace characters need quoting in Cygwin programs,
1334 so this list is conditionally modified below. */
1335 char *sepchars = " \t*?";
1337 /* We don't care about the other modes */
1338 if (mode != _P_NOWAIT)
1340 errno = EINVAL;
1341 return -1;
1344 /* Handle executable names without an executable suffix. */
1345 program = build_string (cmdname);
1346 if (NILP (Ffile_executable_p (program)))
1348 struct gcpro gcpro1;
1350 full = Qnil;
1351 GCPRO1 (program);
1352 openp (Vexec_path, program, Vexec_suffixes, &full, make_number (X_OK));
1353 UNGCPRO;
1354 if (NILP (full))
1356 errno = EINVAL;
1357 return -1;
1359 program = full;
1362 /* make sure argv[0] and cmdname are both in DOS format */
1363 cmdname = SDATA (program);
1364 unixtodos_filename (cmdname);
1365 argv[0] = cmdname;
1367 /* Determine whether program is a 16-bit DOS executable, or a 32-bit Windows
1368 executable that is implicitly linked to the Cygnus dll (implying it
1369 was compiled with the Cygnus GNU toolchain and hence relies on
1370 cygwin.dll to parse the command line - we use this to decide how to
1371 escape quote chars in command line args that must be quoted).
1373 Also determine whether it is a GUI app, so that we don't hide its
1374 initial window unless specifically requested. */
1375 w32_executable_type (cmdname, &is_dos_app, &is_cygnus_app, &is_gui_app);
1377 /* On Windows 95, if cmdname is a DOS app, we invoke a helper
1378 application to start it by specifying the helper app as cmdname,
1379 while leaving the real app name as argv[0]. */
1380 if (is_dos_app)
1382 cmdname = alloca (MAXPATHLEN);
1383 if (egetenv ("CMDPROXY"))
1384 strcpy (cmdname, egetenv ("CMDPROXY"));
1385 else
1387 strcpy (cmdname, SDATA (Vinvocation_directory));
1388 strcat (cmdname, "cmdproxy.exe");
1390 unixtodos_filename (cmdname);
1393 /* we have to do some conjuring here to put argv and envp into the
1394 form CreateProcess wants... argv needs to be a space separated/null
1395 terminated list of parameters, and envp is a null
1396 separated/double-null terminated list of parameters.
1398 Additionally, zero-length args and args containing whitespace or
1399 quote chars need to be wrapped in double quotes - for this to work,
1400 embedded quotes need to be escaped as well. The aim is to ensure
1401 the child process reconstructs the argv array we start with
1402 exactly, so we treat quotes at the beginning and end of arguments
1403 as embedded quotes.
1405 The w32 GNU-based library from Cygnus doubles quotes to escape
1406 them, while MSVC uses backslash for escaping. (Actually the MSVC
1407 startup code does attempt to recognize doubled quotes and accept
1408 them, but gets it wrong and ends up requiring three quotes to get a
1409 single embedded quote!) So by default we decide whether to use
1410 quote or backslash as the escape character based on whether the
1411 binary is apparently a Cygnus compiled app.
1413 Note that using backslash to escape embedded quotes requires
1414 additional special handling if an embedded quote is already
1415 preceded by backslash, or if an arg requiring quoting ends with
1416 backslash. In such cases, the run of escape characters needs to be
1417 doubled. For consistency, we apply this special handling as long
1418 as the escape character is not quote.
1420 Since we have no idea how large argv and envp are likely to be we
1421 figure out list lengths on the fly and allocate them. */
1423 if (!NILP (Vw32_quote_process_args))
1425 do_quoting = 1;
1426 /* Override escape char by binding w32-quote-process-args to
1427 desired character, or use t for auto-selection. */
1428 if (INTEGERP (Vw32_quote_process_args))
1429 escape_char = XINT (Vw32_quote_process_args);
1430 else
1431 escape_char = is_cygnus_app ? '"' : '\\';
1434 /* Cygwin apps needs quoting a bit more often. */
1435 if (escape_char == '"')
1436 sepchars = "\r\n\t\f '";
1438 /* do argv... */
1439 arglen = 0;
1440 targ = argv;
1441 while (*targ)
1443 char * p = *targ;
1444 int need_quotes = 0;
1445 int escape_char_run = 0;
1447 if (*p == 0)
1448 need_quotes = 1;
1449 for ( ; *p; p++)
1451 if (escape_char == '"' && *p == '\\')
1452 /* If it's a Cygwin app, \ needs to be escaped. */
1453 arglen++;
1454 else if (*p == '"')
1456 /* allow for embedded quotes to be escaped */
1457 arglen++;
1458 need_quotes = 1;
1459 /* handle the case where the embedded quote is already escaped */
1460 if (escape_char_run > 0)
1462 /* To preserve the arg exactly, we need to double the
1463 preceding escape characters (plus adding one to
1464 escape the quote character itself). */
1465 arglen += escape_char_run;
1468 else if (strchr (sepchars, *p) != NULL)
1470 need_quotes = 1;
1473 if (*p == escape_char && escape_char != '"')
1474 escape_char_run++;
1475 else
1476 escape_char_run = 0;
1478 if (need_quotes)
1480 arglen += 2;
1481 /* handle the case where the arg ends with an escape char - we
1482 must not let the enclosing quote be escaped. */
1483 if (escape_char_run > 0)
1484 arglen += escape_char_run;
1486 arglen += strlen (*targ++) + 1;
1488 cmdline = alloca (arglen);
1489 targ = argv;
1490 parg = cmdline;
1491 while (*targ)
1493 char * p = *targ;
1494 int need_quotes = 0;
1496 if (*p == 0)
1497 need_quotes = 1;
1499 if (do_quoting)
1501 for ( ; *p; p++)
1502 if ((strchr (sepchars, *p) != NULL) || *p == '"')
1503 need_quotes = 1;
1505 if (need_quotes)
1507 int escape_char_run = 0;
1508 char * first;
1509 char * last;
1511 p = *targ;
1512 first = p;
1513 last = p + strlen (p) - 1;
1514 *parg++ = '"';
1515 #if 0
1516 /* This version does not escape quotes if they occur at the
1517 beginning or end of the arg - this could lead to incorrect
1518 behavior when the arg itself represents a command line
1519 containing quoted args. I believe this was originally done
1520 as a hack to make some things work, before
1521 `w32-quote-process-args' was added. */
1522 while (*p)
1524 if (*p == '"' && p > first && p < last)
1525 *parg++ = escape_char; /* escape embedded quotes */
1526 *parg++ = *p++;
1528 #else
1529 for ( ; *p; p++)
1531 if (*p == '"')
1533 /* double preceding escape chars if any */
1534 while (escape_char_run > 0)
1536 *parg++ = escape_char;
1537 escape_char_run--;
1539 /* escape all quote chars, even at beginning or end */
1540 *parg++ = escape_char;
1542 else if (escape_char == '"' && *p == '\\')
1543 *parg++ = '\\';
1544 *parg++ = *p;
1546 if (*p == escape_char && escape_char != '"')
1547 escape_char_run++;
1548 else
1549 escape_char_run = 0;
1551 /* double escape chars before enclosing quote */
1552 while (escape_char_run > 0)
1554 *parg++ = escape_char;
1555 escape_char_run--;
1557 #endif
1558 *parg++ = '"';
1560 else
1562 strcpy (parg, *targ);
1563 parg += strlen (*targ);
1565 *parg++ = ' ';
1566 targ++;
1568 *--parg = '\0';
1570 /* and envp... */
1571 arglen = 1;
1572 targ = envp;
1573 numenv = 1; /* for end null */
1574 while (*targ)
1576 arglen += strlen (*targ++) + 1;
1577 numenv++;
1579 /* extra env vars... */
1580 sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d",
1581 GetCurrentProcessId ());
1582 arglen += strlen (ppid_env_var_buffer) + 1;
1583 numenv++;
1585 /* merge env passed in and extra env into one, and sort it. */
1586 targ = (char **) alloca (numenv * sizeof (char *));
1587 merge_and_sort_env (envp, extra_env, targ);
1589 /* concatenate env entries. */
1590 env = alloca (arglen);
1591 parg = env;
1592 while (*targ)
1594 strcpy (parg, *targ);
1595 parg += strlen (*targ++);
1596 *parg++ = '\0';
1598 *parg++ = '\0';
1599 *parg = '\0';
1601 cp = new_child ();
1602 if (cp == NULL)
1604 errno = EAGAIN;
1605 return -1;
1608 /* Now create the process. */
1609 if (!create_child (cmdname, cmdline, env, is_gui_app, &pid, cp))
1611 delete_child (cp);
1612 errno = ENOEXEC;
1613 return -1;
1616 return pid;
1619 /* Emulate the select call
1620 Wait for available input on any of the given rfds, or timeout if
1621 a timeout is given and no input is detected
1622 wfds and efds are not supported and must be NULL.
1624 For simplicity, we detect the death of child processes here and
1625 synchronously call the SIGCHLD handler. Since it is possible for
1626 children to be created without a corresponding pipe handle from which
1627 to read output, we wait separately on the process handles as well as
1628 the char_avail events for each process pipe. We only call
1629 wait/reap_process when the process actually terminates.
1631 To reduce the number of places in which Emacs can be hung such that
1632 C-g is not able to interrupt it, we always wait on interrupt_handle
1633 (which is signaled by the input thread when C-g is detected). If we
1634 detect that we were woken up by C-g, we return -1 with errno set to
1635 EINTR as on Unix. */
1637 /* From w32console.c */
1638 extern HANDLE keyboard_handle;
1640 /* From w32xfns.c */
1641 extern HANDLE interrupt_handle;
1643 /* From process.c */
1644 extern int proc_buffered_char[];
1647 sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
1648 EMACS_TIME *timeout, void *ignored)
1650 SELECT_TYPE orfds;
1651 DWORD timeout_ms, start_time;
1652 int i, nh, nc, nr;
1653 DWORD active;
1654 child_process *cp, *cps[MAX_CHILDREN];
1655 HANDLE wait_hnd[MAXDESC + MAX_CHILDREN];
1656 int fdindex[MAXDESC]; /* mapping from wait handles back to descriptors */
1658 timeout_ms =
1659 timeout ? (timeout->tv_sec * 1000 + timeout->tv_nsec / 1000000) : INFINITE;
1661 /* If the descriptor sets are NULL but timeout isn't, then just Sleep. */
1662 if (rfds == NULL && wfds == NULL && efds == NULL && timeout != NULL)
1664 Sleep (timeout_ms);
1665 return 0;
1668 /* Otherwise, we only handle rfds, so fail otherwise. */
1669 if (rfds == NULL || wfds != NULL || efds != NULL)
1671 errno = EINVAL;
1672 return -1;
1675 orfds = *rfds;
1676 FD_ZERO (rfds);
1677 nr = 0;
1679 /* Always wait on interrupt_handle, to detect C-g (quit). */
1680 wait_hnd[0] = interrupt_handle;
1681 fdindex[0] = -1;
1683 /* Build a list of pipe handles to wait on. */
1684 nh = 1;
1685 for (i = 0; i < nfds; i++)
1686 if (FD_ISSET (i, &orfds))
1688 if (i == 0)
1690 if (keyboard_handle)
1692 /* Handle stdin specially */
1693 wait_hnd[nh] = keyboard_handle;
1694 fdindex[nh] = i;
1695 nh++;
1698 /* Check for any emacs-generated input in the queue since
1699 it won't be detected in the wait */
1700 if (detect_input_pending ())
1702 FD_SET (i, rfds);
1703 return 1;
1706 else
1708 /* Child process and socket input */
1709 cp = fd_info[i].cp;
1710 if (cp)
1712 int current_status = cp->status;
1714 if (current_status == STATUS_READ_ACKNOWLEDGED)
1716 /* Tell reader thread which file handle to use. */
1717 cp->fd = i;
1718 /* Wake up the reader thread for this process */
1719 cp->status = STATUS_READ_READY;
1720 if (!SetEvent (cp->char_consumed))
1721 DebPrint (("nt_select.SetEvent failed with "
1722 "%lu for fd %ld\n", GetLastError (), i));
1725 #ifdef CHECK_INTERLOCK
1726 /* slightly crude cross-checking of interlock between threads */
1728 current_status = cp->status;
1729 if (WaitForSingleObject (cp->char_avail, 0) == WAIT_OBJECT_0)
1731 /* char_avail has been signaled, so status (which may
1732 have changed) should indicate read has completed
1733 but has not been acknowledged. */
1734 current_status = cp->status;
1735 if (current_status != STATUS_READ_SUCCEEDED
1736 && current_status != STATUS_READ_FAILED)
1737 DebPrint (("char_avail set, but read not completed: status %d\n",
1738 current_status));
1740 else
1742 /* char_avail has not been signaled, so status should
1743 indicate that read is in progress; small possibility
1744 that read has completed but event wasn't yet signaled
1745 when we tested it (because a context switch occurred
1746 or if running on separate CPUs). */
1747 if (current_status != STATUS_READ_READY
1748 && current_status != STATUS_READ_IN_PROGRESS
1749 && current_status != STATUS_READ_SUCCEEDED
1750 && current_status != STATUS_READ_FAILED)
1751 DebPrint (("char_avail reset, but read status is bad: %d\n",
1752 current_status));
1754 #endif
1755 wait_hnd[nh] = cp->char_avail;
1756 fdindex[nh] = i;
1757 if (!wait_hnd[nh]) emacs_abort ();
1758 nh++;
1759 #ifdef FULL_DEBUG
1760 DebPrint (("select waiting on child %d fd %d\n",
1761 cp-child_procs, i));
1762 #endif
1764 else
1766 /* Unable to find something to wait on for this fd, skip */
1768 /* Note that this is not a fatal error, and can in fact
1769 happen in unusual circumstances. Specifically, if
1770 sys_spawnve fails, eg. because the program doesn't
1771 exist, and debug-on-error is t so Fsignal invokes a
1772 nested input loop, then the process output pipe is
1773 still included in input_wait_mask with no child_proc
1774 associated with it. (It is removed when the debugger
1775 exits the nested input loop and the error is thrown.) */
1777 DebPrint (("sys_select: fd %ld is invalid! ignoring\n", i));
1782 count_children:
1783 /* Add handles of child processes. */
1784 nc = 0;
1785 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
1786 /* Some child_procs might be sockets; ignore them. Also some
1787 children may have died already, but we haven't finished reading
1788 the process output; ignore them too. */
1789 if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess
1790 && (cp->fd < 0
1791 || (fd_info[cp->fd].flags & FILE_SEND_SIGCHLD) == 0
1792 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0)
1795 wait_hnd[nh + nc] = cp->procinfo.hProcess;
1796 cps[nc] = cp;
1797 nc++;
1800 /* Nothing to look for, so we didn't find anything */
1801 if (nh + nc == 0)
1803 if (timeout)
1804 Sleep (timeout_ms);
1805 return 0;
1808 start_time = GetTickCount ();
1810 /* Wait for input or child death to be signaled. If user input is
1811 allowed, then also accept window messages. */
1812 if (FD_ISSET (0, &orfds))
1813 active = MsgWaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms,
1814 QS_ALLINPUT);
1815 else
1816 active = WaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms);
1818 if (active == WAIT_FAILED)
1820 DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n",
1821 nh + nc, timeout_ms, GetLastError ()));
1822 /* don't return EBADF - this causes wait_reading_process_output to
1823 abort; WAIT_FAILED is returned when single-stepping under
1824 Windows 95 after switching thread focus in debugger, and
1825 possibly at other times. */
1826 errno = EINTR;
1827 return -1;
1829 else if (active == WAIT_TIMEOUT)
1831 return 0;
1833 else if (active >= WAIT_OBJECT_0
1834 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
1836 active -= WAIT_OBJECT_0;
1838 else if (active >= WAIT_ABANDONED_0
1839 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
1841 active -= WAIT_ABANDONED_0;
1843 else
1844 emacs_abort ();
1846 /* Loop over all handles after active (now officially documented as
1847 being the first signaled handle in the array). We do this to
1848 ensure fairness, so that all channels with data available will be
1849 processed - otherwise higher numbered channels could be starved. */
1852 if (active == nh + nc)
1854 /* There are messages in the lisp thread's queue; we must
1855 drain the queue now to ensure they are processed promptly,
1856 because if we don't do so, we will not be woken again until
1857 further messages arrive.
1859 NB. If ever we allow window message procedures to callback
1860 into lisp, we will need to ensure messages are dispatched
1861 at a safe time for lisp code to be run (*), and we may also
1862 want to provide some hooks in the dispatch loop to cater
1863 for modeless dialogs created by lisp (ie. to register
1864 window handles to pass to IsDialogMessage).
1866 (*) Note that MsgWaitForMultipleObjects above is an
1867 internal dispatch point for messages that are sent to
1868 windows created by this thread. */
1869 drain_message_queue ();
1871 else if (active >= nh)
1873 cp = cps[active - nh];
1875 /* We cannot always signal SIGCHLD immediately; if we have not
1876 finished reading the process output, we must delay sending
1877 SIGCHLD until we do. */
1879 if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_AT_EOF) == 0)
1880 fd_info[cp->fd].flags |= FILE_SEND_SIGCHLD;
1881 /* SIG_DFL for SIGCHLD is ignore */
1882 else if (sig_handlers[SIGCHLD] != SIG_DFL &&
1883 sig_handlers[SIGCHLD] != SIG_IGN)
1885 #ifdef FULL_DEBUG
1886 DebPrint (("select calling SIGCHLD handler for pid %d\n",
1887 cp->pid));
1888 #endif
1889 dead_child = cp;
1890 sig_handlers[SIGCHLD] (SIGCHLD);
1891 dead_child = NULL;
1894 else if (fdindex[active] == -1)
1896 /* Quit (C-g) was detected. */
1897 errno = EINTR;
1898 return -1;
1900 else if (fdindex[active] == 0)
1902 /* Keyboard input available */
1903 FD_SET (0, rfds);
1904 nr++;
1906 else
1908 /* must be a socket or pipe - read ahead should have
1909 completed, either succeeding or failing. */
1910 FD_SET (fdindex[active], rfds);
1911 nr++;
1914 /* Even though wait_reading_process_output only reads from at most
1915 one channel, we must process all channels here so that we reap
1916 all children that have died. */
1917 while (++active < nh + nc)
1918 if (WaitForSingleObject (wait_hnd[active], 0) == WAIT_OBJECT_0)
1919 break;
1920 } while (active < nh + nc);
1922 /* If no input has arrived and timeout hasn't expired, wait again. */
1923 if (nr == 0)
1925 DWORD elapsed = GetTickCount () - start_time;
1927 if (timeout_ms > elapsed) /* INFINITE is MAX_UINT */
1929 if (timeout_ms != INFINITE)
1930 timeout_ms -= elapsed;
1931 goto count_children;
1935 return nr;
1938 /* Substitute for certain kill () operations */
1940 static BOOL CALLBACK
1941 find_child_console (HWND hwnd, LPARAM arg)
1943 child_process * cp = (child_process *) arg;
1944 DWORD thread_id;
1945 DWORD process_id;
1947 thread_id = GetWindowThreadProcessId (hwnd, &process_id);
1948 if (process_id == cp->procinfo.dwProcessId)
1950 char window_class[32];
1952 GetClassName (hwnd, window_class, sizeof (window_class));
1953 if (strcmp (window_class,
1954 (os_subtype == OS_9X)
1955 ? "tty"
1956 : "ConsoleWindowClass") == 0)
1958 cp->hwnd = hwnd;
1959 return FALSE;
1962 /* keep looking */
1963 return TRUE;
1966 /* Emulate 'kill', but only for other processes. */
1968 sys_kill (int pid, int sig)
1970 child_process *cp;
1971 HANDLE proc_hand;
1972 int need_to_free = 0;
1973 int rc = 0;
1975 /* Only handle signals that will result in the process dying */
1976 if (sig != SIGINT && sig != SIGKILL && sig != SIGQUIT && sig != SIGHUP)
1978 errno = EINVAL;
1979 return -1;
1982 cp = find_child_pid (pid);
1983 if (cp == NULL)
1985 /* We were passed a PID of something other than our subprocess.
1986 If that is our own PID, we will send to ourself a message to
1987 close the selected frame, which does not necessarily
1988 terminates Emacs. But then we are not supposed to call
1989 sys_kill with our own PID. */
1990 proc_hand = OpenProcess (PROCESS_TERMINATE, 0, pid);
1991 if (proc_hand == NULL)
1993 errno = EPERM;
1994 return -1;
1996 need_to_free = 1;
1998 else
2000 proc_hand = cp->procinfo.hProcess;
2001 pid = cp->procinfo.dwProcessId;
2003 /* Try to locate console window for process. */
2004 EnumWindows (find_child_console, (LPARAM) cp);
2007 if (sig == SIGINT || sig == SIGQUIT)
2009 if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
2011 BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0);
2012 /* Fake Ctrl-C for SIGINT, and Ctrl-Break for SIGQUIT. */
2013 BYTE vk_break_code = (sig == SIGINT) ? 'C' : VK_CANCEL;
2014 BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
2015 HWND foreground_window;
2017 if (break_scan_code == 0)
2019 /* Fake Ctrl-C for SIGQUIT if we can't manage Ctrl-Break. */
2020 vk_break_code = 'C';
2021 break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
2024 foreground_window = GetForegroundWindow ();
2025 if (foreground_window)
2027 /* NT 5.0, and apparently also Windows 98, will not allow
2028 a Window to be set to foreground directly without the
2029 user's involvement. The workaround is to attach
2030 ourselves to the thread that owns the foreground
2031 window, since that is the only thread that can set the
2032 foreground window. */
2033 DWORD foreground_thread, child_thread;
2034 foreground_thread =
2035 GetWindowThreadProcessId (foreground_window, NULL);
2036 if (foreground_thread == GetCurrentThreadId ()
2037 || !AttachThreadInput (GetCurrentThreadId (),
2038 foreground_thread, TRUE))
2039 foreground_thread = 0;
2041 child_thread = GetWindowThreadProcessId (cp->hwnd, NULL);
2042 if (child_thread == GetCurrentThreadId ()
2043 || !AttachThreadInput (GetCurrentThreadId (),
2044 child_thread, TRUE))
2045 child_thread = 0;
2047 /* Set the foreground window to the child. */
2048 if (SetForegroundWindow (cp->hwnd))
2050 /* Generate keystrokes as if user had typed Ctrl-Break or
2051 Ctrl-C. */
2052 keybd_event (VK_CONTROL, control_scan_code, 0, 0);
2053 keybd_event (vk_break_code, break_scan_code,
2054 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0);
2055 keybd_event (vk_break_code, break_scan_code,
2056 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY)
2057 | KEYEVENTF_KEYUP, 0);
2058 keybd_event (VK_CONTROL, control_scan_code,
2059 KEYEVENTF_KEYUP, 0);
2061 /* Sleep for a bit to give time for Emacs frame to respond
2062 to focus change events (if Emacs was active app). */
2063 Sleep (100);
2065 SetForegroundWindow (foreground_window);
2067 /* Detach from the foreground and child threads now that
2068 the foreground switching is over. */
2069 if (foreground_thread)
2070 AttachThreadInput (GetCurrentThreadId (),
2071 foreground_thread, FALSE);
2072 if (child_thread)
2073 AttachThreadInput (GetCurrentThreadId (),
2074 child_thread, FALSE);
2077 /* Ctrl-Break is NT equivalent of SIGINT. */
2078 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid))
2080 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
2081 "for pid %lu\n", GetLastError (), pid));
2082 errno = EINVAL;
2083 rc = -1;
2086 else
2088 if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
2090 #if 1
2091 if (os_subtype == OS_9X)
2094 Another possibility is to try terminating the VDM out-right by
2095 calling the Shell VxD (id 0x17) V86 interface, function #4
2096 "SHELL_Destroy_VM", ie.
2098 mov edx,4
2099 mov ebx,vm_handle
2100 call shellapi
2102 First need to determine the current VM handle, and then arrange for
2103 the shellapi call to be made from the system vm (by using
2104 Switch_VM_and_callback).
2106 Could try to invoke DestroyVM through CallVxD.
2109 #if 0
2110 /* On Windows 95, posting WM_QUIT causes the 16-bit subsystem
2111 to hang when cmdproxy is used in conjunction with
2112 command.com for an interactive shell. Posting
2113 WM_CLOSE pops up a dialog that, when Yes is selected,
2114 does the same thing. TerminateProcess is also less
2115 than ideal in that subprocesses tend to stick around
2116 until the machine is shutdown, but at least it
2117 doesn't freeze the 16-bit subsystem. */
2118 PostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
2119 #endif
2120 if (!TerminateProcess (proc_hand, 0xff))
2122 DebPrint (("sys_kill.TerminateProcess returned %d "
2123 "for pid %lu\n", GetLastError (), pid));
2124 errno = EINVAL;
2125 rc = -1;
2128 else
2129 #endif
2130 PostMessage (cp->hwnd, WM_CLOSE, 0, 0);
2132 /* Kill the process. On W32 this doesn't kill child processes
2133 so it doesn't work very well for shells which is why it's not
2134 used in every case. */
2135 else if (!TerminateProcess (proc_hand, 0xff))
2137 DebPrint (("sys_kill.TerminateProcess returned %d "
2138 "for pid %lu\n", GetLastError (), pid));
2139 errno = EINVAL;
2140 rc = -1;
2144 if (need_to_free)
2145 CloseHandle (proc_hand);
2147 return rc;
2150 /* The following two routines are used to manipulate stdin, stdout, and
2151 stderr of our child processes.
2153 Assuming that in, out, and err are *not* inheritable, we make them
2154 stdin, stdout, and stderr of the child as follows:
2156 - Save the parent's current standard handles.
2157 - Set the std handles to inheritable duplicates of the ones being passed in.
2158 (Note that _get_osfhandle() is an io.h procedure that retrieves the
2159 NT file handle for a crt file descriptor.)
2160 - Spawn the child, which inherits in, out, and err as stdin,
2161 stdout, and stderr. (see Spawnve)
2162 - Close the std handles passed to the child.
2163 - Reset the parent's standard handles to the saved handles.
2164 (see reset_standard_handles)
2165 We assume that the caller closes in, out, and err after calling us. */
2167 void
2168 prepare_standard_handles (int in, int out, int err, HANDLE handles[3])
2170 HANDLE parent;
2171 HANDLE newstdin, newstdout, newstderr;
2173 parent = GetCurrentProcess ();
2175 handles[0] = GetStdHandle (STD_INPUT_HANDLE);
2176 handles[1] = GetStdHandle (STD_OUTPUT_HANDLE);
2177 handles[2] = GetStdHandle (STD_ERROR_HANDLE);
2179 /* make inheritable copies of the new handles */
2180 if (!DuplicateHandle (parent,
2181 (HANDLE) _get_osfhandle (in),
2182 parent,
2183 &newstdin,
2185 TRUE,
2186 DUPLICATE_SAME_ACCESS))
2187 report_file_error ("Duplicating input handle for child", Qnil);
2189 if (!DuplicateHandle (parent,
2190 (HANDLE) _get_osfhandle (out),
2191 parent,
2192 &newstdout,
2194 TRUE,
2195 DUPLICATE_SAME_ACCESS))
2196 report_file_error ("Duplicating output handle for child", Qnil);
2198 if (!DuplicateHandle (parent,
2199 (HANDLE) _get_osfhandle (err),
2200 parent,
2201 &newstderr,
2203 TRUE,
2204 DUPLICATE_SAME_ACCESS))
2205 report_file_error ("Duplicating error handle for child", Qnil);
2207 /* and store them as our std handles */
2208 if (!SetStdHandle (STD_INPUT_HANDLE, newstdin))
2209 report_file_error ("Changing stdin handle", Qnil);
2211 if (!SetStdHandle (STD_OUTPUT_HANDLE, newstdout))
2212 report_file_error ("Changing stdout handle", Qnil);
2214 if (!SetStdHandle (STD_ERROR_HANDLE, newstderr))
2215 report_file_error ("Changing stderr handle", Qnil);
2218 void
2219 reset_standard_handles (int in, int out, int err, HANDLE handles[3])
2221 /* close the duplicated handles passed to the child */
2222 CloseHandle (GetStdHandle (STD_INPUT_HANDLE));
2223 CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE));
2224 CloseHandle (GetStdHandle (STD_ERROR_HANDLE));
2226 /* now restore parent's saved std handles */
2227 SetStdHandle (STD_INPUT_HANDLE, handles[0]);
2228 SetStdHandle (STD_OUTPUT_HANDLE, handles[1]);
2229 SetStdHandle (STD_ERROR_HANDLE, handles[2]);
2232 void
2233 set_process_dir (char * dir)
2235 process_dir = dir;
2238 /* To avoid problems with winsock implementations that work over dial-up
2239 connections causing or requiring a connection to exist while Emacs is
2240 running, Emacs no longer automatically loads winsock on startup if it
2241 is present. Instead, it will be loaded when open-network-stream is
2242 first called.
2244 To allow full control over when winsock is loaded, we provide these
2245 two functions to dynamically load and unload winsock. This allows
2246 dial-up users to only be connected when they actually need to use
2247 socket services. */
2249 /* From w32.c */
2250 extern HANDLE winsock_lib;
2251 extern BOOL term_winsock (void);
2252 extern BOOL init_winsock (int load_now);
2254 DEFUN ("w32-has-winsock", Fw32_has_winsock, Sw32_has_winsock, 0, 1, 0,
2255 doc: /* Test for presence of the Windows socket library `winsock'.
2256 Returns non-nil if winsock support is present, nil otherwise.
2258 If the optional argument LOAD-NOW is non-nil, the winsock library is
2259 also loaded immediately if not already loaded. If winsock is loaded,
2260 the winsock local hostname is returned (since this may be different from
2261 the value of `system-name' and should supplant it), otherwise t is
2262 returned to indicate winsock support is present. */)
2263 (Lisp_Object load_now)
2265 int have_winsock;
2267 have_winsock = init_winsock (!NILP (load_now));
2268 if (have_winsock)
2270 if (winsock_lib != NULL)
2272 /* Return new value for system-name. The best way to do this
2273 is to call init_system_name, saving and restoring the
2274 original value to avoid side-effects. */
2275 Lisp_Object orig_hostname = Vsystem_name;
2276 Lisp_Object hostname;
2278 init_system_name ();
2279 hostname = Vsystem_name;
2280 Vsystem_name = orig_hostname;
2281 return hostname;
2283 return Qt;
2285 return Qnil;
2288 DEFUN ("w32-unload-winsock", Fw32_unload_winsock, Sw32_unload_winsock,
2289 0, 0, 0,
2290 doc: /* Unload the Windows socket library `winsock' if loaded.
2291 This is provided to allow dial-up socket connections to be disconnected
2292 when no longer needed. Returns nil without unloading winsock if any
2293 socket connections still exist. */)
2294 (void)
2296 return term_winsock () ? Qt : Qnil;
2300 /* Some miscellaneous functions that are Windows specific, but not GUI
2301 specific (ie. are applicable in terminal or batch mode as well). */
2303 DEFUN ("w32-short-file-name", Fw32_short_file_name, Sw32_short_file_name, 1, 1, 0,
2304 doc: /* Return the short file name version (8.3) of the full path of FILENAME.
2305 If FILENAME does not exist, return nil.
2306 All path elements in FILENAME are converted to their short names. */)
2307 (Lisp_Object filename)
2309 char shortname[MAX_PATH];
2311 CHECK_STRING (filename);
2313 /* first expand it. */
2314 filename = Fexpand_file_name (filename, Qnil);
2316 /* luckily, this returns the short version of each element in the path. */
2317 if (GetShortPathName (SDATA (ENCODE_FILE (filename)), shortname, MAX_PATH) == 0)
2318 return Qnil;
2320 dostounix_filename (shortname);
2322 return build_string (shortname);
2326 DEFUN ("w32-long-file-name", Fw32_long_file_name, Sw32_long_file_name,
2327 1, 1, 0,
2328 doc: /* Return the long file name version of the full path of FILENAME.
2329 If FILENAME does not exist, return nil.
2330 All path elements in FILENAME are converted to their long names. */)
2331 (Lisp_Object filename)
2333 char longname[ MAX_PATH ];
2334 int drive_only = 0;
2336 CHECK_STRING (filename);
2338 if (SBYTES (filename) == 2
2339 && *(SDATA (filename) + 1) == ':')
2340 drive_only = 1;
2342 /* first expand it. */
2343 filename = Fexpand_file_name (filename, Qnil);
2345 if (!w32_get_long_filename (SDATA (ENCODE_FILE (filename)), longname, MAX_PATH))
2346 return Qnil;
2348 dostounix_filename (longname);
2350 /* If we were passed only a drive, make sure that a slash is not appended
2351 for consistency with directories. Allow for drive mapping via SUBST
2352 in case expand-file-name is ever changed to expand those. */
2353 if (drive_only && longname[1] == ':' && longname[2] == '/' && !longname[3])
2354 longname[2] = '\0';
2356 return DECODE_FILE (build_string (longname));
2359 DEFUN ("w32-set-process-priority", Fw32_set_process_priority,
2360 Sw32_set_process_priority, 2, 2, 0,
2361 doc: /* Set the priority of PROCESS to PRIORITY.
2362 If PROCESS is nil, the priority of Emacs is changed, otherwise the
2363 priority of the process whose pid is PROCESS is changed.
2364 PRIORITY should be one of the symbols high, normal, or low;
2365 any other symbol will be interpreted as normal.
2367 If successful, the return value is t, otherwise nil. */)
2368 (Lisp_Object process, Lisp_Object priority)
2370 HANDLE proc_handle = GetCurrentProcess ();
2371 DWORD priority_class = NORMAL_PRIORITY_CLASS;
2372 Lisp_Object result = Qnil;
2374 CHECK_SYMBOL (priority);
2376 if (!NILP (process))
2378 DWORD pid;
2379 child_process *cp;
2381 CHECK_NUMBER (process);
2383 /* Allow pid to be an internally generated one, or one obtained
2384 externally. This is necessary because real pids on Windows 95 are
2385 negative. */
2387 pid = XINT (process);
2388 cp = find_child_pid (pid);
2389 if (cp != NULL)
2390 pid = cp->procinfo.dwProcessId;
2392 proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
2395 if (EQ (priority, Qhigh))
2396 priority_class = HIGH_PRIORITY_CLASS;
2397 else if (EQ (priority, Qlow))
2398 priority_class = IDLE_PRIORITY_CLASS;
2400 if (proc_handle != NULL)
2402 if (SetPriorityClass (proc_handle, priority_class))
2403 result = Qt;
2404 if (!NILP (process))
2405 CloseHandle (proc_handle);
2408 return result;
2411 #ifdef HAVE_LANGINFO_CODESET
2412 /* Emulation of nl_langinfo. Used in fns.c:Flocale_info. */
2413 char *
2414 nl_langinfo (nl_item item)
2416 /* Conversion of Posix item numbers to their Windows equivalents. */
2417 static const LCTYPE w32item[] = {
2418 LOCALE_IDEFAULTANSICODEPAGE,
2419 LOCALE_SDAYNAME1, LOCALE_SDAYNAME2, LOCALE_SDAYNAME3,
2420 LOCALE_SDAYNAME4, LOCALE_SDAYNAME5, LOCALE_SDAYNAME6, LOCALE_SDAYNAME7,
2421 LOCALE_SMONTHNAME1, LOCALE_SMONTHNAME2, LOCALE_SMONTHNAME3,
2422 LOCALE_SMONTHNAME4, LOCALE_SMONTHNAME5, LOCALE_SMONTHNAME6,
2423 LOCALE_SMONTHNAME7, LOCALE_SMONTHNAME8, LOCALE_SMONTHNAME9,
2424 LOCALE_SMONTHNAME10, LOCALE_SMONTHNAME11, LOCALE_SMONTHNAME12
2427 static char *nl_langinfo_buf = NULL;
2428 static int nl_langinfo_len = 0;
2430 if (nl_langinfo_len <= 0)
2431 nl_langinfo_buf = xmalloc (nl_langinfo_len = 1);
2433 if (item < 0 || item >= _NL_NUM)
2434 nl_langinfo_buf[0] = 0;
2435 else
2437 LCID cloc = GetThreadLocale ();
2438 int need_len = GetLocaleInfo (cloc, w32item[item] | LOCALE_USE_CP_ACP,
2439 NULL, 0);
2441 if (need_len <= 0)
2442 nl_langinfo_buf[0] = 0;
2443 else
2445 if (item == CODESET)
2447 need_len += 2; /* for the "cp" prefix */
2448 if (need_len < 8) /* for the case we call GetACP */
2449 need_len = 8;
2451 if (nl_langinfo_len <= need_len)
2452 nl_langinfo_buf = xrealloc (nl_langinfo_buf,
2453 nl_langinfo_len = need_len);
2454 if (!GetLocaleInfo (cloc, w32item[item] | LOCALE_USE_CP_ACP,
2455 nl_langinfo_buf, nl_langinfo_len))
2456 nl_langinfo_buf[0] = 0;
2457 else if (item == CODESET)
2459 if (strcmp (nl_langinfo_buf, "0") == 0 /* CP_ACP */
2460 || strcmp (nl_langinfo_buf, "1") == 0) /* CP_OEMCP */
2461 sprintf (nl_langinfo_buf, "cp%u", GetACP ());
2462 else
2464 memmove (nl_langinfo_buf + 2, nl_langinfo_buf,
2465 strlen (nl_langinfo_buf) + 1);
2466 nl_langinfo_buf[0] = 'c';
2467 nl_langinfo_buf[1] = 'p';
2472 return nl_langinfo_buf;
2474 #endif /* HAVE_LANGINFO_CODESET */
2476 DEFUN ("w32-get-locale-info", Fw32_get_locale_info,
2477 Sw32_get_locale_info, 1, 2, 0,
2478 doc: /* Return information about the Windows locale LCID.
2479 By default, return a three letter locale code which encodes the default
2480 language as the first two characters, and the country or regional variant
2481 as the third letter. For example, ENU refers to `English (United States)',
2482 while ENC means `English (Canadian)'.
2484 If the optional argument LONGFORM is t, the long form of the locale
2485 name is returned, e.g. `English (United States)' instead; if LONGFORM
2486 is a number, it is interpreted as an LCTYPE constant and the corresponding
2487 locale information is returned.
2489 If LCID (a 16-bit number) is not a valid locale, the result is nil. */)
2490 (Lisp_Object lcid, Lisp_Object longform)
2492 int got_abbrev;
2493 int got_full;
2494 char abbrev_name[32] = { 0 };
2495 char full_name[256] = { 0 };
2497 CHECK_NUMBER (lcid);
2499 if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
2500 return Qnil;
2502 if (NILP (longform))
2504 got_abbrev = GetLocaleInfo (XINT (lcid),
2505 LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
2506 abbrev_name, sizeof (abbrev_name));
2507 if (got_abbrev)
2508 return build_string (abbrev_name);
2510 else if (EQ (longform, Qt))
2512 got_full = GetLocaleInfo (XINT (lcid),
2513 LOCALE_SLANGUAGE | LOCALE_USE_CP_ACP,
2514 full_name, sizeof (full_name));
2515 if (got_full)
2516 return DECODE_SYSTEM (build_string (full_name));
2518 else if (NUMBERP (longform))
2520 got_full = GetLocaleInfo (XINT (lcid),
2521 XINT (longform),
2522 full_name, sizeof (full_name));
2523 /* GetLocaleInfo's return value includes the terminating null
2524 character, when the returned information is a string, whereas
2525 make_unibyte_string needs the string length without the
2526 terminating null. */
2527 if (got_full)
2528 return make_unibyte_string (full_name, got_full - 1);
2531 return Qnil;
2535 DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id,
2536 Sw32_get_current_locale_id, 0, 0, 0,
2537 doc: /* Return Windows locale id for current locale setting.
2538 This is a numerical value; use `w32-get-locale-info' to convert to a
2539 human-readable form. */)
2540 (void)
2542 return make_number (GetThreadLocale ());
2545 static DWORD
2546 int_from_hex (char * s)
2548 DWORD val = 0;
2549 static char hex[] = "0123456789abcdefABCDEF";
2550 char * p;
2552 while (*s && (p = strchr (hex, *s)) != NULL)
2554 unsigned digit = p - hex;
2555 if (digit > 15)
2556 digit -= 6;
2557 val = val * 16 + digit;
2558 s++;
2560 return val;
2563 /* We need to build a global list, since the EnumSystemLocale callback
2564 function isn't given a context pointer. */
2565 Lisp_Object Vw32_valid_locale_ids;
2567 static BOOL CALLBACK
2568 enum_locale_fn (LPTSTR localeNum)
2570 DWORD id = int_from_hex (localeNum);
2571 Vw32_valid_locale_ids = Fcons (make_number (id), Vw32_valid_locale_ids);
2572 return TRUE;
2575 DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids,
2576 Sw32_get_valid_locale_ids, 0, 0, 0,
2577 doc: /* Return list of all valid Windows locale ids.
2578 Each id is a numerical value; use `w32-get-locale-info' to convert to a
2579 human-readable form. */)
2580 (void)
2582 Vw32_valid_locale_ids = Qnil;
2584 EnumSystemLocales (enum_locale_fn, LCID_SUPPORTED);
2586 Vw32_valid_locale_ids = Fnreverse (Vw32_valid_locale_ids);
2587 return Vw32_valid_locale_ids;
2591 DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id, Sw32_get_default_locale_id, 0, 1, 0,
2592 doc: /* Return Windows locale id for default locale setting.
2593 By default, the system default locale setting is returned; if the optional
2594 parameter USERP is non-nil, the user default locale setting is returned.
2595 This is a numerical value; use `w32-get-locale-info' to convert to a
2596 human-readable form. */)
2597 (Lisp_Object userp)
2599 if (NILP (userp))
2600 return make_number (GetSystemDefaultLCID ());
2601 return make_number (GetUserDefaultLCID ());
2605 DEFUN ("w32-set-current-locale", Fw32_set_current_locale, Sw32_set_current_locale, 1, 1, 0,
2606 doc: /* Make Windows locale LCID be the current locale setting for Emacs.
2607 If successful, the new locale id is returned, otherwise nil. */)
2608 (Lisp_Object lcid)
2610 CHECK_NUMBER (lcid);
2612 if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
2613 return Qnil;
2615 if (!SetThreadLocale (XINT (lcid)))
2616 return Qnil;
2618 /* Need to set input thread locale if present. */
2619 if (dwWindowsThreadId)
2620 /* Reply is not needed. */
2621 PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0);
2623 return make_number (GetThreadLocale ());
2627 /* We need to build a global list, since the EnumCodePages callback
2628 function isn't given a context pointer. */
2629 Lisp_Object Vw32_valid_codepages;
2631 static BOOL CALLBACK
2632 enum_codepage_fn (LPTSTR codepageNum)
2634 DWORD id = atoi (codepageNum);
2635 Vw32_valid_codepages = Fcons (make_number (id), Vw32_valid_codepages);
2636 return TRUE;
2639 DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages,
2640 Sw32_get_valid_codepages, 0, 0, 0,
2641 doc: /* Return list of all valid Windows codepages. */)
2642 (void)
2644 Vw32_valid_codepages = Qnil;
2646 EnumSystemCodePages (enum_codepage_fn, CP_SUPPORTED);
2648 Vw32_valid_codepages = Fnreverse (Vw32_valid_codepages);
2649 return Vw32_valid_codepages;
2653 DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage,
2654 Sw32_get_console_codepage, 0, 0, 0,
2655 doc: /* Return current Windows codepage for console input. */)
2656 (void)
2658 return make_number (GetConsoleCP ());
2662 DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage,
2663 Sw32_set_console_codepage, 1, 1, 0,
2664 doc: /* Make Windows codepage CP be the codepage for Emacs tty keyboard input.
2665 This codepage setting affects keyboard input in tty mode.
2666 If successful, the new CP is returned, otherwise nil. */)
2667 (Lisp_Object cp)
2669 CHECK_NUMBER (cp);
2671 if (!IsValidCodePage (XINT (cp)))
2672 return Qnil;
2674 if (!SetConsoleCP (XINT (cp)))
2675 return Qnil;
2677 return make_number (GetConsoleCP ());
2681 DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage,
2682 Sw32_get_console_output_codepage, 0, 0, 0,
2683 doc: /* Return current Windows codepage for console output. */)
2684 (void)
2686 return make_number (GetConsoleOutputCP ());
2690 DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage,
2691 Sw32_set_console_output_codepage, 1, 1, 0,
2692 doc: /* Make Windows codepage CP be the codepage for Emacs console output.
2693 This codepage setting affects display in tty mode.
2694 If successful, the new CP is returned, otherwise nil. */)
2695 (Lisp_Object cp)
2697 CHECK_NUMBER (cp);
2699 if (!IsValidCodePage (XINT (cp)))
2700 return Qnil;
2702 if (!SetConsoleOutputCP (XINT (cp)))
2703 return Qnil;
2705 return make_number (GetConsoleOutputCP ());
2709 DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset,
2710 Sw32_get_codepage_charset, 1, 1, 0,
2711 doc: /* Return charset ID corresponding to codepage CP.
2712 Returns nil if the codepage is not valid. */)
2713 (Lisp_Object cp)
2715 CHARSETINFO info;
2717 CHECK_NUMBER (cp);
2719 if (!IsValidCodePage (XINT (cp)))
2720 return Qnil;
2722 if (TranslateCharsetInfo ((DWORD *) XINT (cp), &info, TCI_SRCCODEPAGE))
2723 return make_number (info.ciCharset);
2725 return Qnil;
2729 DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts,
2730 Sw32_get_valid_keyboard_layouts, 0, 0, 0,
2731 doc: /* Return list of Windows keyboard languages and layouts.
2732 The return value is a list of pairs of language id and layout id. */)
2733 (void)
2735 int num_layouts = GetKeyboardLayoutList (0, NULL);
2736 HKL * layouts = (HKL *) alloca (num_layouts * sizeof (HKL));
2737 Lisp_Object obj = Qnil;
2739 if (GetKeyboardLayoutList (num_layouts, layouts) == num_layouts)
2741 while (--num_layouts >= 0)
2743 DWORD kl = (DWORD) layouts[num_layouts];
2745 obj = Fcons (Fcons (make_number (kl & 0xffff),
2746 make_number ((kl >> 16) & 0xffff)),
2747 obj);
2751 return obj;
2755 DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout,
2756 Sw32_get_keyboard_layout, 0, 0, 0,
2757 doc: /* Return current Windows keyboard language and layout.
2758 The return value is the cons of the language id and the layout id. */)
2759 (void)
2761 DWORD kl = (DWORD) GetKeyboardLayout (dwWindowsThreadId);
2763 return Fcons (make_number (kl & 0xffff),
2764 make_number ((kl >> 16) & 0xffff));
2768 DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout,
2769 Sw32_set_keyboard_layout, 1, 1, 0,
2770 doc: /* Make LAYOUT be the current keyboard layout for Emacs.
2771 The keyboard layout setting affects interpretation of keyboard input.
2772 If successful, the new layout id is returned, otherwise nil. */)
2773 (Lisp_Object layout)
2775 DWORD kl;
2777 CHECK_CONS (layout);
2778 CHECK_NUMBER_CAR (layout);
2779 CHECK_NUMBER_CDR (layout);
2781 kl = (XINT (XCAR (layout)) & 0xffff)
2782 | (XINT (XCDR (layout)) << 16);
2784 /* Synchronize layout with input thread. */
2785 if (dwWindowsThreadId)
2787 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETKEYBOARDLAYOUT,
2788 (WPARAM) kl, 0))
2790 MSG msg;
2791 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
2793 if (msg.wParam == 0)
2794 return Qnil;
2797 else if (!ActivateKeyboardLayout ((HKL) kl, 0))
2798 return Qnil;
2800 return Fw32_get_keyboard_layout ();
2804 void
2805 syms_of_ntproc (void)
2807 DEFSYM (Qhigh, "high");
2808 DEFSYM (Qlow, "low");
2810 defsubr (&Sw32_has_winsock);
2811 defsubr (&Sw32_unload_winsock);
2813 defsubr (&Sw32_short_file_name);
2814 defsubr (&Sw32_long_file_name);
2815 defsubr (&Sw32_set_process_priority);
2816 defsubr (&Sw32_get_locale_info);
2817 defsubr (&Sw32_get_current_locale_id);
2818 defsubr (&Sw32_get_default_locale_id);
2819 defsubr (&Sw32_get_valid_locale_ids);
2820 defsubr (&Sw32_set_current_locale);
2822 defsubr (&Sw32_get_console_codepage);
2823 defsubr (&Sw32_set_console_codepage);
2824 defsubr (&Sw32_get_console_output_codepage);
2825 defsubr (&Sw32_set_console_output_codepage);
2826 defsubr (&Sw32_get_valid_codepages);
2827 defsubr (&Sw32_get_codepage_charset);
2829 defsubr (&Sw32_get_valid_keyboard_layouts);
2830 defsubr (&Sw32_get_keyboard_layout);
2831 defsubr (&Sw32_set_keyboard_layout);
2833 DEFVAR_LISP ("w32-quote-process-args", Vw32_quote_process_args,
2834 doc: /* Non-nil enables quoting of process arguments to ensure correct parsing.
2835 Because Windows does not directly pass argv arrays to child processes,
2836 programs have to reconstruct the argv array by parsing the command
2837 line string. For an argument to contain a space, it must be enclosed
2838 in double quotes or it will be parsed as multiple arguments.
2840 If the value is a character, that character will be used to escape any
2841 quote characters that appear, otherwise a suitable escape character
2842 will be chosen based on the type of the program. */);
2843 Vw32_quote_process_args = Qt;
2845 DEFVAR_LISP ("w32-start-process-show-window",
2846 Vw32_start_process_show_window,
2847 doc: /* When nil, new child processes hide their windows.
2848 When non-nil, they show their window in the method of their choice.
2849 This variable doesn't affect GUI applications, which will never be hidden. */);
2850 Vw32_start_process_show_window = Qnil;
2852 DEFVAR_LISP ("w32-start-process-share-console",
2853 Vw32_start_process_share_console,
2854 doc: /* When nil, new child processes are given a new console.
2855 When non-nil, they share the Emacs console; this has the limitation of
2856 allowing only one DOS subprocess to run at a time (whether started directly
2857 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
2858 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
2859 otherwise respond to interrupts from Emacs. */);
2860 Vw32_start_process_share_console = Qnil;
2862 DEFVAR_LISP ("w32-start-process-inherit-error-mode",
2863 Vw32_start_process_inherit_error_mode,
2864 doc: /* When nil, new child processes revert to the default error mode.
2865 When non-nil, they inherit their error mode setting from Emacs, which stops
2866 them blocking when trying to access unmounted drives etc. */);
2867 Vw32_start_process_inherit_error_mode = Qt;
2869 DEFVAR_INT ("w32-pipe-read-delay", w32_pipe_read_delay,
2870 doc: /* Forced delay before reading subprocess output.
2871 This is done to improve the buffering of subprocess output, by
2872 avoiding the inefficiency of frequently reading small amounts of data.
2874 If positive, the value is the number of milliseconds to sleep before
2875 reading the subprocess output. If negative, the magnitude is the number
2876 of time slices to wait (effectively boosting the priority of the child
2877 process temporarily). A value of zero disables waiting entirely. */);
2878 w32_pipe_read_delay = 50;
2880 DEFVAR_LISP ("w32-downcase-file-names", Vw32_downcase_file_names,
2881 doc: /* Non-nil means convert all-upper case file names to lower case.
2882 This applies when performing completions and file name expansion.
2883 Note that the value of this setting also affects remote file names,
2884 so you probably don't want to set to non-nil if you use case-sensitive
2885 filesystems via ange-ftp. */);
2886 Vw32_downcase_file_names = Qnil;
2888 #if 0
2889 DEFVAR_LISP ("w32-generate-fake-inodes", Vw32_generate_fake_inodes,
2890 doc: /* Non-nil means attempt to fake realistic inode values.
2891 This works by hashing the truename of files, and should detect
2892 aliasing between long and short (8.3 DOS) names, but can have
2893 false positives because of hash collisions. Note that determining
2894 the truename of a file can be slow. */);
2895 Vw32_generate_fake_inodes = Qnil;
2896 #endif
2898 DEFVAR_LISP ("w32-get-true-file-attributes", Vw32_get_true_file_attributes,
2899 doc: /* Non-nil means determine accurate file attributes in `file-attributes'.
2900 This option controls whether to issue additional system calls to determine
2901 accurate link counts, file type, and ownership information. It is more
2902 useful for files on NTFS volumes, where hard links and file security are
2903 supported, than on volumes of the FAT family.
2905 Without these system calls, link count will always be reported as 1 and file
2906 ownership will be attributed to the current user.
2907 The default value `local' means only issue these system calls for files
2908 on local fixed drives. A value of nil means never issue them.
2909 Any other non-nil value means do this even on remote and removable drives
2910 where the performance impact may be noticeable even on modern hardware. */);
2911 Vw32_get_true_file_attributes = Qlocal;
2913 staticpro (&Vw32_valid_locale_ids);
2914 staticpro (&Vw32_valid_codepages);
2916 /* end of w32proc.c */