* lisp/bookmark.el (bookmark-version-control): Use Drew's slightly
[emacs.git] / src / w32proc.c
blobfb872990bd098c649bf56542e7db349794b938df
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 #ifdef EMACSDEBUG
71 void
72 _DebPrint (const char *fmt, ...)
74 char buf[1024];
75 va_list args;
77 va_start (args, fmt);
78 vsprintf (buf, fmt, args);
79 va_end (args);
80 OutputDebugString (buf);
82 #endif
84 typedef void (_CALLBACK_ *signal_handler) (int);
86 /* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */
87 static signal_handler sig_handlers[NSIG];
89 static sigset_t sig_mask;
91 static CRITICAL_SECTION crit_sig;
93 /* Improve on the CRT 'signal' implementation so that we could record
94 the SIGCHLD handler and fake interval timers. */
95 signal_handler
96 sys_signal (int sig, signal_handler handler)
98 signal_handler old;
100 /* SIGCHLD is needed for supporting subprocesses, see sys_kill
101 below. SIGALRM and SIGPROF are used by setitimer. All the
102 others are the only ones supported by the MS runtime. */
103 if (!(sig == SIGCHLD || sig == SIGSEGV || sig == SIGILL
104 || sig == SIGFPE || sig == SIGABRT || sig == SIGTERM
105 || sig == SIGALRM || sig == SIGPROF))
107 errno = EINVAL;
108 return SIG_ERR;
110 old = sig_handlers[sig];
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))
118 sig_handlers[sig] = handler;
119 if (!(sig == SIGCHLD || sig == SIGALRM || sig == SIGPROF))
120 signal (sig, handler);
122 return old;
125 /* Emulate sigaction. */
127 sigaction (int sig, const struct sigaction *act, struct sigaction *oact)
129 signal_handler old = SIG_DFL;
130 int retval = 0;
132 if (act)
133 old = sys_signal (sig, act->sa_handler);
134 else if (oact)
135 old = sig_handlers[sig];
137 if (old == SIG_ERR)
139 errno = EINVAL;
140 retval = -1;
142 if (oact)
144 oact->sa_handler = old;
145 oact->sa_flags = 0;
146 oact->sa_mask = empty_mask;
148 return retval;
151 /* Emulate signal sets and blocking of signals used by timers. */
154 sigemptyset (sigset_t *set)
156 *set = 0;
157 return 0;
161 sigaddset (sigset_t *set, int signo)
163 if (!set)
165 errno = EINVAL;
166 return -1;
168 if (signo < 0 || signo >= NSIG)
170 errno = EINVAL;
171 return -1;
174 *set |= (1U << signo);
176 return 0;
180 sigfillset (sigset_t *set)
182 if (!set)
184 errno = EINVAL;
185 return -1;
188 *set = 0xFFFFFFFF;
189 return 0;
193 sigprocmask (int how, const sigset_t *set, sigset_t *oset)
195 if (!(how == SIG_BLOCK || how == SIG_UNBLOCK || how == SIG_SETMASK))
197 errno = EINVAL;
198 return -1;
201 if (oset)
202 *oset = sig_mask;
204 if (!set)
205 return 0;
207 switch (how)
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;
222 return 0;
226 pthread_sigmask (int how, const sigset_t *set, sigset_t *oset)
228 if (sigprocmask (how, set, oset) == -1)
229 return EINVAL;
230 return 0;
234 sigismember (const sigset_t *set, int signo)
236 if (signo < 0 || signo >= NSIG)
238 errno = EINVAL;
239 return -1;
241 if (signo > sizeof (*set) * BITS_PER_CHAR)
242 emacs_abort ();
244 return (*set & (1U << signo)) != 0;
248 setpgrp (int pid, int gid)
250 return 0;
253 /* Emulations of interval timers.
255 Limitations: only ITIMER_REAL and ITIMER_PROF are supported.
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. */
261 /* FIXME: clock_t counts overflow after 49 days, need to handle the
262 wrap-around. */
263 struct itimer_data {
264 clock_t expire;
265 clock_t reload;
266 int terminate;
267 int type;
268 HANDLE caller_thread;
269 HANDLE timer_thread;
272 static clock_t ticks_now;
273 static struct itimer_data real_itimer, prof_itimer;
274 static clock_t clocks_min;
276 static CRITICAL_SECTION crit_real, crit_prof;
278 #define MAX_SINGLE_SLEEP 30
280 static DWORD WINAPI
281 timer_loop (LPVOID arg)
283 struct itimer_data *itimer = (struct itimer_data *)arg;
284 int which = itimer->type;
285 int sig = (which == ITIMER_REAL) ? SIGALRM : SIGPROF;
286 CRITICAL_SECTION *crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
287 const DWORD max_sleep = MAX_SINGLE_SLEEP * 1000 / CLOCKS_PER_SEC;
288 int new_count = 0;
290 while (1)
292 DWORD sleep_time;
293 signal_handler handler;
294 clock_t now, expire, reload;
296 /* Load new values if requested by setitimer. */
297 EnterCriticalSection (crit);
298 expire = itimer->expire;
299 reload = itimer->reload;
300 LeaveCriticalSection (crit);
301 if (itimer->terminate)
302 return 0;
304 if (itimer->expire == 0)
306 /* We are idle. */
307 Sleep (max_sleep);
308 continue;
311 expire = itimer->expire;
312 if (expire > (now = clock ()))
313 sleep_time = expire - now;
314 else
315 sleep_time = 0;
316 /* Don't sleep too long at a time, to be able to see the
317 termination flag without too long a delay. */
318 while (sleep_time > max_sleep)
320 if (itimer->terminate)
321 return 0;
322 Sleep (max_sleep);
323 expire = itimer->expire;
324 sleep_time = (expire > (now = clock ())) ? expire - now : 0;
326 if (itimer->terminate)
327 return 0;
328 if (sleep_time > 0)
330 Sleep (sleep_time * 1000 / CLOCKS_PER_SEC);
331 /* Always sleep past the expiration time, to make sure we
332 never call the handler _before_ the expiration time,
333 always slightly after it. Sleep(0) relinquishes the rest
334 of the scheduled slot, so that we let other threads
335 work. */
336 while (clock () < expire)
337 Sleep (0);
340 if (itimer->expire == 0)
341 continue;
343 /* Time's up. */
344 handler = sig_handlers[sig];
345 if (!(handler == SIG_DFL || handler == SIG_IGN || handler == SIG_ERR)
346 /* FIXME: Don't ignore masked signals. Instead, record that
347 they happened and reissue them when the signal is
348 unblocked. */
349 && !sigismember (&sig_mask, sig)
350 /* Simulate masking of SIGALRM and SIGPROF when processing
351 fatal signals. */
352 && !fatal_error_in_progress
353 && itimer->caller_thread)
355 /* Simulate a signal delivered to the thread which installed
356 the timer, by suspending that thread while the handler
357 runs. */
358 DWORD result = SuspendThread (itimer->caller_thread);
360 if (result == (DWORD)-1)
362 DebPrint (("Thread %d exiting with status 2\n", which));
363 return 2;
365 handler (sig);
366 ResumeThread (itimer->caller_thread);
369 if (itimer->expire == 0)
370 continue;
372 /* Update expiration time and loop. */
373 EnterCriticalSection (crit);
374 expire = itimer->expire;
375 reload = itimer->reload;
376 if (reload > 0)
378 now = clock ();
379 if (expire <= now)
381 clock_t lag = now - expire;
383 /* If we missed some opportunities (presumably while
384 sleeping or while the signal handler ran), skip
385 them. */
386 if (lag > reload)
387 expire = now - (lag % reload);
389 expire += reload;
392 else
393 expire = 0; /* become idle */
394 itimer->expire = expire;
395 LeaveCriticalSection (crit);
397 return 0;
400 static void
401 stop_timer_thread (int which)
403 struct itimer_data *itimer =
404 (which == ITIMER_REAL) ? &real_itimer : &prof_itimer;
405 int i;
406 DWORD exit_code = 255;
407 BOOL status, err;
409 /* Signal the thread that it should terminate. */
410 itimer->terminate = 1;
412 if (itimer->timer_thread == NULL)
413 return;
415 /* Wait for the timer thread to terminate voluntarily, then kill it
416 if it doesn't. This loop waits twice more than the maximum
417 amount of time a timer thread sleeps, see above. */
418 for (i = 0; i < MAX_SINGLE_SLEEP / 5; i++)
420 if (!((status = GetExitCodeThread (itimer->timer_thread, &exit_code))
421 && exit_code == STILL_ACTIVE))
422 break;
423 Sleep (10);
425 if ((status == FALSE && (err = GetLastError ()) == ERROR_INVALID_HANDLE)
426 || exit_code == STILL_ACTIVE)
428 if (!(status == FALSE && err == ERROR_INVALID_HANDLE))
429 TerminateThread (itimer->timer_thread, 0);
432 /* Clean up. */
433 CloseHandle (itimer->timer_thread);
434 itimer->timer_thread = NULL;
435 if (itimer->caller_thread)
437 CloseHandle (itimer->caller_thread);
438 itimer->caller_thread = NULL;
442 /* This is called at shutdown time from term_ntproc. */
443 void
444 term_timers (void)
446 if (real_itimer.timer_thread)
447 stop_timer_thread (ITIMER_REAL);
448 if (prof_itimer.timer_thread)
449 stop_timer_thread (ITIMER_PROF);
451 DeleteCriticalSection (&crit_real);
452 DeleteCriticalSection (&crit_prof);
453 DeleteCriticalSection (&crit_sig);
456 /* This is called at initialization time from init_ntproc. */
457 void
458 init_timers (void)
460 /* Make sure we start with zeroed out itimer structures, since
461 dumping may have left there traces of threads long dead. */
462 memset (&real_itimer, 0, sizeof real_itimer);
463 memset (&prof_itimer, 0, sizeof prof_itimer);
465 InitializeCriticalSection (&crit_real);
466 InitializeCriticalSection (&crit_prof);
467 InitializeCriticalSection (&crit_sig);
470 static int
471 start_timer_thread (int which)
473 DWORD exit_code;
474 struct itimer_data *itimer =
475 (which == ITIMER_REAL) ? &real_itimer : &prof_itimer;
477 if (itimer->timer_thread
478 && GetExitCodeThread (itimer->timer_thread, &exit_code)
479 && exit_code == STILL_ACTIVE)
480 return 0;
482 /* Start a new thread. */
483 if (!DuplicateHandle (GetCurrentProcess (), GetCurrentThread (),
484 GetCurrentProcess (), &itimer->caller_thread, 0,
485 FALSE, DUPLICATE_SAME_ACCESS))
487 errno = ESRCH;
488 return -1;
491 itimer->terminate = 0;
492 itimer->type = which;
493 /* Request that no more than 64KB of stack be reserved for this
494 thread, to avoid reserving too much memory, which would get in
495 the way of threads we start to wait for subprocesses. See also
496 new_child below. */
497 itimer->timer_thread = CreateThread (NULL, 64 * 1024, timer_loop,
498 (void *)itimer, 0x00010000, NULL);
500 if (!itimer->timer_thread)
502 CloseHandle (itimer->caller_thread);
503 itimer->caller_thread = NULL;
504 errno = EAGAIN;
505 return -1;
508 /* This is needed to make sure that the timer thread running for
509 profiling gets CPU as soon as the Sleep call terminates. */
510 if (which == ITIMER_PROF)
511 SetThreadPriority (itimer->caller_thread, THREAD_PRIORITY_TIME_CRITICAL);
513 return 0;
516 /* Most of the code of getitimer and setitimer (but not of their
517 subroutines) was shamelessly stolen from itimer.c in the DJGPP
518 library, see www.delorie.com/djgpp. */
520 getitimer (int which, struct itimerval *value)
522 volatile clock_t *t_expire;
523 volatile clock_t *t_reload;
524 clock_t expire, reload;
525 __int64 usecs;
526 CRITICAL_SECTION *crit;
528 ticks_now = clock ();
530 if (!value)
532 errno = EFAULT;
533 return -1;
536 if (which != ITIMER_REAL && which != ITIMER_PROF)
538 errno = EINVAL;
539 return -1;
542 t_expire = (which == ITIMER_REAL) ? &real_itimer.expire: &prof_itimer.expire;
543 t_reload = (which == ITIMER_REAL) ? &real_itimer.reload: &prof_itimer.reload;
544 crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
546 EnterCriticalSection (crit);
547 reload = *t_reload;
548 expire = *t_expire;
549 LeaveCriticalSection (crit);
551 if (expire)
552 expire -= ticks_now;
554 value->it_value.tv_sec = expire / CLOCKS_PER_SEC;
555 usecs = (expire % CLOCKS_PER_SEC) * (__int64)1000000 / CLOCKS_PER_SEC;
556 value->it_value.tv_usec = usecs;
557 value->it_interval.tv_sec = reload / CLOCKS_PER_SEC;
558 usecs = (reload % CLOCKS_PER_SEC) * (__int64)1000000 / CLOCKS_PER_SEC;
559 value->it_interval.tv_usec= usecs;
561 return 0;
565 setitimer(int which, struct itimerval *value, struct itimerval *ovalue)
567 volatile clock_t *t_expire, *t_reload;
568 clock_t expire, reload, expire_old, reload_old;
569 __int64 usecs;
570 CRITICAL_SECTION *crit;
572 /* Posix systems expect timer values smaller than the resolution of
573 the system clock be rounded up to the clock resolution. First
574 time we are called, measure the clock tick resolution. */
575 if (!clocks_min)
577 clock_t t1, t2;
579 for (t1 = clock (); (t2 = clock ()) == t1; )
581 clocks_min = t2 - t1;
584 if (ovalue)
586 if (getitimer (which, ovalue)) /* also sets ticks_now */
587 return -1; /* errno already set */
589 else
590 ticks_now = clock ();
592 if (which != ITIMER_REAL && which != ITIMER_PROF)
594 errno = EINVAL;
595 return -1;
598 t_expire =
599 (which == ITIMER_REAL) ? &real_itimer.expire : &prof_itimer.expire;
600 t_reload =
601 (which == ITIMER_REAL) ? &real_itimer.reload : &prof_itimer.reload;
603 crit = (which == ITIMER_REAL) ? &crit_real : &crit_prof;
605 if (!value
606 || (value->it_value.tv_sec == 0 && value->it_value.tv_usec == 0))
608 EnterCriticalSection (crit);
609 /* Disable the timer. */
610 *t_expire = 0;
611 *t_reload = 0;
612 LeaveCriticalSection (crit);
613 return 0;
616 reload = value->it_interval.tv_sec * CLOCKS_PER_SEC;
618 usecs = value->it_interval.tv_usec;
619 if (value->it_interval.tv_sec == 0
620 && usecs && usecs * CLOCKS_PER_SEC < clocks_min * 1000000)
621 reload = clocks_min;
622 else
624 usecs *= CLOCKS_PER_SEC;
625 reload += usecs / 1000000;
628 expire = value->it_value.tv_sec * CLOCKS_PER_SEC;
629 usecs = value->it_value.tv_usec;
630 if (value->it_value.tv_sec == 0
631 && usecs * CLOCKS_PER_SEC < clocks_min * 1000000)
632 expire = clocks_min;
633 else
635 usecs *= CLOCKS_PER_SEC;
636 expire += usecs / 1000000;
639 expire += ticks_now;
641 EnterCriticalSection (crit);
642 expire_old = *t_expire;
643 reload_old = *t_reload;
644 if (!(expire == expire_old && reload == reload_old))
646 *t_reload = reload;
647 *t_expire = expire;
649 LeaveCriticalSection (crit);
651 return start_timer_thread (which);
655 alarm (int seconds)
657 struct itimerval new_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 setitimer (ITIMER_REAL, &new_values, NULL);
665 return seconds;
668 /* Defined in <process.h> which conflicts with the local copy */
669 #define _P_NOWAIT 1
671 /* Child process management list. */
672 int child_proc_count = 0;
673 child_process child_procs[ MAX_CHILDREN ];
674 child_process *dead_child = NULL;
676 static DWORD WINAPI reader_thread (void *arg);
678 /* Find an unused process slot. */
679 child_process *
680 new_child (void)
682 child_process *cp;
683 DWORD id;
685 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
686 if (!CHILD_ACTIVE (cp))
687 goto Initialize;
688 if (child_proc_count == MAX_CHILDREN)
689 return NULL;
690 cp = &child_procs[child_proc_count++];
692 Initialize:
693 memset (cp, 0, sizeof (*cp));
694 cp->fd = -1;
695 cp->pid = -1;
696 cp->procinfo.hProcess = NULL;
697 cp->status = STATUS_READ_ERROR;
699 /* use manual reset event so that select() will function properly */
700 cp->char_avail = CreateEvent (NULL, TRUE, FALSE, NULL);
701 if (cp->char_avail)
703 cp->char_consumed = CreateEvent (NULL, FALSE, FALSE, NULL);
704 if (cp->char_consumed)
706 /* The 0x00010000 flag is STACK_SIZE_PARAM_IS_A_RESERVATION.
707 It means that the 64K stack we are requesting in the 2nd
708 argument is how much memory should be reserved for the
709 stack. If we don't use this flag, the memory requested
710 by the 2nd argument is the amount actually _committed_,
711 but Windows reserves 8MB of memory for each thread's
712 stack. (The 8MB figure comes from the -stack
713 command-line argument we pass to the linker when building
714 Emacs, but that's because we need a large stack for
715 Emacs's main thread.) Since we request 2GB of reserved
716 memory at startup (see w32heap.c), which is close to the
717 maximum memory available for a 32-bit process on Windows,
718 the 8MB reservation for each thread causes failures in
719 starting subprocesses, because we create a thread running
720 reader_thread for each subprocess. As 8MB of stack is
721 way too much for reader_thread, forcing Windows to
722 reserve less wins the day. */
723 cp->thrd = CreateThread (NULL, 64 * 1024, reader_thread, cp,
724 0x00010000, &id);
725 if (cp->thrd)
726 return cp;
729 delete_child (cp);
730 return NULL;
733 void
734 delete_child (child_process *cp)
736 int i;
738 /* Should not be deleting a child that is still needed. */
739 for (i = 0; i < MAXDESC; i++)
740 if (fd_info[i].cp == cp)
741 emacs_abort ();
743 if (!CHILD_ACTIVE (cp))
744 return;
746 /* reap thread if necessary */
747 if (cp->thrd)
749 DWORD rc;
751 if (GetExitCodeThread (cp->thrd, &rc) && rc == STILL_ACTIVE)
753 /* let the thread exit cleanly if possible */
754 cp->status = STATUS_READ_ERROR;
755 SetEvent (cp->char_consumed);
756 #if 0
757 /* We used to forcibly terminate the thread here, but it
758 is normally unnecessary, and in abnormal cases, the worst that
759 will happen is we have an extra idle thread hanging around
760 waiting for the zombie process. */
761 if (WaitForSingleObject (cp->thrd, 1000) != WAIT_OBJECT_0)
763 DebPrint (("delete_child.WaitForSingleObject (thread) failed "
764 "with %lu for fd %ld\n", GetLastError (), cp->fd));
765 TerminateThread (cp->thrd, 0);
767 #endif
769 CloseHandle (cp->thrd);
770 cp->thrd = NULL;
772 if (cp->char_avail)
774 CloseHandle (cp->char_avail);
775 cp->char_avail = NULL;
777 if (cp->char_consumed)
779 CloseHandle (cp->char_consumed);
780 cp->char_consumed = NULL;
783 /* update child_proc_count (highest numbered slot in use plus one) */
784 if (cp == child_procs + child_proc_count - 1)
786 for (i = child_proc_count-1; i >= 0; i--)
787 if (CHILD_ACTIVE (&child_procs[i]))
789 child_proc_count = i + 1;
790 break;
793 if (i < 0)
794 child_proc_count = 0;
797 /* Find a child by pid. */
798 static child_process *
799 find_child_pid (DWORD pid)
801 child_process *cp;
803 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
804 if (CHILD_ACTIVE (cp) && pid == cp->pid)
805 return cp;
806 return NULL;
810 /* Thread proc for child process and socket reader threads. Each thread
811 is normally blocked until woken by select() to check for input by
812 reading one char. When the read completes, char_avail is signaled
813 to wake up the select emulator and the thread blocks itself again. */
814 static DWORD WINAPI
815 reader_thread (void *arg)
817 child_process *cp;
819 /* Our identity */
820 cp = (child_process *)arg;
822 /* We have to wait for the go-ahead before we can start */
823 if (cp == NULL
824 || WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0
825 || cp->fd < 0)
826 return 1;
828 for (;;)
830 int rc;
832 if (fd_info[cp->fd].flags & FILE_LISTEN)
833 rc = _sys_wait_accept (cp->fd);
834 else
835 rc = _sys_read_ahead (cp->fd);
837 /* The name char_avail is a misnomer - it really just means the
838 read-ahead has completed, whether successfully or not. */
839 if (!SetEvent (cp->char_avail))
841 DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld\n",
842 GetLastError (), cp->fd));
843 return 1;
846 if (rc == STATUS_READ_ERROR)
847 return 1;
849 /* If the read died, the child has died so let the thread die */
850 if (rc == STATUS_READ_FAILED)
851 break;
853 /* Wait until our input is acknowledged before reading again */
854 if (WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0)
856 DebPrint (("reader_thread.WaitForSingleObject failed with "
857 "%lu for fd %ld\n", GetLastError (), cp->fd));
858 break;
861 return 0;
864 /* To avoid Emacs changing directory, we just record here the directory
865 the new process should start in. This is set just before calling
866 sys_spawnve, and is not generally valid at any other time. */
867 static char * process_dir;
869 static BOOL
870 create_child (char *exe, char *cmdline, char *env, int is_gui_app,
871 int * pPid, child_process *cp)
873 STARTUPINFO start;
874 SECURITY_ATTRIBUTES sec_attrs;
875 #if 0
876 SECURITY_DESCRIPTOR sec_desc;
877 #endif
878 DWORD flags;
879 char dir[ MAXPATHLEN ];
881 if (cp == NULL) emacs_abort ();
883 memset (&start, 0, sizeof (start));
884 start.cb = sizeof (start);
886 #ifdef HAVE_NTGUI
887 if (NILP (Vw32_start_process_show_window) && !is_gui_app)
888 start.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW;
889 else
890 start.dwFlags = STARTF_USESTDHANDLES;
891 start.wShowWindow = SW_HIDE;
893 start.hStdInput = GetStdHandle (STD_INPUT_HANDLE);
894 start.hStdOutput = GetStdHandle (STD_OUTPUT_HANDLE);
895 start.hStdError = GetStdHandle (STD_ERROR_HANDLE);
896 #endif /* HAVE_NTGUI */
898 #if 0
899 /* Explicitly specify no security */
900 if (!InitializeSecurityDescriptor (&sec_desc, SECURITY_DESCRIPTOR_REVISION))
901 goto EH_Fail;
902 if (!SetSecurityDescriptorDacl (&sec_desc, TRUE, NULL, FALSE))
903 goto EH_Fail;
904 #endif
905 sec_attrs.nLength = sizeof (sec_attrs);
906 sec_attrs.lpSecurityDescriptor = NULL /* &sec_desc */;
907 sec_attrs.bInheritHandle = FALSE;
909 strcpy (dir, process_dir);
910 unixtodos_filename (dir);
912 flags = (!NILP (Vw32_start_process_share_console)
913 ? CREATE_NEW_PROCESS_GROUP
914 : CREATE_NEW_CONSOLE);
915 if (NILP (Vw32_start_process_inherit_error_mode))
916 flags |= CREATE_DEFAULT_ERROR_MODE;
917 if (!CreateProcess (exe, cmdline, &sec_attrs, NULL, TRUE,
918 flags, env, dir, &start, &cp->procinfo))
919 goto EH_Fail;
921 cp->pid = (int) cp->procinfo.dwProcessId;
923 /* Hack for Windows 95, which assigns large (ie negative) pids */
924 if (cp->pid < 0)
925 cp->pid = -cp->pid;
927 /* pid must fit in a Lisp_Int */
928 cp->pid = cp->pid & INTMASK;
930 *pPid = cp->pid;
932 return TRUE;
934 EH_Fail:
935 DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError ()););
936 return FALSE;
939 /* create_child doesn't know what emacs' file handle will be for waiting
940 on output from the child, so we need to make this additional call
941 to register the handle with the process
942 This way the select emulator knows how to match file handles with
943 entries in child_procs. */
944 void
945 register_child (int pid, int fd)
947 child_process *cp;
949 cp = find_child_pid (pid);
950 if (cp == NULL)
952 DebPrint (("register_child unable to find pid %lu\n", pid));
953 return;
956 #ifdef FULL_DEBUG
957 DebPrint (("register_child registered fd %d with pid %lu\n", fd, pid));
958 #endif
960 cp->fd = fd;
962 /* thread is initially blocked until select is called; set status so
963 that select will release thread */
964 cp->status = STATUS_READ_ACKNOWLEDGED;
966 /* attach child_process to fd_info */
967 if (fd_info[fd].cp != NULL)
969 DebPrint (("register_child: fd_info[%d] apparently in use!\n", fd));
970 emacs_abort ();
973 fd_info[fd].cp = cp;
976 /* When a process dies its pipe will break so the reader thread will
977 signal failure to the select emulator.
978 The select emulator then calls this routine to clean up.
979 Since the thread signaled failure we can assume it is exiting. */
980 static void
981 reap_subprocess (child_process *cp)
983 if (cp->procinfo.hProcess)
985 /* Reap the process */
986 #ifdef FULL_DEBUG
987 /* Process should have already died before we are called. */
988 if (WaitForSingleObject (cp->procinfo.hProcess, 0) != WAIT_OBJECT_0)
989 DebPrint (("reap_subprocess: child fpr fd %d has not died yet!", cp->fd));
990 #endif
991 CloseHandle (cp->procinfo.hProcess);
992 cp->procinfo.hProcess = NULL;
993 CloseHandle (cp->procinfo.hThread);
994 cp->procinfo.hThread = NULL;
997 /* For asynchronous children, the child_proc resources will be freed
998 when the last pipe read descriptor is closed; for synchronous
999 children, we must explicitly free the resources now because
1000 register_child has not been called. */
1001 if (cp->fd == -1)
1002 delete_child (cp);
1005 /* Wait for any of our existing child processes to die
1006 When it does, close its handle
1007 Return the pid and fill in the status if non-NULL. */
1010 sys_wait (int *status)
1012 DWORD active, retval;
1013 int nh;
1014 int pid;
1015 child_process *cp, *cps[MAX_CHILDREN];
1016 HANDLE wait_hnd[MAX_CHILDREN];
1018 nh = 0;
1019 if (dead_child != NULL)
1021 /* We want to wait for a specific child */
1022 wait_hnd[nh] = dead_child->procinfo.hProcess;
1023 cps[nh] = dead_child;
1024 if (!wait_hnd[nh]) emacs_abort ();
1025 nh++;
1026 active = 0;
1027 goto get_result;
1029 else
1031 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
1032 /* some child_procs might be sockets; ignore them */
1033 if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess
1034 && (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0))
1036 wait_hnd[nh] = cp->procinfo.hProcess;
1037 cps[nh] = cp;
1038 nh++;
1042 if (nh == 0)
1044 /* Nothing to wait on, so fail */
1045 errno = ECHILD;
1046 return -1;
1051 /* Check for quit about once a second. */
1052 QUIT;
1053 active = WaitForMultipleObjects (nh, wait_hnd, FALSE, 1000);
1054 } while (active == WAIT_TIMEOUT);
1056 if (active == WAIT_FAILED)
1058 errno = EBADF;
1059 return -1;
1061 else if (active >= WAIT_OBJECT_0
1062 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
1064 active -= WAIT_OBJECT_0;
1066 else if (active >= WAIT_ABANDONED_0
1067 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
1069 active -= WAIT_ABANDONED_0;
1071 else
1072 emacs_abort ();
1074 get_result:
1075 if (!GetExitCodeProcess (wait_hnd[active], &retval))
1077 DebPrint (("Wait.GetExitCodeProcess failed with %lu\n",
1078 GetLastError ()));
1079 retval = 1;
1081 if (retval == STILL_ACTIVE)
1083 /* Should never happen */
1084 DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
1085 errno = EINVAL;
1086 return -1;
1089 /* Massage the exit code from the process to match the format expected
1090 by the WIFSTOPPED et al macros in syswait.h. Only WIFSIGNALED and
1091 WIFEXITED are supported; WIFSTOPPED doesn't make sense under NT. */
1093 if (retval == STATUS_CONTROL_C_EXIT)
1094 retval = SIGINT;
1095 else
1096 retval <<= 8;
1098 cp = cps[active];
1099 pid = cp->pid;
1100 #ifdef FULL_DEBUG
1101 DebPrint (("Wait signaled with process pid %d\n", cp->pid));
1102 #endif
1104 if (status)
1106 *status = retval;
1108 else if (synch_process_alive)
1110 synch_process_alive = 0;
1112 /* Report the status of the synchronous process. */
1113 if (WIFEXITED (retval))
1114 synch_process_retcode = WEXITSTATUS (retval);
1115 else if (WIFSIGNALED (retval))
1117 int code = WTERMSIG (retval);
1118 char *signame;
1120 synchronize_system_messages_locale ();
1121 signame = strsignal (code);
1123 if (signame == 0)
1124 signame = "unknown";
1126 synch_process_death = signame;
1129 reap_subprocess (cp);
1132 reap_subprocess (cp);
1134 return pid;
1137 /* Old versions of w32api headers don't have separate 32-bit and
1138 64-bit defines, but the one they have matches the 32-bit variety. */
1139 #ifndef IMAGE_NT_OPTIONAL_HDR32_MAGIC
1140 # define IMAGE_NT_OPTIONAL_HDR32_MAGIC IMAGE_NT_OPTIONAL_HDR_MAGIC
1141 # define IMAGE_OPTIONAL_HEADER32 IMAGE_OPTIONAL_HEADER
1142 #endif
1144 static void
1145 w32_executable_type (char * filename,
1146 int * is_dos_app,
1147 int * is_cygnus_app,
1148 int * is_gui_app)
1150 file_data executable;
1151 char * p;
1153 /* Default values in case we can't tell for sure. */
1154 *is_dos_app = FALSE;
1155 *is_cygnus_app = FALSE;
1156 *is_gui_app = FALSE;
1158 if (!open_input_file (&executable, filename))
1159 return;
1161 p = strrchr (filename, '.');
1163 /* We can only identify DOS .com programs from the extension. */
1164 if (p && xstrcasecmp (p, ".com") == 0)
1165 *is_dos_app = TRUE;
1166 else if (p && (xstrcasecmp (p, ".bat") == 0
1167 || xstrcasecmp (p, ".cmd") == 0))
1169 /* A DOS shell script - it appears that CreateProcess is happy to
1170 accept this (somewhat surprisingly); presumably it looks at
1171 COMSPEC to determine what executable to actually invoke.
1172 Therefore, we have to do the same here as well. */
1173 /* Actually, I think it uses the program association for that
1174 extension, which is defined in the registry. */
1175 p = egetenv ("COMSPEC");
1176 if (p)
1177 w32_executable_type (p, is_dos_app, is_cygnus_app, is_gui_app);
1179 else
1181 /* Look for DOS .exe signature - if found, we must also check that
1182 it isn't really a 16- or 32-bit Windows exe, since both formats
1183 start with a DOS program stub. Note that 16-bit Windows
1184 executables use the OS/2 1.x format. */
1186 IMAGE_DOS_HEADER * dos_header;
1187 IMAGE_NT_HEADERS * nt_header;
1189 dos_header = (PIMAGE_DOS_HEADER) executable.file_base;
1190 if (dos_header->e_magic != IMAGE_DOS_SIGNATURE)
1191 goto unwind;
1193 nt_header = (PIMAGE_NT_HEADERS) ((unsigned char *) dos_header + dos_header->e_lfanew);
1195 if ((char *) nt_header > (char *) dos_header + executable.size)
1197 /* Some dos headers (pkunzip) have bogus e_lfanew fields. */
1198 *is_dos_app = TRUE;
1200 else if (nt_header->Signature != IMAGE_NT_SIGNATURE
1201 && LOWORD (nt_header->Signature) != IMAGE_OS2_SIGNATURE)
1203 *is_dos_app = TRUE;
1205 else if (nt_header->Signature == IMAGE_NT_SIGNATURE)
1207 IMAGE_DATA_DIRECTORY *data_dir = NULL;
1208 if (nt_header->OptionalHeader.Magic == IMAGE_NT_OPTIONAL_HDR32_MAGIC)
1210 /* Ensure we are using the 32 bit structure. */
1211 IMAGE_OPTIONAL_HEADER32 *opt
1212 = (IMAGE_OPTIONAL_HEADER32*) &(nt_header->OptionalHeader);
1213 data_dir = opt->DataDirectory;
1214 *is_gui_app = (opt->Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
1216 /* MingW 3.12 has the required 64 bit structs, but in case older
1217 versions don't, only check 64 bit exes if we know how. */
1218 #ifdef IMAGE_NT_OPTIONAL_HDR64_MAGIC
1219 else if (nt_header->OptionalHeader.Magic
1220 == IMAGE_NT_OPTIONAL_HDR64_MAGIC)
1222 IMAGE_OPTIONAL_HEADER64 *opt
1223 = (IMAGE_OPTIONAL_HEADER64*) &(nt_header->OptionalHeader);
1224 data_dir = opt->DataDirectory;
1225 *is_gui_app = (opt->Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
1227 #endif
1228 if (data_dir)
1230 /* Look for cygwin.dll in DLL import list. */
1231 IMAGE_DATA_DIRECTORY import_dir =
1232 data_dir[IMAGE_DIRECTORY_ENTRY_IMPORT];
1233 IMAGE_IMPORT_DESCRIPTOR * imports;
1234 IMAGE_SECTION_HEADER * section;
1236 section = rva_to_section (import_dir.VirtualAddress, nt_header);
1237 imports = RVA_TO_PTR (import_dir.VirtualAddress, section,
1238 executable);
1240 for ( ; imports->Name; imports++)
1242 char * dllname = RVA_TO_PTR (imports->Name, section,
1243 executable);
1245 /* The exact name of the cygwin dll has changed with
1246 various releases, but hopefully this will be reasonably
1247 future proof. */
1248 if (strncmp (dllname, "cygwin", 6) == 0)
1250 *is_cygnus_app = TRUE;
1251 break;
1258 unwind:
1259 close_file_data (&executable);
1262 static int
1263 compare_env (const void *strp1, const void *strp2)
1265 const char *str1 = *(const char **)strp1, *str2 = *(const char **)strp2;
1267 while (*str1 && *str2 && *str1 != '=' && *str2 != '=')
1269 /* Sort order in command.com/cmd.exe is based on uppercasing
1270 names, so do the same here. */
1271 if (toupper (*str1) > toupper (*str2))
1272 return 1;
1273 else if (toupper (*str1) < toupper (*str2))
1274 return -1;
1275 str1++, str2++;
1278 if (*str1 == '=' && *str2 == '=')
1279 return 0;
1280 else if (*str1 == '=')
1281 return -1;
1282 else
1283 return 1;
1286 static void
1287 merge_and_sort_env (char **envp1, char **envp2, char **new_envp)
1289 char **optr, **nptr;
1290 int num;
1292 nptr = new_envp;
1293 optr = envp1;
1294 while (*optr)
1295 *nptr++ = *optr++;
1296 num = optr - envp1;
1298 optr = envp2;
1299 while (*optr)
1300 *nptr++ = *optr++;
1301 num += optr - envp2;
1303 qsort (new_envp, num, sizeof (char *), compare_env);
1305 *nptr = NULL;
1308 /* When a new child process is created we need to register it in our list,
1309 so intercept spawn requests. */
1311 sys_spawnve (int mode, char *cmdname, char **argv, char **envp)
1313 Lisp_Object program, full;
1314 char *cmdline, *env, *parg, **targ;
1315 int arglen, numenv;
1316 int pid;
1317 child_process *cp;
1318 int is_dos_app, is_cygnus_app, is_gui_app;
1319 int do_quoting = 0;
1320 char escape_char;
1321 /* We pass our process ID to our children by setting up an environment
1322 variable in their environment. */
1323 char ppid_env_var_buffer[64];
1324 char *extra_env[] = {ppid_env_var_buffer, NULL};
1325 /* These are the characters that cause an argument to need quoting.
1326 Arguments with whitespace characters need quoting to prevent the
1327 argument being split into two or more. Arguments with wildcards
1328 are also quoted, for consistency with posix platforms, where wildcards
1329 are not expanded if we run the program directly without a shell.
1330 Some extra whitespace characters need quoting in Cygwin programs,
1331 so this list is conditionally modified below. */
1332 char *sepchars = " \t*?";
1334 /* We don't care about the other modes */
1335 if (mode != _P_NOWAIT)
1337 errno = EINVAL;
1338 return -1;
1341 /* Handle executable names without an executable suffix. */
1342 program = build_string (cmdname);
1343 if (NILP (Ffile_executable_p (program)))
1345 struct gcpro gcpro1;
1347 full = Qnil;
1348 GCPRO1 (program);
1349 openp (Vexec_path, program, Vexec_suffixes, &full, make_number (X_OK));
1350 UNGCPRO;
1351 if (NILP (full))
1353 errno = EINVAL;
1354 return -1;
1356 program = full;
1359 /* make sure argv[0] and cmdname are both in DOS format */
1360 cmdname = SDATA (program);
1361 unixtodos_filename (cmdname);
1362 argv[0] = cmdname;
1364 /* Determine whether program is a 16-bit DOS executable, or a 32-bit Windows
1365 executable that is implicitly linked to the Cygnus dll (implying it
1366 was compiled with the Cygnus GNU toolchain and hence relies on
1367 cygwin.dll to parse the command line - we use this to decide how to
1368 escape quote chars in command line args that must be quoted).
1370 Also determine whether it is a GUI app, so that we don't hide its
1371 initial window unless specifically requested. */
1372 w32_executable_type (cmdname, &is_dos_app, &is_cygnus_app, &is_gui_app);
1374 /* On Windows 95, if cmdname is a DOS app, we invoke a helper
1375 application to start it by specifying the helper app as cmdname,
1376 while leaving the real app name as argv[0]. */
1377 if (is_dos_app)
1379 cmdname = alloca (MAXPATHLEN);
1380 if (egetenv ("CMDPROXY"))
1381 strcpy (cmdname, egetenv ("CMDPROXY"));
1382 else
1384 strcpy (cmdname, SDATA (Vinvocation_directory));
1385 strcat (cmdname, "cmdproxy.exe");
1387 unixtodos_filename (cmdname);
1390 /* we have to do some conjuring here to put argv and envp into the
1391 form CreateProcess wants... argv needs to be a space separated/null
1392 terminated list of parameters, and envp is a null
1393 separated/double-null terminated list of parameters.
1395 Additionally, zero-length args and args containing whitespace or
1396 quote chars need to be wrapped in double quotes - for this to work,
1397 embedded quotes need to be escaped as well. The aim is to ensure
1398 the child process reconstructs the argv array we start with
1399 exactly, so we treat quotes at the beginning and end of arguments
1400 as embedded quotes.
1402 The w32 GNU-based library from Cygnus doubles quotes to escape
1403 them, while MSVC uses backslash for escaping. (Actually the MSVC
1404 startup code does attempt to recognize doubled quotes and accept
1405 them, but gets it wrong and ends up requiring three quotes to get a
1406 single embedded quote!) So by default we decide whether to use
1407 quote or backslash as the escape character based on whether the
1408 binary is apparently a Cygnus compiled app.
1410 Note that using backslash to escape embedded quotes requires
1411 additional special handling if an embedded quote is already
1412 preceded by backslash, or if an arg requiring quoting ends with
1413 backslash. In such cases, the run of escape characters needs to be
1414 doubled. For consistency, we apply this special handling as long
1415 as the escape character is not quote.
1417 Since we have no idea how large argv and envp are likely to be we
1418 figure out list lengths on the fly and allocate them. */
1420 if (!NILP (Vw32_quote_process_args))
1422 do_quoting = 1;
1423 /* Override escape char by binding w32-quote-process-args to
1424 desired character, or use t for auto-selection. */
1425 if (INTEGERP (Vw32_quote_process_args))
1426 escape_char = XINT (Vw32_quote_process_args);
1427 else
1428 escape_char = is_cygnus_app ? '"' : '\\';
1431 /* Cygwin apps needs quoting a bit more often. */
1432 if (escape_char == '"')
1433 sepchars = "\r\n\t\f '";
1435 /* do argv... */
1436 arglen = 0;
1437 targ = argv;
1438 while (*targ)
1440 char * p = *targ;
1441 int need_quotes = 0;
1442 int escape_char_run = 0;
1444 if (*p == 0)
1445 need_quotes = 1;
1446 for ( ; *p; p++)
1448 if (escape_char == '"' && *p == '\\')
1449 /* If it's a Cygwin app, \ needs to be escaped. */
1450 arglen++;
1451 else if (*p == '"')
1453 /* allow for embedded quotes to be escaped */
1454 arglen++;
1455 need_quotes = 1;
1456 /* handle the case where the embedded quote is already escaped */
1457 if (escape_char_run > 0)
1459 /* To preserve the arg exactly, we need to double the
1460 preceding escape characters (plus adding one to
1461 escape the quote character itself). */
1462 arglen += escape_char_run;
1465 else if (strchr (sepchars, *p) != NULL)
1467 need_quotes = 1;
1470 if (*p == escape_char && escape_char != '"')
1471 escape_char_run++;
1472 else
1473 escape_char_run = 0;
1475 if (need_quotes)
1477 arglen += 2;
1478 /* handle the case where the arg ends with an escape char - we
1479 must not let the enclosing quote be escaped. */
1480 if (escape_char_run > 0)
1481 arglen += escape_char_run;
1483 arglen += strlen (*targ++) + 1;
1485 cmdline = alloca (arglen);
1486 targ = argv;
1487 parg = cmdline;
1488 while (*targ)
1490 char * p = *targ;
1491 int need_quotes = 0;
1493 if (*p == 0)
1494 need_quotes = 1;
1496 if (do_quoting)
1498 for ( ; *p; p++)
1499 if ((strchr (sepchars, *p) != NULL) || *p == '"')
1500 need_quotes = 1;
1502 if (need_quotes)
1504 int escape_char_run = 0;
1505 char * first;
1506 char * last;
1508 p = *targ;
1509 first = p;
1510 last = p + strlen (p) - 1;
1511 *parg++ = '"';
1512 #if 0
1513 /* This version does not escape quotes if they occur at the
1514 beginning or end of the arg - this could lead to incorrect
1515 behavior when the arg itself represents a command line
1516 containing quoted args. I believe this was originally done
1517 as a hack to make some things work, before
1518 `w32-quote-process-args' was added. */
1519 while (*p)
1521 if (*p == '"' && p > first && p < last)
1522 *parg++ = escape_char; /* escape embedded quotes */
1523 *parg++ = *p++;
1525 #else
1526 for ( ; *p; p++)
1528 if (*p == '"')
1530 /* double preceding escape chars if any */
1531 while (escape_char_run > 0)
1533 *parg++ = escape_char;
1534 escape_char_run--;
1536 /* escape all quote chars, even at beginning or end */
1537 *parg++ = escape_char;
1539 else if (escape_char == '"' && *p == '\\')
1540 *parg++ = '\\';
1541 *parg++ = *p;
1543 if (*p == escape_char && escape_char != '"')
1544 escape_char_run++;
1545 else
1546 escape_char_run = 0;
1548 /* double escape chars before enclosing quote */
1549 while (escape_char_run > 0)
1551 *parg++ = escape_char;
1552 escape_char_run--;
1554 #endif
1555 *parg++ = '"';
1557 else
1559 strcpy (parg, *targ);
1560 parg += strlen (*targ);
1562 *parg++ = ' ';
1563 targ++;
1565 *--parg = '\0';
1567 /* and envp... */
1568 arglen = 1;
1569 targ = envp;
1570 numenv = 1; /* for end null */
1571 while (*targ)
1573 arglen += strlen (*targ++) + 1;
1574 numenv++;
1576 /* extra env vars... */
1577 sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d",
1578 GetCurrentProcessId ());
1579 arglen += strlen (ppid_env_var_buffer) + 1;
1580 numenv++;
1582 /* merge env passed in and extra env into one, and sort it. */
1583 targ = (char **) alloca (numenv * sizeof (char *));
1584 merge_and_sort_env (envp, extra_env, targ);
1586 /* concatenate env entries. */
1587 env = alloca (arglen);
1588 parg = env;
1589 while (*targ)
1591 strcpy (parg, *targ);
1592 parg += strlen (*targ++);
1593 *parg++ = '\0';
1595 *parg++ = '\0';
1596 *parg = '\0';
1598 cp = new_child ();
1599 if (cp == NULL)
1601 errno = EAGAIN;
1602 return -1;
1605 /* Now create the process. */
1606 if (!create_child (cmdname, cmdline, env, is_gui_app, &pid, cp))
1608 delete_child (cp);
1609 errno = ENOEXEC;
1610 return -1;
1613 return pid;
1616 /* Emulate the select call
1617 Wait for available input on any of the given rfds, or timeout if
1618 a timeout is given and no input is detected
1619 wfds and efds are not supported and must be NULL.
1621 For simplicity, we detect the death of child processes here and
1622 synchronously call the SIGCHLD handler. Since it is possible for
1623 children to be created without a corresponding pipe handle from which
1624 to read output, we wait separately on the process handles as well as
1625 the char_avail events for each process pipe. We only call
1626 wait/reap_process when the process actually terminates.
1628 To reduce the number of places in which Emacs can be hung such that
1629 C-g is not able to interrupt it, we always wait on interrupt_handle
1630 (which is signaled by the input thread when C-g is detected). If we
1631 detect that we were woken up by C-g, we return -1 with errno set to
1632 EINTR as on Unix. */
1634 /* From w32console.c */
1635 extern HANDLE keyboard_handle;
1637 /* From w32xfns.c */
1638 extern HANDLE interrupt_handle;
1640 /* From process.c */
1641 extern int proc_buffered_char[];
1644 sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
1645 EMACS_TIME *timeout, void *ignored)
1647 SELECT_TYPE orfds;
1648 DWORD timeout_ms, start_time;
1649 int i, nh, nc, nr;
1650 DWORD active;
1651 child_process *cp, *cps[MAX_CHILDREN];
1652 HANDLE wait_hnd[MAXDESC + MAX_CHILDREN];
1653 int fdindex[MAXDESC]; /* mapping from wait handles back to descriptors */
1655 timeout_ms =
1656 timeout ? (timeout->tv_sec * 1000 + timeout->tv_nsec / 1000000) : INFINITE;
1658 /* If the descriptor sets are NULL but timeout isn't, then just Sleep. */
1659 if (rfds == NULL && wfds == NULL && efds == NULL && timeout != NULL)
1661 Sleep (timeout_ms);
1662 return 0;
1665 /* Otherwise, we only handle rfds, so fail otherwise. */
1666 if (rfds == NULL || wfds != NULL || efds != NULL)
1668 errno = EINVAL;
1669 return -1;
1672 orfds = *rfds;
1673 FD_ZERO (rfds);
1674 nr = 0;
1676 /* Always wait on interrupt_handle, to detect C-g (quit). */
1677 wait_hnd[0] = interrupt_handle;
1678 fdindex[0] = -1;
1680 /* Build a list of pipe handles to wait on. */
1681 nh = 1;
1682 for (i = 0; i < nfds; i++)
1683 if (FD_ISSET (i, &orfds))
1685 if (i == 0)
1687 if (keyboard_handle)
1689 /* Handle stdin specially */
1690 wait_hnd[nh] = keyboard_handle;
1691 fdindex[nh] = i;
1692 nh++;
1695 /* Check for any emacs-generated input in the queue since
1696 it won't be detected in the wait */
1697 if (detect_input_pending ())
1699 FD_SET (i, rfds);
1700 return 1;
1703 else
1705 /* Child process and socket input */
1706 cp = fd_info[i].cp;
1707 if (cp)
1709 int current_status = cp->status;
1711 if (current_status == STATUS_READ_ACKNOWLEDGED)
1713 /* Tell reader thread which file handle to use. */
1714 cp->fd = i;
1715 /* Wake up the reader thread for this process */
1716 cp->status = STATUS_READ_READY;
1717 if (!SetEvent (cp->char_consumed))
1718 DebPrint (("nt_select.SetEvent failed with "
1719 "%lu for fd %ld\n", GetLastError (), i));
1722 #ifdef CHECK_INTERLOCK
1723 /* slightly crude cross-checking of interlock between threads */
1725 current_status = cp->status;
1726 if (WaitForSingleObject (cp->char_avail, 0) == WAIT_OBJECT_0)
1728 /* char_avail has been signaled, so status (which may
1729 have changed) should indicate read has completed
1730 but has not been acknowledged. */
1731 current_status = cp->status;
1732 if (current_status != STATUS_READ_SUCCEEDED
1733 && current_status != STATUS_READ_FAILED)
1734 DebPrint (("char_avail set, but read not completed: status %d\n",
1735 current_status));
1737 else
1739 /* char_avail has not been signaled, so status should
1740 indicate that read is in progress; small possibility
1741 that read has completed but event wasn't yet signaled
1742 when we tested it (because a context switch occurred
1743 or if running on separate CPUs). */
1744 if (current_status != STATUS_READ_READY
1745 && current_status != STATUS_READ_IN_PROGRESS
1746 && current_status != STATUS_READ_SUCCEEDED
1747 && current_status != STATUS_READ_FAILED)
1748 DebPrint (("char_avail reset, but read status is bad: %d\n",
1749 current_status));
1751 #endif
1752 wait_hnd[nh] = cp->char_avail;
1753 fdindex[nh] = i;
1754 if (!wait_hnd[nh]) emacs_abort ();
1755 nh++;
1756 #ifdef FULL_DEBUG
1757 DebPrint (("select waiting on child %d fd %d\n",
1758 cp-child_procs, i));
1759 #endif
1761 else
1763 /* Unable to find something to wait on for this fd, skip */
1765 /* Note that this is not a fatal error, and can in fact
1766 happen in unusual circumstances. Specifically, if
1767 sys_spawnve fails, eg. because the program doesn't
1768 exist, and debug-on-error is t so Fsignal invokes a
1769 nested input loop, then the process output pipe is
1770 still included in input_wait_mask with no child_proc
1771 associated with it. (It is removed when the debugger
1772 exits the nested input loop and the error is thrown.) */
1774 DebPrint (("sys_select: fd %ld is invalid! ignoring\n", i));
1779 count_children:
1780 /* Add handles of child processes. */
1781 nc = 0;
1782 for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--)
1783 /* Some child_procs might be sockets; ignore them. Also some
1784 children may have died already, but we haven't finished reading
1785 the process output; ignore them too. */
1786 if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess
1787 && (cp->fd < 0
1788 || (fd_info[cp->fd].flags & FILE_SEND_SIGCHLD) == 0
1789 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0)
1792 wait_hnd[nh + nc] = cp->procinfo.hProcess;
1793 cps[nc] = cp;
1794 nc++;
1797 /* Nothing to look for, so we didn't find anything */
1798 if (nh + nc == 0)
1800 if (timeout)
1801 Sleep (timeout_ms);
1802 return 0;
1805 start_time = GetTickCount ();
1807 /* Wait for input or child death to be signaled. If user input is
1808 allowed, then also accept window messages. */
1809 if (FD_ISSET (0, &orfds))
1810 active = MsgWaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms,
1811 QS_ALLINPUT);
1812 else
1813 active = WaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms);
1815 if (active == WAIT_FAILED)
1817 DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n",
1818 nh + nc, timeout_ms, GetLastError ()));
1819 /* don't return EBADF - this causes wait_reading_process_output to
1820 abort; WAIT_FAILED is returned when single-stepping under
1821 Windows 95 after switching thread focus in debugger, and
1822 possibly at other times. */
1823 errno = EINTR;
1824 return -1;
1826 else if (active == WAIT_TIMEOUT)
1828 return 0;
1830 else if (active >= WAIT_OBJECT_0
1831 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
1833 active -= WAIT_OBJECT_0;
1835 else if (active >= WAIT_ABANDONED_0
1836 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
1838 active -= WAIT_ABANDONED_0;
1840 else
1841 emacs_abort ();
1843 /* Loop over all handles after active (now officially documented as
1844 being the first signaled handle in the array). We do this to
1845 ensure fairness, so that all channels with data available will be
1846 processed - otherwise higher numbered channels could be starved. */
1849 if (active == nh + nc)
1851 /* There are messages in the lisp thread's queue; we must
1852 drain the queue now to ensure they are processed promptly,
1853 because if we don't do so, we will not be woken again until
1854 further messages arrive.
1856 NB. If ever we allow window message procedures to callback
1857 into lisp, we will need to ensure messages are dispatched
1858 at a safe time for lisp code to be run (*), and we may also
1859 want to provide some hooks in the dispatch loop to cater
1860 for modeless dialogs created by lisp (ie. to register
1861 window handles to pass to IsDialogMessage).
1863 (*) Note that MsgWaitForMultipleObjects above is an
1864 internal dispatch point for messages that are sent to
1865 windows created by this thread. */
1866 drain_message_queue ();
1868 else if (active >= nh)
1870 cp = cps[active - nh];
1872 /* We cannot always signal SIGCHLD immediately; if we have not
1873 finished reading the process output, we must delay sending
1874 SIGCHLD until we do. */
1876 if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_AT_EOF) == 0)
1877 fd_info[cp->fd].flags |= FILE_SEND_SIGCHLD;
1878 /* SIG_DFL for SIGCHLD is ignore */
1879 else if (sig_handlers[SIGCHLD] != SIG_DFL &&
1880 sig_handlers[SIGCHLD] != SIG_IGN)
1882 #ifdef FULL_DEBUG
1883 DebPrint (("select calling SIGCHLD handler for pid %d\n",
1884 cp->pid));
1885 #endif
1886 dead_child = cp;
1887 sig_handlers[SIGCHLD] (SIGCHLD);
1888 dead_child = NULL;
1891 else if (fdindex[active] == -1)
1893 /* Quit (C-g) was detected. */
1894 errno = EINTR;
1895 return -1;
1897 else if (fdindex[active] == 0)
1899 /* Keyboard input available */
1900 FD_SET (0, rfds);
1901 nr++;
1903 else
1905 /* must be a socket or pipe - read ahead should have
1906 completed, either succeeding or failing. */
1907 FD_SET (fdindex[active], rfds);
1908 nr++;
1911 /* Even though wait_reading_process_output only reads from at most
1912 one channel, we must process all channels here so that we reap
1913 all children that have died. */
1914 while (++active < nh + nc)
1915 if (WaitForSingleObject (wait_hnd[active], 0) == WAIT_OBJECT_0)
1916 break;
1917 } while (active < nh + nc);
1919 /* If no input has arrived and timeout hasn't expired, wait again. */
1920 if (nr == 0)
1922 DWORD elapsed = GetTickCount () - start_time;
1924 if (timeout_ms > elapsed) /* INFINITE is MAX_UINT */
1926 if (timeout_ms != INFINITE)
1927 timeout_ms -= elapsed;
1928 goto count_children;
1932 return nr;
1935 /* Substitute for certain kill () operations */
1937 static BOOL CALLBACK
1938 find_child_console (HWND hwnd, LPARAM arg)
1940 child_process * cp = (child_process *) arg;
1941 DWORD thread_id;
1942 DWORD process_id;
1944 thread_id = GetWindowThreadProcessId (hwnd, &process_id);
1945 if (process_id == cp->procinfo.dwProcessId)
1947 char window_class[32];
1949 GetClassName (hwnd, window_class, sizeof (window_class));
1950 if (strcmp (window_class,
1951 (os_subtype == OS_9X)
1952 ? "tty"
1953 : "ConsoleWindowClass") == 0)
1955 cp->hwnd = hwnd;
1956 return FALSE;
1959 /* keep looking */
1960 return TRUE;
1963 /* Emulate 'kill', but only for other processes. */
1965 sys_kill (int pid, int sig)
1967 child_process *cp;
1968 HANDLE proc_hand;
1969 int need_to_free = 0;
1970 int rc = 0;
1972 /* Only handle signals that will result in the process dying */
1973 if (sig != SIGINT && sig != SIGKILL && sig != SIGQUIT && sig != SIGHUP)
1975 errno = EINVAL;
1976 return -1;
1979 cp = find_child_pid (pid);
1980 if (cp == NULL)
1982 /* We were passed a PID of something other than our subprocess.
1983 If that is our own PID, we will send to ourself a message to
1984 close the selected frame, which does not necessarily
1985 terminates Emacs. But then we are not supposed to call
1986 sys_kill with our own PID. */
1987 proc_hand = OpenProcess (PROCESS_TERMINATE, 0, pid);
1988 if (proc_hand == NULL)
1990 errno = EPERM;
1991 return -1;
1993 need_to_free = 1;
1995 else
1997 proc_hand = cp->procinfo.hProcess;
1998 pid = cp->procinfo.dwProcessId;
2000 /* Try to locate console window for process. */
2001 EnumWindows (find_child_console, (LPARAM) cp);
2004 if (sig == SIGINT || sig == SIGQUIT)
2006 if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
2008 BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0);
2009 /* Fake Ctrl-C for SIGINT, and Ctrl-Break for SIGQUIT. */
2010 BYTE vk_break_code = (sig == SIGINT) ? 'C' : VK_CANCEL;
2011 BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
2012 HWND foreground_window;
2014 if (break_scan_code == 0)
2016 /* Fake Ctrl-C for SIGQUIT if we can't manage Ctrl-Break. */
2017 vk_break_code = 'C';
2018 break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
2021 foreground_window = GetForegroundWindow ();
2022 if (foreground_window)
2024 /* NT 5.0, and apparently also Windows 98, will not allow
2025 a Window to be set to foreground directly without the
2026 user's involvement. The workaround is to attach
2027 ourselves to the thread that owns the foreground
2028 window, since that is the only thread that can set the
2029 foreground window. */
2030 DWORD foreground_thread, child_thread;
2031 foreground_thread =
2032 GetWindowThreadProcessId (foreground_window, NULL);
2033 if (foreground_thread == GetCurrentThreadId ()
2034 || !AttachThreadInput (GetCurrentThreadId (),
2035 foreground_thread, TRUE))
2036 foreground_thread = 0;
2038 child_thread = GetWindowThreadProcessId (cp->hwnd, NULL);
2039 if (child_thread == GetCurrentThreadId ()
2040 || !AttachThreadInput (GetCurrentThreadId (),
2041 child_thread, TRUE))
2042 child_thread = 0;
2044 /* Set the foreground window to the child. */
2045 if (SetForegroundWindow (cp->hwnd))
2047 /* Generate keystrokes as if user had typed Ctrl-Break or
2048 Ctrl-C. */
2049 keybd_event (VK_CONTROL, control_scan_code, 0, 0);
2050 keybd_event (vk_break_code, break_scan_code,
2051 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0);
2052 keybd_event (vk_break_code, break_scan_code,
2053 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY)
2054 | KEYEVENTF_KEYUP, 0);
2055 keybd_event (VK_CONTROL, control_scan_code,
2056 KEYEVENTF_KEYUP, 0);
2058 /* Sleep for a bit to give time for Emacs frame to respond
2059 to focus change events (if Emacs was active app). */
2060 Sleep (100);
2062 SetForegroundWindow (foreground_window);
2064 /* Detach from the foreground and child threads now that
2065 the foreground switching is over. */
2066 if (foreground_thread)
2067 AttachThreadInput (GetCurrentThreadId (),
2068 foreground_thread, FALSE);
2069 if (child_thread)
2070 AttachThreadInput (GetCurrentThreadId (),
2071 child_thread, FALSE);
2074 /* Ctrl-Break is NT equivalent of SIGINT. */
2075 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid))
2077 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
2078 "for pid %lu\n", GetLastError (), pid));
2079 errno = EINVAL;
2080 rc = -1;
2083 else
2085 if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
2087 #if 1
2088 if (os_subtype == OS_9X)
2091 Another possibility is to try terminating the VDM out-right by
2092 calling the Shell VxD (id 0x17) V86 interface, function #4
2093 "SHELL_Destroy_VM", ie.
2095 mov edx,4
2096 mov ebx,vm_handle
2097 call shellapi
2099 First need to determine the current VM handle, and then arrange for
2100 the shellapi call to be made from the system vm (by using
2101 Switch_VM_and_callback).
2103 Could try to invoke DestroyVM through CallVxD.
2106 #if 0
2107 /* On Windows 95, posting WM_QUIT causes the 16-bit subsystem
2108 to hang when cmdproxy is used in conjunction with
2109 command.com for an interactive shell. Posting
2110 WM_CLOSE pops up a dialog that, when Yes is selected,
2111 does the same thing. TerminateProcess is also less
2112 than ideal in that subprocesses tend to stick around
2113 until the machine is shutdown, but at least it
2114 doesn't freeze the 16-bit subsystem. */
2115 PostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
2116 #endif
2117 if (!TerminateProcess (proc_hand, 0xff))
2119 DebPrint (("sys_kill.TerminateProcess returned %d "
2120 "for pid %lu\n", GetLastError (), pid));
2121 errno = EINVAL;
2122 rc = -1;
2125 else
2126 #endif
2127 PostMessage (cp->hwnd, WM_CLOSE, 0, 0);
2129 /* Kill the process. On W32 this doesn't kill child processes
2130 so it doesn't work very well for shells which is why it's not
2131 used in every case. */
2132 else if (!TerminateProcess (proc_hand, 0xff))
2134 DebPrint (("sys_kill.TerminateProcess returned %d "
2135 "for pid %lu\n", GetLastError (), pid));
2136 errno = EINVAL;
2137 rc = -1;
2141 if (need_to_free)
2142 CloseHandle (proc_hand);
2144 return rc;
2147 /* The following two routines are used to manipulate stdin, stdout, and
2148 stderr of our child processes.
2150 Assuming that in, out, and err are *not* inheritable, we make them
2151 stdin, stdout, and stderr of the child as follows:
2153 - Save the parent's current standard handles.
2154 - Set the std handles to inheritable duplicates of the ones being passed in.
2155 (Note that _get_osfhandle() is an io.h procedure that retrieves the
2156 NT file handle for a crt file descriptor.)
2157 - Spawn the child, which inherits in, out, and err as stdin,
2158 stdout, and stderr. (see Spawnve)
2159 - Close the std handles passed to the child.
2160 - Reset the parent's standard handles to the saved handles.
2161 (see reset_standard_handles)
2162 We assume that the caller closes in, out, and err after calling us. */
2164 void
2165 prepare_standard_handles (int in, int out, int err, HANDLE handles[3])
2167 HANDLE parent;
2168 HANDLE newstdin, newstdout, newstderr;
2170 parent = GetCurrentProcess ();
2172 handles[0] = GetStdHandle (STD_INPUT_HANDLE);
2173 handles[1] = GetStdHandle (STD_OUTPUT_HANDLE);
2174 handles[2] = GetStdHandle (STD_ERROR_HANDLE);
2176 /* make inheritable copies of the new handles */
2177 if (!DuplicateHandle (parent,
2178 (HANDLE) _get_osfhandle (in),
2179 parent,
2180 &newstdin,
2182 TRUE,
2183 DUPLICATE_SAME_ACCESS))
2184 report_file_error ("Duplicating input handle for child", Qnil);
2186 if (!DuplicateHandle (parent,
2187 (HANDLE) _get_osfhandle (out),
2188 parent,
2189 &newstdout,
2191 TRUE,
2192 DUPLICATE_SAME_ACCESS))
2193 report_file_error ("Duplicating output handle for child", Qnil);
2195 if (!DuplicateHandle (parent,
2196 (HANDLE) _get_osfhandle (err),
2197 parent,
2198 &newstderr,
2200 TRUE,
2201 DUPLICATE_SAME_ACCESS))
2202 report_file_error ("Duplicating error handle for child", Qnil);
2204 /* and store them as our std handles */
2205 if (!SetStdHandle (STD_INPUT_HANDLE, newstdin))
2206 report_file_error ("Changing stdin handle", Qnil);
2208 if (!SetStdHandle (STD_OUTPUT_HANDLE, newstdout))
2209 report_file_error ("Changing stdout handle", Qnil);
2211 if (!SetStdHandle (STD_ERROR_HANDLE, newstderr))
2212 report_file_error ("Changing stderr handle", Qnil);
2215 void
2216 reset_standard_handles (int in, int out, int err, HANDLE handles[3])
2218 /* close the duplicated handles passed to the child */
2219 CloseHandle (GetStdHandle (STD_INPUT_HANDLE));
2220 CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE));
2221 CloseHandle (GetStdHandle (STD_ERROR_HANDLE));
2223 /* now restore parent's saved std handles */
2224 SetStdHandle (STD_INPUT_HANDLE, handles[0]);
2225 SetStdHandle (STD_OUTPUT_HANDLE, handles[1]);
2226 SetStdHandle (STD_ERROR_HANDLE, handles[2]);
2229 void
2230 set_process_dir (char * dir)
2232 process_dir = dir;
2235 /* To avoid problems with winsock implementations that work over dial-up
2236 connections causing or requiring a connection to exist while Emacs is
2237 running, Emacs no longer automatically loads winsock on startup if it
2238 is present. Instead, it will be loaded when open-network-stream is
2239 first called.
2241 To allow full control over when winsock is loaded, we provide these
2242 two functions to dynamically load and unload winsock. This allows
2243 dial-up users to only be connected when they actually need to use
2244 socket services. */
2246 /* From w32.c */
2247 extern HANDLE winsock_lib;
2248 extern BOOL term_winsock (void);
2249 extern BOOL init_winsock (int load_now);
2251 DEFUN ("w32-has-winsock", Fw32_has_winsock, Sw32_has_winsock, 0, 1, 0,
2252 doc: /* Test for presence of the Windows socket library `winsock'.
2253 Returns non-nil if winsock support is present, nil otherwise.
2255 If the optional argument LOAD-NOW is non-nil, the winsock library is
2256 also loaded immediately if not already loaded. If winsock is loaded,
2257 the winsock local hostname is returned (since this may be different from
2258 the value of `system-name' and should supplant it), otherwise t is
2259 returned to indicate winsock support is present. */)
2260 (Lisp_Object load_now)
2262 int have_winsock;
2264 have_winsock = init_winsock (!NILP (load_now));
2265 if (have_winsock)
2267 if (winsock_lib != NULL)
2269 /* Return new value for system-name. The best way to do this
2270 is to call init_system_name, saving and restoring the
2271 original value to avoid side-effects. */
2272 Lisp_Object orig_hostname = Vsystem_name;
2273 Lisp_Object hostname;
2275 init_system_name ();
2276 hostname = Vsystem_name;
2277 Vsystem_name = orig_hostname;
2278 return hostname;
2280 return Qt;
2282 return Qnil;
2285 DEFUN ("w32-unload-winsock", Fw32_unload_winsock, Sw32_unload_winsock,
2286 0, 0, 0,
2287 doc: /* Unload the Windows socket library `winsock' if loaded.
2288 This is provided to allow dial-up socket connections to be disconnected
2289 when no longer needed. Returns nil without unloading winsock if any
2290 socket connections still exist. */)
2291 (void)
2293 return term_winsock () ? Qt : Qnil;
2297 /* Some miscellaneous functions that are Windows specific, but not GUI
2298 specific (ie. are applicable in terminal or batch mode as well). */
2300 DEFUN ("w32-short-file-name", Fw32_short_file_name, Sw32_short_file_name, 1, 1, 0,
2301 doc: /* Return the short file name version (8.3) of the full path of FILENAME.
2302 If FILENAME does not exist, return nil.
2303 All path elements in FILENAME are converted to their short names. */)
2304 (Lisp_Object filename)
2306 char shortname[MAX_PATH];
2308 CHECK_STRING (filename);
2310 /* first expand it. */
2311 filename = Fexpand_file_name (filename, Qnil);
2313 /* luckily, this returns the short version of each element in the path. */
2314 if (GetShortPathName (SDATA (ENCODE_FILE (filename)), shortname, MAX_PATH) == 0)
2315 return Qnil;
2317 dostounix_filename (shortname);
2319 return build_string (shortname);
2323 DEFUN ("w32-long-file-name", Fw32_long_file_name, Sw32_long_file_name,
2324 1, 1, 0,
2325 doc: /* Return the long file name version of the full path of FILENAME.
2326 If FILENAME does not exist, return nil.
2327 All path elements in FILENAME are converted to their long names. */)
2328 (Lisp_Object filename)
2330 char longname[ MAX_PATH ];
2331 int drive_only = 0;
2333 CHECK_STRING (filename);
2335 if (SBYTES (filename) == 2
2336 && *(SDATA (filename) + 1) == ':')
2337 drive_only = 1;
2339 /* first expand it. */
2340 filename = Fexpand_file_name (filename, Qnil);
2342 if (!w32_get_long_filename (SDATA (ENCODE_FILE (filename)), longname, MAX_PATH))
2343 return Qnil;
2345 dostounix_filename (longname);
2347 /* If we were passed only a drive, make sure that a slash is not appended
2348 for consistency with directories. Allow for drive mapping via SUBST
2349 in case expand-file-name is ever changed to expand those. */
2350 if (drive_only && longname[1] == ':' && longname[2] == '/' && !longname[3])
2351 longname[2] = '\0';
2353 return DECODE_FILE (build_string (longname));
2356 DEFUN ("w32-set-process-priority", Fw32_set_process_priority,
2357 Sw32_set_process_priority, 2, 2, 0,
2358 doc: /* Set the priority of PROCESS to PRIORITY.
2359 If PROCESS is nil, the priority of Emacs is changed, otherwise the
2360 priority of the process whose pid is PROCESS is changed.
2361 PRIORITY should be one of the symbols high, normal, or low;
2362 any other symbol will be interpreted as normal.
2364 If successful, the return value is t, otherwise nil. */)
2365 (Lisp_Object process, Lisp_Object priority)
2367 HANDLE proc_handle = GetCurrentProcess ();
2368 DWORD priority_class = NORMAL_PRIORITY_CLASS;
2369 Lisp_Object result = Qnil;
2371 CHECK_SYMBOL (priority);
2373 if (!NILP (process))
2375 DWORD pid;
2376 child_process *cp;
2378 CHECK_NUMBER (process);
2380 /* Allow pid to be an internally generated one, or one obtained
2381 externally. This is necessary because real pids on Windows 95 are
2382 negative. */
2384 pid = XINT (process);
2385 cp = find_child_pid (pid);
2386 if (cp != NULL)
2387 pid = cp->procinfo.dwProcessId;
2389 proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
2392 if (EQ (priority, Qhigh))
2393 priority_class = HIGH_PRIORITY_CLASS;
2394 else if (EQ (priority, Qlow))
2395 priority_class = IDLE_PRIORITY_CLASS;
2397 if (proc_handle != NULL)
2399 if (SetPriorityClass (proc_handle, priority_class))
2400 result = Qt;
2401 if (!NILP (process))
2402 CloseHandle (proc_handle);
2405 return result;
2408 #ifdef HAVE_LANGINFO_CODESET
2409 /* Emulation of nl_langinfo. Used in fns.c:Flocale_info. */
2410 char *
2411 nl_langinfo (nl_item item)
2413 /* Conversion of Posix item numbers to their Windows equivalents. */
2414 static const LCTYPE w32item[] = {
2415 LOCALE_IDEFAULTANSICODEPAGE,
2416 LOCALE_SDAYNAME1, LOCALE_SDAYNAME2, LOCALE_SDAYNAME3,
2417 LOCALE_SDAYNAME4, LOCALE_SDAYNAME5, LOCALE_SDAYNAME6, LOCALE_SDAYNAME7,
2418 LOCALE_SMONTHNAME1, LOCALE_SMONTHNAME2, LOCALE_SMONTHNAME3,
2419 LOCALE_SMONTHNAME4, LOCALE_SMONTHNAME5, LOCALE_SMONTHNAME6,
2420 LOCALE_SMONTHNAME7, LOCALE_SMONTHNAME8, LOCALE_SMONTHNAME9,
2421 LOCALE_SMONTHNAME10, LOCALE_SMONTHNAME11, LOCALE_SMONTHNAME12
2424 static char *nl_langinfo_buf = NULL;
2425 static int nl_langinfo_len = 0;
2427 if (nl_langinfo_len <= 0)
2428 nl_langinfo_buf = xmalloc (nl_langinfo_len = 1);
2430 if (item < 0 || item >= _NL_NUM)
2431 nl_langinfo_buf[0] = 0;
2432 else
2434 LCID cloc = GetThreadLocale ();
2435 int need_len = GetLocaleInfo (cloc, w32item[item] | LOCALE_USE_CP_ACP,
2436 NULL, 0);
2438 if (need_len <= 0)
2439 nl_langinfo_buf[0] = 0;
2440 else
2442 if (item == CODESET)
2444 need_len += 2; /* for the "cp" prefix */
2445 if (need_len < 8) /* for the case we call GetACP */
2446 need_len = 8;
2448 if (nl_langinfo_len <= need_len)
2449 nl_langinfo_buf = xrealloc (nl_langinfo_buf,
2450 nl_langinfo_len = need_len);
2451 if (!GetLocaleInfo (cloc, w32item[item] | LOCALE_USE_CP_ACP,
2452 nl_langinfo_buf, nl_langinfo_len))
2453 nl_langinfo_buf[0] = 0;
2454 else if (item == CODESET)
2456 if (strcmp (nl_langinfo_buf, "0") == 0 /* CP_ACP */
2457 || strcmp (nl_langinfo_buf, "1") == 0) /* CP_OEMCP */
2458 sprintf (nl_langinfo_buf, "cp%u", GetACP ());
2459 else
2461 memmove (nl_langinfo_buf + 2, nl_langinfo_buf,
2462 strlen (nl_langinfo_buf) + 1);
2463 nl_langinfo_buf[0] = 'c';
2464 nl_langinfo_buf[1] = 'p';
2469 return nl_langinfo_buf;
2471 #endif /* HAVE_LANGINFO_CODESET */
2473 DEFUN ("w32-get-locale-info", Fw32_get_locale_info,
2474 Sw32_get_locale_info, 1, 2, 0,
2475 doc: /* Return information about the Windows locale LCID.
2476 By default, return a three letter locale code which encodes the default
2477 language as the first two characters, and the country or regional variant
2478 as the third letter. For example, ENU refers to `English (United States)',
2479 while ENC means `English (Canadian)'.
2481 If the optional argument LONGFORM is t, the long form of the locale
2482 name is returned, e.g. `English (United States)' instead; if LONGFORM
2483 is a number, it is interpreted as an LCTYPE constant and the corresponding
2484 locale information is returned.
2486 If LCID (a 16-bit number) is not a valid locale, the result is nil. */)
2487 (Lisp_Object lcid, Lisp_Object longform)
2489 int got_abbrev;
2490 int got_full;
2491 char abbrev_name[32] = { 0 };
2492 char full_name[256] = { 0 };
2494 CHECK_NUMBER (lcid);
2496 if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
2497 return Qnil;
2499 if (NILP (longform))
2501 got_abbrev = GetLocaleInfo (XINT (lcid),
2502 LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
2503 abbrev_name, sizeof (abbrev_name));
2504 if (got_abbrev)
2505 return build_string (abbrev_name);
2507 else if (EQ (longform, Qt))
2509 got_full = GetLocaleInfo (XINT (lcid),
2510 LOCALE_SLANGUAGE | LOCALE_USE_CP_ACP,
2511 full_name, sizeof (full_name));
2512 if (got_full)
2513 return DECODE_SYSTEM (build_string (full_name));
2515 else if (NUMBERP (longform))
2517 got_full = GetLocaleInfo (XINT (lcid),
2518 XINT (longform),
2519 full_name, sizeof (full_name));
2520 /* GetLocaleInfo's return value includes the terminating null
2521 character, when the returned information is a string, whereas
2522 make_unibyte_string needs the string length without the
2523 terminating null. */
2524 if (got_full)
2525 return make_unibyte_string (full_name, got_full - 1);
2528 return Qnil;
2532 DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id,
2533 Sw32_get_current_locale_id, 0, 0, 0,
2534 doc: /* Return Windows locale id for current locale setting.
2535 This is a numerical value; use `w32-get-locale-info' to convert to a
2536 human-readable form. */)
2537 (void)
2539 return make_number (GetThreadLocale ());
2542 static DWORD
2543 int_from_hex (char * s)
2545 DWORD val = 0;
2546 static char hex[] = "0123456789abcdefABCDEF";
2547 char * p;
2549 while (*s && (p = strchr (hex, *s)) != NULL)
2551 unsigned digit = p - hex;
2552 if (digit > 15)
2553 digit -= 6;
2554 val = val * 16 + digit;
2555 s++;
2557 return val;
2560 /* We need to build a global list, since the EnumSystemLocale callback
2561 function isn't given a context pointer. */
2562 Lisp_Object Vw32_valid_locale_ids;
2564 static BOOL CALLBACK
2565 enum_locale_fn (LPTSTR localeNum)
2567 DWORD id = int_from_hex (localeNum);
2568 Vw32_valid_locale_ids = Fcons (make_number (id), Vw32_valid_locale_ids);
2569 return TRUE;
2572 DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids,
2573 Sw32_get_valid_locale_ids, 0, 0, 0,
2574 doc: /* Return list of all valid Windows locale ids.
2575 Each id is a numerical value; use `w32-get-locale-info' to convert to a
2576 human-readable form. */)
2577 (void)
2579 Vw32_valid_locale_ids = Qnil;
2581 EnumSystemLocales (enum_locale_fn, LCID_SUPPORTED);
2583 Vw32_valid_locale_ids = Fnreverse (Vw32_valid_locale_ids);
2584 return Vw32_valid_locale_ids;
2588 DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id, Sw32_get_default_locale_id, 0, 1, 0,
2589 doc: /* Return Windows locale id for default locale setting.
2590 By default, the system default locale setting is returned; if the optional
2591 parameter USERP is non-nil, the user default locale setting is returned.
2592 This is a numerical value; use `w32-get-locale-info' to convert to a
2593 human-readable form. */)
2594 (Lisp_Object userp)
2596 if (NILP (userp))
2597 return make_number (GetSystemDefaultLCID ());
2598 return make_number (GetUserDefaultLCID ());
2602 DEFUN ("w32-set-current-locale", Fw32_set_current_locale, Sw32_set_current_locale, 1, 1, 0,
2603 doc: /* Make Windows locale LCID be the current locale setting for Emacs.
2604 If successful, the new locale id is returned, otherwise nil. */)
2605 (Lisp_Object lcid)
2607 CHECK_NUMBER (lcid);
2609 if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
2610 return Qnil;
2612 if (!SetThreadLocale (XINT (lcid)))
2613 return Qnil;
2615 /* Need to set input thread locale if present. */
2616 if (dwWindowsThreadId)
2617 /* Reply is not needed. */
2618 PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0);
2620 return make_number (GetThreadLocale ());
2624 /* We need to build a global list, since the EnumCodePages callback
2625 function isn't given a context pointer. */
2626 Lisp_Object Vw32_valid_codepages;
2628 static BOOL CALLBACK
2629 enum_codepage_fn (LPTSTR codepageNum)
2631 DWORD id = atoi (codepageNum);
2632 Vw32_valid_codepages = Fcons (make_number (id), Vw32_valid_codepages);
2633 return TRUE;
2636 DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages,
2637 Sw32_get_valid_codepages, 0, 0, 0,
2638 doc: /* Return list of all valid Windows codepages. */)
2639 (void)
2641 Vw32_valid_codepages = Qnil;
2643 EnumSystemCodePages (enum_codepage_fn, CP_SUPPORTED);
2645 Vw32_valid_codepages = Fnreverse (Vw32_valid_codepages);
2646 return Vw32_valid_codepages;
2650 DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage,
2651 Sw32_get_console_codepage, 0, 0, 0,
2652 doc: /* Return current Windows codepage for console input. */)
2653 (void)
2655 return make_number (GetConsoleCP ());
2659 DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage,
2660 Sw32_set_console_codepage, 1, 1, 0,
2661 doc: /* Make Windows codepage CP be the codepage for Emacs tty keyboard input.
2662 This codepage setting affects keyboard input in tty mode.
2663 If successful, the new CP is returned, otherwise nil. */)
2664 (Lisp_Object cp)
2666 CHECK_NUMBER (cp);
2668 if (!IsValidCodePage (XINT (cp)))
2669 return Qnil;
2671 if (!SetConsoleCP (XINT (cp)))
2672 return Qnil;
2674 return make_number (GetConsoleCP ());
2678 DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage,
2679 Sw32_get_console_output_codepage, 0, 0, 0,
2680 doc: /* Return current Windows codepage for console output. */)
2681 (void)
2683 return make_number (GetConsoleOutputCP ());
2687 DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage,
2688 Sw32_set_console_output_codepage, 1, 1, 0,
2689 doc: /* Make Windows codepage CP be the codepage for Emacs console output.
2690 This codepage setting affects display in tty mode.
2691 If successful, the new CP is returned, otherwise nil. */)
2692 (Lisp_Object cp)
2694 CHECK_NUMBER (cp);
2696 if (!IsValidCodePage (XINT (cp)))
2697 return Qnil;
2699 if (!SetConsoleOutputCP (XINT (cp)))
2700 return Qnil;
2702 return make_number (GetConsoleOutputCP ());
2706 DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset,
2707 Sw32_get_codepage_charset, 1, 1, 0,
2708 doc: /* Return charset ID corresponding to codepage CP.
2709 Returns nil if the codepage is not valid. */)
2710 (Lisp_Object cp)
2712 CHARSETINFO info;
2714 CHECK_NUMBER (cp);
2716 if (!IsValidCodePage (XINT (cp)))
2717 return Qnil;
2719 if (TranslateCharsetInfo ((DWORD *) XINT (cp), &info, TCI_SRCCODEPAGE))
2720 return make_number (info.ciCharset);
2722 return Qnil;
2726 DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts,
2727 Sw32_get_valid_keyboard_layouts, 0, 0, 0,
2728 doc: /* Return list of Windows keyboard languages and layouts.
2729 The return value is a list of pairs of language id and layout id. */)
2730 (void)
2732 int num_layouts = GetKeyboardLayoutList (0, NULL);
2733 HKL * layouts = (HKL *) alloca (num_layouts * sizeof (HKL));
2734 Lisp_Object obj = Qnil;
2736 if (GetKeyboardLayoutList (num_layouts, layouts) == num_layouts)
2738 while (--num_layouts >= 0)
2740 DWORD kl = (DWORD) layouts[num_layouts];
2742 obj = Fcons (Fcons (make_number (kl & 0xffff),
2743 make_number ((kl >> 16) & 0xffff)),
2744 obj);
2748 return obj;
2752 DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout,
2753 Sw32_get_keyboard_layout, 0, 0, 0,
2754 doc: /* Return current Windows keyboard language and layout.
2755 The return value is the cons of the language id and the layout id. */)
2756 (void)
2758 DWORD kl = (DWORD) GetKeyboardLayout (dwWindowsThreadId);
2760 return Fcons (make_number (kl & 0xffff),
2761 make_number ((kl >> 16) & 0xffff));
2765 DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout,
2766 Sw32_set_keyboard_layout, 1, 1, 0,
2767 doc: /* Make LAYOUT be the current keyboard layout for Emacs.
2768 The keyboard layout setting affects interpretation of keyboard input.
2769 If successful, the new layout id is returned, otherwise nil. */)
2770 (Lisp_Object layout)
2772 DWORD kl;
2774 CHECK_CONS (layout);
2775 CHECK_NUMBER_CAR (layout);
2776 CHECK_NUMBER_CDR (layout);
2778 kl = (XINT (XCAR (layout)) & 0xffff)
2779 | (XINT (XCDR (layout)) << 16);
2781 /* Synchronize layout with input thread. */
2782 if (dwWindowsThreadId)
2784 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETKEYBOARDLAYOUT,
2785 (WPARAM) kl, 0))
2787 MSG msg;
2788 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
2790 if (msg.wParam == 0)
2791 return Qnil;
2794 else if (!ActivateKeyboardLayout ((HKL) kl, 0))
2795 return Qnil;
2797 return Fw32_get_keyboard_layout ();
2801 void
2802 syms_of_ntproc (void)
2804 DEFSYM (Qhigh, "high");
2805 DEFSYM (Qlow, "low");
2807 defsubr (&Sw32_has_winsock);
2808 defsubr (&Sw32_unload_winsock);
2810 defsubr (&Sw32_short_file_name);
2811 defsubr (&Sw32_long_file_name);
2812 defsubr (&Sw32_set_process_priority);
2813 defsubr (&Sw32_get_locale_info);
2814 defsubr (&Sw32_get_current_locale_id);
2815 defsubr (&Sw32_get_default_locale_id);
2816 defsubr (&Sw32_get_valid_locale_ids);
2817 defsubr (&Sw32_set_current_locale);
2819 defsubr (&Sw32_get_console_codepage);
2820 defsubr (&Sw32_set_console_codepage);
2821 defsubr (&Sw32_get_console_output_codepage);
2822 defsubr (&Sw32_set_console_output_codepage);
2823 defsubr (&Sw32_get_valid_codepages);
2824 defsubr (&Sw32_get_codepage_charset);
2826 defsubr (&Sw32_get_valid_keyboard_layouts);
2827 defsubr (&Sw32_get_keyboard_layout);
2828 defsubr (&Sw32_set_keyboard_layout);
2830 DEFVAR_LISP ("w32-quote-process-args", Vw32_quote_process_args,
2831 doc: /* Non-nil enables quoting of process arguments to ensure correct parsing.
2832 Because Windows does not directly pass argv arrays to child processes,
2833 programs have to reconstruct the argv array by parsing the command
2834 line string. For an argument to contain a space, it must be enclosed
2835 in double quotes or it will be parsed as multiple arguments.
2837 If the value is a character, that character will be used to escape any
2838 quote characters that appear, otherwise a suitable escape character
2839 will be chosen based on the type of the program. */);
2840 Vw32_quote_process_args = Qt;
2842 DEFVAR_LISP ("w32-start-process-show-window",
2843 Vw32_start_process_show_window,
2844 doc: /* When nil, new child processes hide their windows.
2845 When non-nil, they show their window in the method of their choice.
2846 This variable doesn't affect GUI applications, which will never be hidden. */);
2847 Vw32_start_process_show_window = Qnil;
2849 DEFVAR_LISP ("w32-start-process-share-console",
2850 Vw32_start_process_share_console,
2851 doc: /* When nil, new child processes are given a new console.
2852 When non-nil, they share the Emacs console; this has the limitation of
2853 allowing only one DOS subprocess to run at a time (whether started directly
2854 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
2855 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
2856 otherwise respond to interrupts from Emacs. */);
2857 Vw32_start_process_share_console = Qnil;
2859 DEFVAR_LISP ("w32-start-process-inherit-error-mode",
2860 Vw32_start_process_inherit_error_mode,
2861 doc: /* When nil, new child processes revert to the default error mode.
2862 When non-nil, they inherit their error mode setting from Emacs, which stops
2863 them blocking when trying to access unmounted drives etc. */);
2864 Vw32_start_process_inherit_error_mode = Qt;
2866 DEFVAR_INT ("w32-pipe-read-delay", w32_pipe_read_delay,
2867 doc: /* Forced delay before reading subprocess output.
2868 This is done to improve the buffering of subprocess output, by
2869 avoiding the inefficiency of frequently reading small amounts of data.
2871 If positive, the value is the number of milliseconds to sleep before
2872 reading the subprocess output. If negative, the magnitude is the number
2873 of time slices to wait (effectively boosting the priority of the child
2874 process temporarily). A value of zero disables waiting entirely. */);
2875 w32_pipe_read_delay = 50;
2877 DEFVAR_LISP ("w32-downcase-file-names", Vw32_downcase_file_names,
2878 doc: /* Non-nil means convert all-upper case file names to lower case.
2879 This applies when performing completions and file name expansion.
2880 Note that the value of this setting also affects remote file names,
2881 so you probably don't want to set to non-nil if you use case-sensitive
2882 filesystems via ange-ftp. */);
2883 Vw32_downcase_file_names = Qnil;
2885 #if 0
2886 DEFVAR_LISP ("w32-generate-fake-inodes", Vw32_generate_fake_inodes,
2887 doc: /* Non-nil means attempt to fake realistic inode values.
2888 This works by hashing the truename of files, and should detect
2889 aliasing between long and short (8.3 DOS) names, but can have
2890 false positives because of hash collisions. Note that determining
2891 the truename of a file can be slow. */);
2892 Vw32_generate_fake_inodes = Qnil;
2893 #endif
2895 DEFVAR_LISP ("w32-get-true-file-attributes", Vw32_get_true_file_attributes,
2896 doc: /* Non-nil means determine accurate file attributes in `file-attributes'.
2897 This option controls whether to issue additional system calls to determine
2898 accurate link counts, file type, and ownership information. It is more
2899 useful for files on NTFS volumes, where hard links and file security are
2900 supported, than on volumes of the FAT family.
2902 Without these system calls, link count will always be reported as 1 and file
2903 ownership will be attributed to the current user.
2904 The default value `local' means only issue these system calls for files
2905 on local fixed drives. A value of nil means never issue them.
2906 Any other non-nil value means do this even on remote and removable drives
2907 where the performance impact may be noticeable even on modern hardware. */);
2908 Vw32_get_true_file_attributes = Qlocal;
2910 staticpro (&Vw32_valid_locale_ids);
2911 staticpro (&Vw32_valid_codepages);
2913 /* end of w32proc.c */