1/* Process support for GNU Emacs on the Microsoft W32 API.
2   Copyright (C) 1992, 1995, 1999, 2000, 2001, 2002, 2003, 2004,
3		 2005, 2006, 2007 Free Software Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING.  If not, write to
19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20Boston, MA 02110-1301, USA.
21
22   Drew Bliss                   Oct 14, 1993
23     Adapted from alarm.c by Tim Fleehart
24*/
25
26#include <stdio.h>
27#include <stdlib.h>
28#include <errno.h>
29#include <io.h>
30#include <fcntl.h>
31#include <signal.h>
32#include <sys/file.h>
33
34/* must include CRT headers *before* config.h */
35
36#ifdef HAVE_CONFIG_H
37#include <config.h>
38#endif
39
40#undef signal
41#undef wait
42#undef spawnve
43#undef select
44#undef kill
45
46#include <windows.h>
47#ifdef __GNUC__
48/* This definition is missing from mingw32 headers. */
49extern BOOL WINAPI IsValidLocale(LCID, DWORD);
50#endif
51
52#ifdef HAVE_LANGINFO_CODESET
53#include <nl_types.h>
54#include <langinfo.h>
55#endif
56
57#include "lisp.h"
58#include "w32.h"
59#include "w32heap.h"
60#include "systime.h"
61#include "syswait.h"
62#include "process.h"
63#include "syssignal.h"
64#include "w32term.h"
65
66#define RVA_TO_PTR(var,section,filedata) \
67  ((void *)((section)->PointerToRawData					\
68	    + ((DWORD)(var) - (section)->VirtualAddress)		\
69	    + (filedata).file_base))
70
71/* Control whether spawnve quotes arguments as necessary to ensure
72   correct parsing by child process.  Because not all uses of spawnve
73   are careful about constructing argv arrays, we make this behaviour
74   conditional (off by default). */
75Lisp_Object Vw32_quote_process_args;
76
77/* Control whether create_child causes the process' window to be
78   hidden.  The default is nil. */
79Lisp_Object Vw32_start_process_show_window;
80
81/* Control whether create_child causes the process to inherit Emacs'
82   console window, or be given a new one of its own.  The default is
83   nil, to allow multiple DOS programs to run on Win95.  Having separate
84   consoles also allows Emacs to cleanly terminate process groups.  */
85Lisp_Object Vw32_start_process_share_console;
86
87/* Control whether create_child cause the process to inherit Emacs'
88   error mode setting.  The default is t, to minimize the possibility of
89   subprocesses blocking when accessing unmounted drives.  */
90Lisp_Object Vw32_start_process_inherit_error_mode;
91
92/* Time to sleep before reading from a subprocess output pipe - this
93   avoids the inefficiency of frequently reading small amounts of data.
94   This is primarily necessary for handling DOS processes on Windows 95,
95   but is useful for W32 processes on both Windows 95 and NT as well.  */
96int w32_pipe_read_delay;
97
98/* Control conversion of upper case file names to lower case.
99   nil means no, t means yes. */
100Lisp_Object Vw32_downcase_file_names;
101
102/* Control whether stat() attempts to generate fake but hopefully
103   "accurate" inode values, by hashing the absolute truenames of files.
104   This should detect aliasing between long and short names, but still
105   allows the possibility of hash collisions.  */
106Lisp_Object Vw32_generate_fake_inodes;
107
108/* Control whether stat() attempts to determine file type and link count
109   exactly, at the expense of slower operation.  Since true hard links
110   are supported on NTFS volumes, this is only relevant on NT.  */
111Lisp_Object Vw32_get_true_file_attributes;
112
113Lisp_Object Qhigh, Qlow;
114
115#ifdef EMACSDEBUG
116void _DebPrint (const char *fmt, ...)
117{
118  char buf[1024];
119  va_list args;
120
121  va_start (args, fmt);
122  vsprintf (buf, fmt, args);
123  va_end (args);
124  OutputDebugString (buf);
125}
126#endif
127
128typedef void (_CALLBACK_ *signal_handler)(int);
129
130/* Signal handlers...SIG_DFL == 0 so this is initialized correctly.  */
131static signal_handler sig_handlers[NSIG];
132
133/* Fake signal implementation to record the SIGCHLD handler.  */
134signal_handler
135sys_signal (int sig, signal_handler handler)
136{
137  signal_handler old;
138
139  if (sig != SIGCHLD)
140    {
141      errno = EINVAL;
142      return SIG_ERR;
143    }
144  old = sig_handlers[sig];
145  sig_handlers[sig] = handler;
146  return old;
147}
148
149/* Defined in <process.h> which conflicts with the local copy */
150#define _P_NOWAIT 1
151
152/* Child process management list.  */
153int child_proc_count = 0;
154child_process child_procs[ MAX_CHILDREN ];
155child_process *dead_child = NULL;
156
157DWORD WINAPI reader_thread (void *arg);
158
159/* Find an unused process slot.  */
160child_process *
161new_child (void)
162{
163  child_process *cp;
164  DWORD id;
165
166  for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--)
167    if (!CHILD_ACTIVE (cp))
168      goto Initialise;
169  if (child_proc_count == MAX_CHILDREN)
170    return NULL;
171  cp = &child_procs[child_proc_count++];
172
173 Initialise:
174  memset (cp, 0, sizeof(*cp));
175  cp->fd = -1;
176  cp->pid = -1;
177  cp->procinfo.hProcess = NULL;
178  cp->status = STATUS_READ_ERROR;
179
180  /* use manual reset event so that select() will function properly */
181  cp->char_avail = CreateEvent (NULL, TRUE, FALSE, NULL);
182  if (cp->char_avail)
183    {
184      cp->char_consumed = CreateEvent (NULL, FALSE, FALSE, NULL);
185      if (cp->char_consumed)
186        {
187	  cp->thrd = CreateThread (NULL, 1024, reader_thread, cp, 0, &id);
188	  if (cp->thrd)
189	    return cp;
190	}
191    }
192  delete_child (cp);
193  return NULL;
194}
195
196void
197delete_child (child_process *cp)
198{
199  int i;
200
201  /* Should not be deleting a child that is still needed. */
202  for (i = 0; i < MAXDESC; i++)
203    if (fd_info[i].cp == cp)
204      abort ();
205
206  if (!CHILD_ACTIVE (cp))
207    return;
208
209  /* reap thread if necessary */
210  if (cp->thrd)
211    {
212      DWORD rc;
213
214      if (GetExitCodeThread (cp->thrd, &rc) && rc == STILL_ACTIVE)
215        {
216	  /* let the thread exit cleanly if possible */
217	  cp->status = STATUS_READ_ERROR;
218	  SetEvent (cp->char_consumed);
219	  if (WaitForSingleObject (cp->thrd, 1000) != WAIT_OBJECT_0)
220	    {
221	      DebPrint (("delete_child.WaitForSingleObject (thread) failed "
222			 "with %lu for fd %ld\n", GetLastError (), cp->fd));
223	      TerminateThread (cp->thrd, 0);
224	    }
225	}
226      CloseHandle (cp->thrd);
227      cp->thrd = NULL;
228    }
229  if (cp->char_avail)
230    {
231      CloseHandle (cp->char_avail);
232      cp->char_avail = NULL;
233    }
234  if (cp->char_consumed)
235    {
236      CloseHandle (cp->char_consumed);
237      cp->char_consumed = NULL;
238    }
239
240  /* update child_proc_count (highest numbered slot in use plus one) */
241  if (cp == child_procs + child_proc_count - 1)
242    {
243      for (i = child_proc_count-1; i >= 0; i--)
244	if (CHILD_ACTIVE (&child_procs[i]))
245	  {
246	    child_proc_count = i + 1;
247	    break;
248	  }
249    }
250  if (i < 0)
251    child_proc_count = 0;
252}
253
254/* Find a child by pid.  */
255static child_process *
256find_child_pid (DWORD pid)
257{
258  child_process *cp;
259
260  for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--)
261    if (CHILD_ACTIVE (cp) && pid == cp->pid)
262      return cp;
263  return NULL;
264}
265
266
267/* Thread proc for child process and socket reader threads. Each thread
268   is normally blocked until woken by select() to check for input by
269   reading one char.  When the read completes, char_avail is signalled
270   to wake up the select emulator and the thread blocks itself again. */
271DWORD WINAPI
272reader_thread (void *arg)
273{
274  child_process *cp;
275
276  /* Our identity */
277  cp = (child_process *)arg;
278
279  /* We have to wait for the go-ahead before we can start */
280  if (cp == NULL
281      || WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0)
282    return 1;
283
284  for (;;)
285    {
286      int rc;
287
288      if (fd_info[cp->fd].flags & FILE_LISTEN)
289	rc = _sys_wait_accept (cp->fd);
290      else
291	rc = _sys_read_ahead (cp->fd);
292
293      /* The name char_avail is a misnomer - it really just means the
294	 read-ahead has completed, whether successfully or not. */
295      if (!SetEvent (cp->char_avail))
296        {
297	  DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld\n",
298		     GetLastError (), cp->fd));
299	  return 1;
300	}
301
302      if (rc == STATUS_READ_ERROR)
303	return 1;
304
305      /* If the read died, the child has died so let the thread die */
306      if (rc == STATUS_READ_FAILED)
307	break;
308
309      /* Wait until our input is acknowledged before reading again */
310      if (WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0)
311        {
312	  DebPrint (("reader_thread.WaitForSingleObject failed with "
313		     "%lu for fd %ld\n", GetLastError (), cp->fd));
314	  break;
315        }
316    }
317  return 0;
318}
319
320/* To avoid Emacs changing directory, we just record here the directory
321   the new process should start in.  This is set just before calling
322   sys_spawnve, and is not generally valid at any other time.  */
323static char * process_dir;
324
325static BOOL
326create_child (char *exe, char *cmdline, char *env, int is_gui_app,
327	      int * pPid, child_process *cp)
328{
329  STARTUPINFO start;
330  SECURITY_ATTRIBUTES sec_attrs;
331#if 0
332  SECURITY_DESCRIPTOR sec_desc;
333#endif
334  DWORD flags;
335  char dir[ MAXPATHLEN ];
336
337  if (cp == NULL) abort ();
338
339  memset (&start, 0, sizeof (start));
340  start.cb = sizeof (start);
341
342#ifdef HAVE_NTGUI
343  if (NILP (Vw32_start_process_show_window) && !is_gui_app)
344    start.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW;
345  else
346    start.dwFlags = STARTF_USESTDHANDLES;
347  start.wShowWindow = SW_HIDE;
348
349  start.hStdInput = GetStdHandle (STD_INPUT_HANDLE);
350  start.hStdOutput = GetStdHandle (STD_OUTPUT_HANDLE);
351  start.hStdError = GetStdHandle (STD_ERROR_HANDLE);
352#endif /* HAVE_NTGUI */
353
354#if 0
355  /* Explicitly specify no security */
356  if (!InitializeSecurityDescriptor (&sec_desc, SECURITY_DESCRIPTOR_REVISION))
357    goto EH_Fail;
358  if (!SetSecurityDescriptorDacl (&sec_desc, TRUE, NULL, FALSE))
359    goto EH_Fail;
360#endif
361  sec_attrs.nLength = sizeof (sec_attrs);
362  sec_attrs.lpSecurityDescriptor = NULL /* &sec_desc */;
363  sec_attrs.bInheritHandle = FALSE;
364
365  strcpy (dir, process_dir);
366  unixtodos_filename (dir);
367
368  flags = (!NILP (Vw32_start_process_share_console)
369	   ? CREATE_NEW_PROCESS_GROUP
370	   : CREATE_NEW_CONSOLE);
371  if (NILP (Vw32_start_process_inherit_error_mode))
372    flags |= CREATE_DEFAULT_ERROR_MODE;
373  if (!CreateProcess (exe, cmdline, &sec_attrs, NULL, TRUE,
374		      flags, env, dir, &start, &cp->procinfo))
375    goto EH_Fail;
376
377  cp->pid = (int) cp->procinfo.dwProcessId;
378
379  /* Hack for Windows 95, which assigns large (ie negative) pids */
380  if (cp->pid < 0)
381    cp->pid = -cp->pid;
382
383  /* pid must fit in a Lisp_Int */
384  cp->pid = cp->pid & INTMASK;
385
386  *pPid = cp->pid;
387
388  return TRUE;
389
390 EH_Fail:
391  DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError()););
392  return FALSE;
393}
394
395/* create_child doesn't know what emacs' file handle will be for waiting
396   on output from the child, so we need to make this additional call
397   to register the handle with the process
398   This way the select emulator knows how to match file handles with
399   entries in child_procs.  */
400void
401register_child (int pid, int fd)
402{
403  child_process *cp;
404
405  cp = find_child_pid (pid);
406  if (cp == NULL)
407    {
408      DebPrint (("register_child unable to find pid %lu\n", pid));
409      return;
410    }
411
412#ifdef FULL_DEBUG
413  DebPrint (("register_child registered fd %d with pid %lu\n", fd, pid));
414#endif
415
416  cp->fd = fd;
417
418  /* thread is initially blocked until select is called; set status so
419     that select will release thread */
420  cp->status = STATUS_READ_ACKNOWLEDGED;
421
422  /* attach child_process to fd_info */
423  if (fd_info[fd].cp != NULL)
424    {
425      DebPrint (("register_child: fd_info[%d] apparently in use!\n", fd));
426      abort ();
427    }
428
429  fd_info[fd].cp = cp;
430}
431
432/* When a process dies its pipe will break so the reader thread will
433   signal failure to the select emulator.
434   The select emulator then calls this routine to clean up.
435   Since the thread signaled failure we can assume it is exiting.  */
436static void
437reap_subprocess (child_process *cp)
438{
439  if (cp->procinfo.hProcess)
440    {
441      /* Reap the process */
442#ifdef FULL_DEBUG
443      /* Process should have already died before we are called.  */
444      if (WaitForSingleObject (cp->procinfo.hProcess, 0) != WAIT_OBJECT_0)
445	DebPrint (("reap_subprocess: child fpr fd %d has not died yet!", cp->fd));
446#endif
447      CloseHandle (cp->procinfo.hProcess);
448      cp->procinfo.hProcess = NULL;
449      CloseHandle (cp->procinfo.hThread);
450      cp->procinfo.hThread = NULL;
451    }
452
453  /* For asynchronous children, the child_proc resources will be freed
454     when the last pipe read descriptor is closed; for synchronous
455     children, we must explicitly free the resources now because
456     register_child has not been called. */
457  if (cp->fd == -1)
458    delete_child (cp);
459}
460
461/* Wait for any of our existing child processes to die
462   When it does, close its handle
463   Return the pid and fill in the status if non-NULL.  */
464
465int
466sys_wait (int *status)
467{
468  DWORD active, retval;
469  int nh;
470  int pid;
471  child_process *cp, *cps[MAX_CHILDREN];
472  HANDLE wait_hnd[MAX_CHILDREN];
473
474  nh = 0;
475  if (dead_child != NULL)
476    {
477      /* We want to wait for a specific child */
478      wait_hnd[nh] = dead_child->procinfo.hProcess;
479      cps[nh] = dead_child;
480      if (!wait_hnd[nh]) abort ();
481      nh++;
482      active = 0;
483      goto get_result;
484    }
485  else
486    {
487      for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--)
488	/* some child_procs might be sockets; ignore them */
489	if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess
490	    && (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0))
491	  {
492	    wait_hnd[nh] = cp->procinfo.hProcess;
493	    cps[nh] = cp;
494	    nh++;
495	  }
496    }
497
498  if (nh == 0)
499    {
500      /* Nothing to wait on, so fail */
501      errno = ECHILD;
502      return -1;
503    }
504
505  do
506    {
507      /* Check for quit about once a second. */
508      QUIT;
509      active = WaitForMultipleObjects (nh, wait_hnd, FALSE, 1000);
510    } while (active == WAIT_TIMEOUT);
511
512  if (active == WAIT_FAILED)
513    {
514      errno = EBADF;
515      return -1;
516    }
517  else if (active >= WAIT_OBJECT_0
518	   && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
519    {
520      active -= WAIT_OBJECT_0;
521    }
522  else if (active >= WAIT_ABANDONED_0
523	   && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
524    {
525      active -= WAIT_ABANDONED_0;
526    }
527  else
528    abort ();
529
530get_result:
531  if (!GetExitCodeProcess (wait_hnd[active], &retval))
532    {
533      DebPrint (("Wait.GetExitCodeProcess failed with %lu\n",
534		 GetLastError ()));
535      retval = 1;
536    }
537  if (retval == STILL_ACTIVE)
538    {
539      /* Should never happen */
540      DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
541      errno = EINVAL;
542      return -1;
543    }
544
545  /* Massage the exit code from the process to match the format expected
546     by the WIFSTOPPED et al macros in syswait.h.  Only WIFSIGNALED and
547     WIFEXITED are supported; WIFSTOPPED doesn't make sense under NT.  */
548
549  if (retval == STATUS_CONTROL_C_EXIT)
550    retval = SIGINT;
551  else
552    retval <<= 8;
553
554  cp = cps[active];
555  pid = cp->pid;
556#ifdef FULL_DEBUG
557  DebPrint (("Wait signaled with process pid %d\n", cp->pid));
558#endif
559
560  if (status)
561    {
562      *status = retval;
563    }
564  else if (synch_process_alive)
565    {
566      synch_process_alive = 0;
567
568      /* Report the status of the synchronous process.  */
569      if (WIFEXITED (retval))
570	synch_process_retcode = WRETCODE (retval);
571      else if (WIFSIGNALED (retval))
572	{
573	  int code = WTERMSIG (retval);
574	  char *signame;
575
576	  synchronize_system_messages_locale ();
577	  signame = strsignal (code);
578
579	  if (signame == 0)
580	    signame = "unknown";
581
582	  synch_process_death = signame;
583	}
584
585      reap_subprocess (cp);
586    }
587
588  reap_subprocess (cp);
589
590  return pid;
591}
592
593void
594w32_executable_type (char * filename, int * is_dos_app, int * is_cygnus_app, int * is_gui_app)
595{
596  file_data executable;
597  char * p;
598
599  /* Default values in case we can't tell for sure.  */
600  *is_dos_app = FALSE;
601  *is_cygnus_app = FALSE;
602  *is_gui_app = FALSE;
603
604  if (!open_input_file (&executable, filename))
605    return;
606
607  p = strrchr (filename, '.');
608
609  /* We can only identify DOS .com programs from the extension. */
610  if (p && stricmp (p, ".com") == 0)
611    *is_dos_app = TRUE;
612  else if (p && (stricmp (p, ".bat") == 0
613		 || stricmp (p, ".cmd") == 0))
614    {
615      /* A DOS shell script - it appears that CreateProcess is happy to
616	 accept this (somewhat surprisingly); presumably it looks at
617	 COMSPEC to determine what executable to actually invoke.
618	 Therefore, we have to do the same here as well. */
619      /* Actually, I think it uses the program association for that
620	 extension, which is defined in the registry.  */
621      p = egetenv ("COMSPEC");
622      if (p)
623	w32_executable_type (p, is_dos_app, is_cygnus_app, is_gui_app);
624    }
625  else
626    {
627      /* Look for DOS .exe signature - if found, we must also check that
628	 it isn't really a 16- or 32-bit Windows exe, since both formats
629	 start with a DOS program stub.  Note that 16-bit Windows
630	 executables use the OS/2 1.x format. */
631
632      IMAGE_DOS_HEADER * dos_header;
633      IMAGE_NT_HEADERS * nt_header;
634
635      dos_header = (PIMAGE_DOS_HEADER) executable.file_base;
636      if (dos_header->e_magic != IMAGE_DOS_SIGNATURE)
637	goto unwind;
638
639      nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew);
640
641      if ((char *) nt_header > (char *) dos_header + executable.size)
642	{
643	  /* Some dos headers (pkunzip) have bogus e_lfanew fields.  */
644	  *is_dos_app = TRUE;
645	}
646      else if (nt_header->Signature != IMAGE_NT_SIGNATURE
647	       && LOWORD (nt_header->Signature) != IMAGE_OS2_SIGNATURE)
648  	{
649	  *is_dos_app = TRUE;
650  	}
651      else if (nt_header->Signature == IMAGE_NT_SIGNATURE)
652  	{
653	  /* Look for cygwin.dll in DLL import list. */
654	  IMAGE_DATA_DIRECTORY import_dir =
655	    nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT];
656	  IMAGE_IMPORT_DESCRIPTOR * imports;
657	  IMAGE_SECTION_HEADER * section;
658
659	  section = rva_to_section (import_dir.VirtualAddress, nt_header);
660	  imports = RVA_TO_PTR (import_dir.VirtualAddress, section, executable);
661
662	  for ( ; imports->Name; imports++)
663  	    {
664	      char * dllname = RVA_TO_PTR (imports->Name, section, executable);
665
666	      /* The exact name of the cygwin dll has changed with
667	         various releases, but hopefully this will be reasonably
668	         future proof.  */
669	      if (strncmp (dllname, "cygwin", 6) == 0)
670		{
671		  *is_cygnus_app = TRUE;
672		  break;
673		}
674  	    }
675
676	  /* Check whether app is marked as a console or windowed (aka
677             GUI) app.  Accept Posix and OS2 subsytem apps as console
678             apps.  */
679	  *is_gui_app = (nt_header->OptionalHeader.Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
680  	}
681    }
682
683unwind:
684  close_file_data (&executable);
685}
686
687int
688compare_env (const void *strp1, const void *strp2)
689{
690  const char *str1 = *(const char **)strp1, *str2 = *(const char **)strp2;
691
692  while (*str1 && *str2 && *str1 != '=' && *str2 != '=')
693    {
694      /* Sort order in command.com/cmd.exe is based on uppercasing
695         names, so do the same here.  */
696      if (toupper (*str1) > toupper (*str2))
697	return 1;
698      else if (toupper (*str1) < toupper (*str2))
699	return -1;
700      str1++, str2++;
701    }
702
703  if (*str1 == '=' && *str2 == '=')
704    return 0;
705  else if (*str1 == '=')
706    return -1;
707  else
708    return 1;
709}
710
711void
712merge_and_sort_env (char **envp1, char **envp2, char **new_envp)
713{
714  char **optr, **nptr;
715  int num;
716
717  nptr = new_envp;
718  optr = envp1;
719  while (*optr)
720    *nptr++ = *optr++;
721  num = optr - envp1;
722
723  optr = envp2;
724  while (*optr)
725    *nptr++ = *optr++;
726  num += optr - envp2;
727
728  qsort (new_envp, num, sizeof (char *), compare_env);
729
730  *nptr = NULL;
731}
732
733/* When a new child process is created we need to register it in our list,
734   so intercept spawn requests.  */
735int
736sys_spawnve (int mode, char *cmdname, char **argv, char **envp)
737{
738  Lisp_Object program, full;
739  char *cmdline, *env, *parg, **targ;
740  int arglen, numenv;
741  int pid;
742  child_process *cp;
743  int is_dos_app, is_cygnus_app, is_gui_app;
744  int do_quoting = 0;
745  char escape_char;
746  /* We pass our process ID to our children by setting up an environment
747     variable in their environment.  */
748  char ppid_env_var_buffer[64];
749  char *extra_env[] = {ppid_env_var_buffer, NULL};
750  char *sepchars = " \t";
751
752  /* We don't care about the other modes */
753  if (mode != _P_NOWAIT)
754    {
755      errno = EINVAL;
756      return -1;
757    }
758
759  /* Handle executable names without an executable suffix.  */
760  program = make_string (cmdname, strlen (cmdname));
761  if (NILP (Ffile_executable_p (program)))
762    {
763      struct gcpro gcpro1;
764
765      full = Qnil;
766      GCPRO1 (program);
767      openp (Vexec_path, program, Vexec_suffixes, &full, make_number (X_OK));
768      UNGCPRO;
769      if (NILP (full))
770	{
771	  errno = EINVAL;
772	  return -1;
773	}
774      program = full;
775    }
776
777  /* make sure argv[0] and cmdname are both in DOS format */
778  cmdname = SDATA (program);
779  unixtodos_filename (cmdname);
780  argv[0] = cmdname;
781
782  /* Determine whether program is a 16-bit DOS executable, or a w32
783     executable that is implicitly linked to the Cygnus dll (implying it
784     was compiled with the Cygnus GNU toolchain and hence relies on
785     cygwin.dll to parse the command line - we use this to decide how to
786     escape quote chars in command line args that must be quoted).
787
788     Also determine whether it is a GUI app, so that we don't hide its
789     initial window unless specifically requested.  */
790  w32_executable_type (cmdname, &is_dos_app, &is_cygnus_app, &is_gui_app);
791
792  /* On Windows 95, if cmdname is a DOS app, we invoke a helper
793     application to start it by specifying the helper app as cmdname,
794     while leaving the real app name as argv[0].  */
795  if (is_dos_app)
796    {
797      cmdname = alloca (MAXPATHLEN);
798      if (egetenv ("CMDPROXY"))
799	strcpy (cmdname, egetenv ("CMDPROXY"));
800      else
801	{
802	  strcpy (cmdname, SDATA (Vinvocation_directory));
803	  strcat (cmdname, "cmdproxy.exe");
804	}
805      unixtodos_filename (cmdname);
806    }
807
808  /* we have to do some conjuring here to put argv and envp into the
809     form CreateProcess wants...  argv needs to be a space separated/null
810     terminated list of parameters, and envp is a null
811     separated/double-null terminated list of parameters.
812
813     Additionally, zero-length args and args containing whitespace or
814     quote chars need to be wrapped in double quotes - for this to work,
815     embedded quotes need to be escaped as well.  The aim is to ensure
816     the child process reconstructs the argv array we start with
817     exactly, so we treat quotes at the beginning and end of arguments
818     as embedded quotes.
819
820     The w32 GNU-based library from Cygnus doubles quotes to escape
821     them, while MSVC uses backslash for escaping.  (Actually the MSVC
822     startup code does attempt to recognise doubled quotes and accept
823     them, but gets it wrong and ends up requiring three quotes to get a
824     single embedded quote!)  So by default we decide whether to use
825     quote or backslash as the escape character based on whether the
826     binary is apparently a Cygnus compiled app.
827
828     Note that using backslash to escape embedded quotes requires
829     additional special handling if an embedded quote is already
830     preceeded by backslash, or if an arg requiring quoting ends with
831     backslash.  In such cases, the run of escape characters needs to be
832     doubled.  For consistency, we apply this special handling as long
833     as the escape character is not quote.
834
835     Since we have no idea how large argv and envp are likely to be we
836     figure out list lengths on the fly and allocate them.  */
837
838  if (!NILP (Vw32_quote_process_args))
839    {
840      do_quoting = 1;
841      /* Override escape char by binding w32-quote-process-args to
842	 desired character, or use t for auto-selection.  */
843      if (INTEGERP (Vw32_quote_process_args))
844	escape_char = XINT (Vw32_quote_process_args);
845      else
846	escape_char = is_cygnus_app ? '"' : '\\';
847    }
848
849  /* Cygwin apps needs quoting a bit more often */
850  if (escape_char == '"')
851    sepchars = "\r\n\t\f '";
852
853  /* do argv...  */
854  arglen = 0;
855  targ = argv;
856  while (*targ)
857    {
858      char * p = *targ;
859      int need_quotes = 0;
860      int escape_char_run = 0;
861
862      if (*p == 0)
863	need_quotes = 1;
864      for ( ; *p; p++)
865	{
866	  if (escape_char == '"' && *p == '\\')
867	    /* If it's a Cygwin app, \ needs to be escaped.  */
868	    arglen++;
869	  else if (*p == '"')
870	    {
871	      /* allow for embedded quotes to be escaped */
872	      arglen++;
873	      need_quotes = 1;
874	      /* handle the case where the embedded quote is already escaped */
875	      if (escape_char_run > 0)
876		{
877		  /* To preserve the arg exactly, we need to double the
878		     preceding escape characters (plus adding one to
879		     escape the quote character itself).  */
880		  arglen += escape_char_run;
881		}
882	    }
883	  else if (strchr (sepchars, *p) != NULL)
884	    {
885	      need_quotes = 1;
886	    }
887
888	  if (*p == escape_char && escape_char != '"')
889	    escape_char_run++;
890	  else
891	    escape_char_run = 0;
892	}
893      if (need_quotes)
894	{
895	  arglen += 2;
896	  /* handle the case where the arg ends with an escape char - we
897	     must not let the enclosing quote be escaped.  */
898	  if (escape_char_run > 0)
899	    arglen += escape_char_run;
900	}
901      arglen += strlen (*targ++) + 1;
902    }
903  cmdline = alloca (arglen);
904  targ = argv;
905  parg = cmdline;
906  while (*targ)
907    {
908      char * p = *targ;
909      int need_quotes = 0;
910
911      if (*p == 0)
912	need_quotes = 1;
913
914      if (do_quoting)
915	{
916	  for ( ; *p; p++)
917	    if ((strchr (sepchars, *p) != NULL) || *p == '"')
918	      need_quotes = 1;
919	}
920      if (need_quotes)
921	{
922	  int escape_char_run = 0;
923	  char * first;
924	  char * last;
925
926	  p = *targ;
927	  first = p;
928	  last = p + strlen (p) - 1;
929	  *parg++ = '"';
930#if 0
931	  /* This version does not escape quotes if they occur at the
932	     beginning or end of the arg - this could lead to incorrect
933	     behaviour when the arg itself represents a command line
934	     containing quoted args.  I believe this was originally done
935	     as a hack to make some things work, before
936	     `w32-quote-process-args' was added.  */
937	  while (*p)
938	    {
939	      if (*p == '"' && p > first && p < last)
940		*parg++ = escape_char;	/* escape embedded quotes */
941	      *parg++ = *p++;
942	    }
943#else
944	  for ( ; *p; p++)
945	    {
946	      if (*p == '"')
947		{
948		  /* double preceding escape chars if any */
949		  while (escape_char_run > 0)
950		    {
951		      *parg++ = escape_char;
952		      escape_char_run--;
953		    }
954		  /* escape all quote chars, even at beginning or end */
955		  *parg++ = escape_char;
956		}
957	      else if (escape_char == '"' && *p == '\\')
958		*parg++ = '\\';
959	      *parg++ = *p;
960
961	      if (*p == escape_char && escape_char != '"')
962		escape_char_run++;
963	      else
964		escape_char_run = 0;
965	    }
966	  /* double escape chars before enclosing quote */
967	  while (escape_char_run > 0)
968	    {
969	      *parg++ = escape_char;
970	      escape_char_run--;
971	    }
972#endif
973	  *parg++ = '"';
974	}
975      else
976	{
977	  strcpy (parg, *targ);
978	  parg += strlen (*targ);
979	}
980      *parg++ = ' ';
981      targ++;
982    }
983  *--parg = '\0';
984
985  /* and envp...  */
986  arglen = 1;
987  targ = envp;
988  numenv = 1; /* for end null */
989  while (*targ)
990    {
991      arglen += strlen (*targ++) + 1;
992      numenv++;
993    }
994  /* extra env vars... */
995  sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d",
996	   GetCurrentProcessId ());
997  arglen += strlen (ppid_env_var_buffer) + 1;
998  numenv++;
999
1000  /* merge env passed in and extra env into one, and sort it.  */
1001  targ = (char **) alloca (numenv * sizeof (char *));
1002  merge_and_sort_env (envp, extra_env, targ);
1003
1004  /* concatenate env entries.  */
1005  env = alloca (arglen);
1006  parg = env;
1007  while (*targ)
1008    {
1009      strcpy (parg, *targ);
1010      parg += strlen (*targ++);
1011      *parg++ = '\0';
1012    }
1013  *parg++ = '\0';
1014  *parg = '\0';
1015
1016  cp = new_child ();
1017  if (cp == NULL)
1018    {
1019      errno = EAGAIN;
1020      return -1;
1021    }
1022
1023  /* Now create the process.  */
1024  if (!create_child (cmdname, cmdline, env, is_gui_app, &pid, cp))
1025    {
1026      delete_child (cp);
1027      errno = ENOEXEC;
1028      return -1;
1029    }
1030
1031  return pid;
1032}
1033
1034/* Emulate the select call
1035   Wait for available input on any of the given rfds, or timeout if
1036   a timeout is given and no input is detected
1037   wfds and efds are not supported and must be NULL.
1038
1039   For simplicity, we detect the death of child processes here and
1040   synchronously call the SIGCHLD handler.  Since it is possible for
1041   children to be created without a corresponding pipe handle from which
1042   to read output, we wait separately on the process handles as well as
1043   the char_avail events for each process pipe.  We only call
1044   wait/reap_process when the process actually terminates.
1045
1046   To reduce the number of places in which Emacs can be hung such that
1047   C-g is not able to interrupt it, we always wait on interrupt_handle
1048   (which is signalled by the input thread when C-g is detected).  If we
1049   detect that we were woken up by C-g, we return -1 with errno set to
1050   EINTR as on Unix.  */
1051
1052/* From ntterm.c */
1053extern HANDLE keyboard_handle;
1054
1055/* From w32xfns.c */
1056extern HANDLE interrupt_handle;
1057
1058/* From process.c */
1059extern int proc_buffered_char[];
1060
1061int
1062sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
1063	    EMACS_TIME *timeout)
1064{
1065  SELECT_TYPE orfds;
1066  DWORD timeout_ms, start_time;
1067  int i, nh, nc, nr;
1068  DWORD active;
1069  child_process *cp, *cps[MAX_CHILDREN];
1070  HANDLE wait_hnd[MAXDESC + MAX_CHILDREN];
1071  int fdindex[MAXDESC];   /* mapping from wait handles back to descriptors */
1072
1073  timeout_ms = timeout ? (timeout->tv_sec * 1000 + timeout->tv_usec / 1000) : INFINITE;
1074
1075  /* If the descriptor sets are NULL but timeout isn't, then just Sleep.  */
1076  if (rfds == NULL && wfds == NULL && efds == NULL && timeout != NULL)
1077    {
1078      Sleep (timeout_ms);
1079      return 0;
1080    }
1081
1082  /* Otherwise, we only handle rfds, so fail otherwise.  */
1083  if (rfds == NULL || wfds != NULL || efds != NULL)
1084    {
1085      errno = EINVAL;
1086      return -1;
1087    }
1088
1089  orfds = *rfds;
1090  FD_ZERO (rfds);
1091  nr = 0;
1092
1093  /* Always wait on interrupt_handle, to detect C-g (quit).  */
1094  wait_hnd[0] = interrupt_handle;
1095  fdindex[0] = -1;
1096
1097  /* Build a list of pipe handles to wait on.  */
1098  nh = 1;
1099  for (i = 0; i < nfds; i++)
1100    if (FD_ISSET (i, &orfds))
1101      {
1102	if (i == 0)
1103	  {
1104	    if (keyboard_handle)
1105	      {
1106		/* Handle stdin specially */
1107		wait_hnd[nh] = keyboard_handle;
1108		fdindex[nh] = i;
1109		nh++;
1110	      }
1111
1112	    /* Check for any emacs-generated input in the queue since
1113	       it won't be detected in the wait */
1114	    if (detect_input_pending ())
1115	      {
1116		FD_SET (i, rfds);
1117		return 1;
1118	      }
1119	  }
1120	else
1121	  {
1122	    /* Child process and socket input */
1123	    cp = fd_info[i].cp;
1124	    if (cp)
1125	      {
1126		int current_status = cp->status;
1127
1128		if (current_status == STATUS_READ_ACKNOWLEDGED)
1129		  {
1130		    /* Tell reader thread which file handle to use. */
1131		    cp->fd = i;
1132		    /* Wake up the reader thread for this process */
1133		    cp->status = STATUS_READ_READY;
1134		    if (!SetEvent (cp->char_consumed))
1135		      DebPrint (("nt_select.SetEvent failed with "
1136				 "%lu for fd %ld\n", GetLastError (), i));
1137		  }
1138
1139#ifdef CHECK_INTERLOCK
1140		/* slightly crude cross-checking of interlock between threads */
1141
1142		current_status = cp->status;
1143		if (WaitForSingleObject (cp->char_avail, 0) == WAIT_OBJECT_0)
1144		  {
1145		    /* char_avail has been signalled, so status (which may
1146		       have changed) should indicate read has completed
1147		       but has not been acknowledged. */
1148		    current_status = cp->status;
1149		    if (current_status != STATUS_READ_SUCCEEDED
1150			&& current_status != STATUS_READ_FAILED)
1151		      DebPrint (("char_avail set, but read not completed: status %d\n",
1152				 current_status));
1153		  }
1154		else
1155		  {
1156		    /* char_avail has not been signalled, so status should
1157		       indicate that read is in progress; small possibility
1158		       that read has completed but event wasn't yet signalled
1159		       when we tested it (because a context switch occurred
1160		       or if running on separate CPUs). */
1161		    if (current_status != STATUS_READ_READY
1162			&& current_status != STATUS_READ_IN_PROGRESS
1163			&& current_status != STATUS_READ_SUCCEEDED
1164			&& current_status != STATUS_READ_FAILED)
1165		      DebPrint (("char_avail reset, but read status is bad: %d\n",
1166				 current_status));
1167		  }
1168#endif
1169		wait_hnd[nh] = cp->char_avail;
1170		fdindex[nh] = i;
1171		if (!wait_hnd[nh]) abort ();
1172		nh++;
1173#ifdef FULL_DEBUG
1174		DebPrint (("select waiting on child %d fd %d\n",
1175			   cp-child_procs, i));
1176#endif
1177	      }
1178	    else
1179	      {
1180		/* Unable to find something to wait on for this fd, skip */
1181
1182		/* Note that this is not a fatal error, and can in fact
1183		   happen in unusual circumstances.  Specifically, if
1184		   sys_spawnve fails, eg. because the program doesn't
1185		   exist, and debug-on-error is t so Fsignal invokes a
1186		   nested input loop, then the process output pipe is
1187		   still included in input_wait_mask with no child_proc
1188		   associated with it.  (It is removed when the debugger
1189		   exits the nested input loop and the error is thrown.)  */
1190
1191		DebPrint (("sys_select: fd %ld is invalid! ignoring\n", i));
1192	      }
1193	  }
1194      }
1195
1196count_children:
1197  /* Add handles of child processes.  */
1198  nc = 0;
1199  for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--)
1200    /* Some child_procs might be sockets; ignore them.  Also some
1201       children may have died already, but we haven't finished reading
1202       the process output; ignore them too.  */
1203    if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess
1204	&& (cp->fd < 0
1205	    || (fd_info[cp->fd].flags & FILE_SEND_SIGCHLD) == 0
1206	    || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0)
1207	)
1208      {
1209	wait_hnd[nh + nc] = cp->procinfo.hProcess;
1210	cps[nc] = cp;
1211	nc++;
1212      }
1213
1214  /* Nothing to look for, so we didn't find anything */
1215  if (nh + nc == 0)
1216    {
1217      if (timeout)
1218	Sleep (timeout_ms);
1219      return 0;
1220    }
1221
1222  start_time = GetTickCount ();
1223
1224  /* Wait for input or child death to be signalled.  If user input is
1225     allowed, then also accept window messages.  */
1226  if (FD_ISSET (0, &orfds))
1227    active = MsgWaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms,
1228					QS_ALLINPUT);
1229  else
1230    active = WaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms);
1231
1232  if (active == WAIT_FAILED)
1233    {
1234      DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n",
1235		 nh + nc, timeout_ms, GetLastError ()));
1236      /* don't return EBADF - this causes wait_reading_process_output to
1237	 abort; WAIT_FAILED is returned when single-stepping under
1238	 Windows 95 after switching thread focus in debugger, and
1239	 possibly at other times. */
1240      errno = EINTR;
1241      return -1;
1242    }
1243  else if (active == WAIT_TIMEOUT)
1244    {
1245      return 0;
1246    }
1247  else if (active >= WAIT_OBJECT_0
1248	   && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
1249    {
1250      active -= WAIT_OBJECT_0;
1251    }
1252  else if (active >= WAIT_ABANDONED_0
1253	   && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
1254    {
1255      active -= WAIT_ABANDONED_0;
1256    }
1257  else
1258    abort ();
1259
1260  /* Loop over all handles after active (now officially documented as
1261     being the first signalled handle in the array).  We do this to
1262     ensure fairness, so that all channels with data available will be
1263     processed - otherwise higher numbered channels could be starved. */
1264  do
1265    {
1266      if (active == nh + nc)
1267	{
1268	  /* There are messages in the lisp thread's queue; we must
1269             drain the queue now to ensure they are processed promptly,
1270             because if we don't do so, we will not be woken again until
1271             further messages arrive.
1272
1273	     NB. If ever we allow window message procedures to callback
1274	     into lisp, we will need to ensure messages are dispatched
1275	     at a safe time for lisp code to be run (*), and we may also
1276	     want to provide some hooks in the dispatch loop to cater
1277	     for modeless dialogs created by lisp (ie. to register
1278	     window handles to pass to IsDialogMessage).
1279
1280	     (*) Note that MsgWaitForMultipleObjects above is an
1281	     internal dispatch point for messages that are sent to
1282	     windows created by this thread.  */
1283	  drain_message_queue ();
1284	}
1285      else if (active >= nh)
1286	{
1287	  cp = cps[active - nh];
1288
1289	  /* We cannot always signal SIGCHLD immediately; if we have not
1290	     finished reading the process output, we must delay sending
1291	     SIGCHLD until we do.  */
1292
1293	  if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_AT_EOF) == 0)
1294	    fd_info[cp->fd].flags |= FILE_SEND_SIGCHLD;
1295	  /* SIG_DFL for SIGCHLD is ignore */
1296	  else if (sig_handlers[SIGCHLD] != SIG_DFL &&
1297		   sig_handlers[SIGCHLD] != SIG_IGN)
1298	    {
1299#ifdef FULL_DEBUG
1300	      DebPrint (("select calling SIGCHLD handler for pid %d\n",
1301			 cp->pid));
1302#endif
1303	      dead_child = cp;
1304	      sig_handlers[SIGCHLD] (SIGCHLD);
1305	      dead_child = NULL;
1306	    }
1307	}
1308      else if (fdindex[active] == -1)
1309	{
1310	  /* Quit (C-g) was detected.  */
1311	  errno = EINTR;
1312	  return -1;
1313	}
1314      else if (fdindex[active] == 0)
1315	{
1316	  /* Keyboard input available */
1317	  FD_SET (0, rfds);
1318	  nr++;
1319	}
1320      else
1321	{
1322	  /* must be a socket or pipe - read ahead should have
1323             completed, either succeeding or failing.  */
1324	  FD_SET (fdindex[active], rfds);
1325	  nr++;
1326	}
1327
1328      /* Even though wait_reading_process_output only reads from at most
1329	 one channel, we must process all channels here so that we reap
1330	 all children that have died.  */
1331      while (++active < nh + nc)
1332	if (WaitForSingleObject (wait_hnd[active], 0) == WAIT_OBJECT_0)
1333	  break;
1334    } while (active < nh + nc);
1335
1336  /* If no input has arrived and timeout hasn't expired, wait again.  */
1337  if (nr == 0)
1338    {
1339      DWORD elapsed = GetTickCount () - start_time;
1340
1341      if (timeout_ms > elapsed)	/* INFINITE is MAX_UINT */
1342	{
1343	  if (timeout_ms != INFINITE)
1344	    timeout_ms -= elapsed;
1345	  goto count_children;
1346	}
1347    }
1348
1349  return nr;
1350}
1351
1352/* Substitute for certain kill () operations */
1353
1354static BOOL CALLBACK
1355find_child_console (HWND hwnd, LPARAM arg)
1356{
1357  child_process * cp = (child_process *) arg;
1358  DWORD thread_id;
1359  DWORD process_id;
1360
1361  thread_id = GetWindowThreadProcessId (hwnd, &process_id);
1362  if (process_id == cp->procinfo.dwProcessId)
1363    {
1364      char window_class[32];
1365
1366      GetClassName (hwnd, window_class, sizeof (window_class));
1367      if (strcmp (window_class,
1368		  (os_subtype == OS_WIN95)
1369		  ? "tty"
1370		  : "ConsoleWindowClass") == 0)
1371	{
1372	  cp->hwnd = hwnd;
1373	  return FALSE;
1374	}
1375    }
1376  /* keep looking */
1377  return TRUE;
1378}
1379
1380int
1381sys_kill (int pid, int sig)
1382{
1383  child_process *cp;
1384  HANDLE proc_hand;
1385  int need_to_free = 0;
1386  int rc = 0;
1387
1388  /* Only handle signals that will result in the process dying */
1389  if (sig != SIGINT && sig != SIGKILL && sig != SIGQUIT && sig != SIGHUP)
1390    {
1391      errno = EINVAL;
1392      return -1;
1393    }
1394
1395  cp = find_child_pid (pid);
1396  if (cp == NULL)
1397    {
1398      proc_hand = OpenProcess (PROCESS_TERMINATE, 0, pid);
1399      if (proc_hand == NULL)
1400        {
1401	  errno = EPERM;
1402	  return -1;
1403	}
1404      need_to_free = 1;
1405    }
1406  else
1407    {
1408      proc_hand = cp->procinfo.hProcess;
1409      pid = cp->procinfo.dwProcessId;
1410
1411      /* Try to locate console window for process. */
1412      EnumWindows (find_child_console, (LPARAM) cp);
1413    }
1414
1415  if (sig == SIGINT || sig == SIGQUIT)
1416    {
1417      if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
1418	{
1419	  BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0);
1420	  /* Fake Ctrl-C for SIGINT, and Ctrl-Break for SIGQUIT.  */
1421	  BYTE vk_break_code = (sig == SIGINT) ? 'C' : VK_CANCEL;
1422	  BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
1423	  HWND foreground_window;
1424
1425	  if (break_scan_code == 0)
1426	    {
1427	      /* Fake Ctrl-C for SIGQUIT if we can't manage Ctrl-Break. */
1428	      vk_break_code = 'C';
1429	      break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
1430	    }
1431
1432	  foreground_window = GetForegroundWindow ();
1433	  if (foreground_window)
1434	    {
1435              /* NT 5.0, and apparently also Windows 98, will not allow
1436		 a Window to be set to foreground directly without the
1437		 user's involvement. The workaround is to attach
1438		 ourselves to the thread that owns the foreground
1439		 window, since that is the only thread that can set the
1440		 foreground window.  */
1441              DWORD foreground_thread, child_thread;
1442              foreground_thread =
1443		GetWindowThreadProcessId (foreground_window, NULL);
1444	      if (foreground_thread == GetCurrentThreadId ()
1445                  || !AttachThreadInput (GetCurrentThreadId (),
1446                                         foreground_thread, TRUE))
1447                foreground_thread = 0;
1448
1449              child_thread = GetWindowThreadProcessId (cp->hwnd, NULL);
1450	      if (child_thread == GetCurrentThreadId ()
1451                  || !AttachThreadInput (GetCurrentThreadId (),
1452                                         child_thread, TRUE))
1453                child_thread = 0;
1454
1455              /* Set the foreground window to the child.  */
1456              if (SetForegroundWindow (cp->hwnd))
1457                {
1458                  /* Generate keystrokes as if user had typed Ctrl-Break or
1459                     Ctrl-C.  */
1460                  keybd_event (VK_CONTROL, control_scan_code, 0, 0);
1461                  keybd_event (vk_break_code, break_scan_code,
1462		    (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0);
1463                  keybd_event (vk_break_code, break_scan_code,
1464                    (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY)
1465                    | KEYEVENTF_KEYUP, 0);
1466                  keybd_event (VK_CONTROL, control_scan_code,
1467                               KEYEVENTF_KEYUP, 0);
1468
1469                  /* Sleep for a bit to give time for Emacs frame to respond
1470                     to focus change events (if Emacs was active app).  */
1471                  Sleep (100);
1472
1473                  SetForegroundWindow (foreground_window);
1474                }
1475              /* Detach from the foreground and child threads now that
1476                 the foreground switching is over.  */
1477              if (foreground_thread)
1478                AttachThreadInput (GetCurrentThreadId (),
1479                                   foreground_thread, FALSE);
1480              if (child_thread)
1481                AttachThreadInput (GetCurrentThreadId (),
1482                                   child_thread, FALSE);
1483            }
1484        }
1485      /* Ctrl-Break is NT equivalent of SIGINT.  */
1486      else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid))
1487        {
1488	  DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
1489		     "for pid %lu\n", GetLastError (), pid));
1490	  errno = EINVAL;
1491	  rc = -1;
1492	}
1493    }
1494  else
1495    {
1496      if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
1497	{
1498#if 1
1499	  if (os_subtype == OS_WIN95)
1500	    {
1501/*
1502   Another possibility is to try terminating the VDM out-right by
1503   calling the Shell VxD (id 0x17) V86 interface, function #4
1504   "SHELL_Destroy_VM", ie.
1505
1506     mov edx,4
1507     mov ebx,vm_handle
1508     call shellapi
1509
1510   First need to determine the current VM handle, and then arrange for
1511   the shellapi call to be made from the system vm (by using
1512   Switch_VM_and_callback).
1513
1514   Could try to invoke DestroyVM through CallVxD.
1515
1516*/
1517#if 0
1518	      /* On Win95, posting WM_QUIT causes the 16-bit subsystem
1519		 to hang when cmdproxy is used in conjunction with
1520		 command.com for an interactive shell.  Posting
1521		 WM_CLOSE pops up a dialog that, when Yes is selected,
1522		 does the same thing.  TerminateProcess is also less
1523		 than ideal in that subprocesses tend to stick around
1524		 until the machine is shutdown, but at least it
1525		 doesn't freeze the 16-bit subsystem.  */
1526	      PostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
1527#endif
1528	      if (!TerminateProcess (proc_hand, 0xff))
1529		{
1530		  DebPrint (("sys_kill.TerminateProcess returned %d "
1531			     "for pid %lu\n", GetLastError (), pid));
1532		  errno = EINVAL;
1533		  rc = -1;
1534		}
1535	    }
1536	  else
1537#endif
1538	    PostMessage (cp->hwnd, WM_CLOSE, 0, 0);
1539	}
1540      /* Kill the process.  On W32 this doesn't kill child processes
1541	 so it doesn't work very well for shells which is why it's not
1542	 used in every case.  */
1543      else if (!TerminateProcess (proc_hand, 0xff))
1544        {
1545	  DebPrint (("sys_kill.TerminateProcess returned %d "
1546		     "for pid %lu\n", GetLastError (), pid));
1547	  errno = EINVAL;
1548	  rc = -1;
1549        }
1550    }
1551
1552  if (need_to_free)
1553    CloseHandle (proc_hand);
1554
1555  return rc;
1556}
1557
1558/* extern int report_file_error (char *, Lisp_Object); */
1559
1560/* The following two routines are used to manipulate stdin, stdout, and
1561   stderr of our child processes.
1562
1563   Assuming that in, out, and err are *not* inheritable, we make them
1564   stdin, stdout, and stderr of the child as follows:
1565
1566   - Save the parent's current standard handles.
1567   - Set the std handles to inheritable duplicates of the ones being passed in.
1568     (Note that _get_osfhandle() is an io.h procedure that retrieves the
1569     NT file handle for a crt file descriptor.)
1570   - Spawn the child, which inherits in, out, and err as stdin,
1571     stdout, and stderr. (see Spawnve)
1572   - Close the std handles passed to the child.
1573   - Reset the parent's standard handles to the saved handles.
1574     (see reset_standard_handles)
1575   We assume that the caller closes in, out, and err after calling us.  */
1576
1577void
1578prepare_standard_handles (int in, int out, int err, HANDLE handles[3])
1579{
1580  HANDLE parent;
1581  HANDLE newstdin, newstdout, newstderr;
1582
1583  parent = GetCurrentProcess ();
1584
1585  handles[0] = GetStdHandle (STD_INPUT_HANDLE);
1586  handles[1] = GetStdHandle (STD_OUTPUT_HANDLE);
1587  handles[2] = GetStdHandle (STD_ERROR_HANDLE);
1588
1589  /* make inheritable copies of the new handles */
1590  if (!DuplicateHandle (parent,
1591		       (HANDLE) _get_osfhandle (in),
1592		       parent,
1593		       &newstdin,
1594		       0,
1595		       TRUE,
1596		       DUPLICATE_SAME_ACCESS))
1597    report_file_error ("Duplicating input handle for child", Qnil);
1598
1599  if (!DuplicateHandle (parent,
1600		       (HANDLE) _get_osfhandle (out),
1601		       parent,
1602		       &newstdout,
1603		       0,
1604		       TRUE,
1605		       DUPLICATE_SAME_ACCESS))
1606    report_file_error ("Duplicating output handle for child", Qnil);
1607
1608  if (!DuplicateHandle (parent,
1609		       (HANDLE) _get_osfhandle (err),
1610		       parent,
1611		       &newstderr,
1612		       0,
1613		       TRUE,
1614		       DUPLICATE_SAME_ACCESS))
1615    report_file_error ("Duplicating error handle for child", Qnil);
1616
1617  /* and store them as our std handles */
1618  if (!SetStdHandle (STD_INPUT_HANDLE, newstdin))
1619    report_file_error ("Changing stdin handle", Qnil);
1620
1621  if (!SetStdHandle (STD_OUTPUT_HANDLE, newstdout))
1622    report_file_error ("Changing stdout handle", Qnil);
1623
1624  if (!SetStdHandle (STD_ERROR_HANDLE, newstderr))
1625    report_file_error ("Changing stderr handle", Qnil);
1626}
1627
1628void
1629reset_standard_handles (int in, int out, int err, HANDLE handles[3])
1630{
1631  /* close the duplicated handles passed to the child */
1632  CloseHandle (GetStdHandle (STD_INPUT_HANDLE));
1633  CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE));
1634  CloseHandle (GetStdHandle (STD_ERROR_HANDLE));
1635
1636  /* now restore parent's saved std handles */
1637  SetStdHandle (STD_INPUT_HANDLE, handles[0]);
1638  SetStdHandle (STD_OUTPUT_HANDLE, handles[1]);
1639  SetStdHandle (STD_ERROR_HANDLE, handles[2]);
1640}
1641
1642void
1643set_process_dir (char * dir)
1644{
1645  process_dir = dir;
1646}
1647
1648#ifdef HAVE_SOCKETS
1649
1650/* To avoid problems with winsock implementations that work over dial-up
1651   connections causing or requiring a connection to exist while Emacs is
1652   running, Emacs no longer automatically loads winsock on startup if it
1653   is present.  Instead, it will be loaded when open-network-stream is
1654   first called.
1655
1656   To allow full control over when winsock is loaded, we provide these
1657   two functions to dynamically load and unload winsock.  This allows
1658   dial-up users to only be connected when they actually need to use
1659   socket services.  */
1660
1661/* From nt.c */
1662extern HANDLE winsock_lib;
1663extern BOOL term_winsock (void);
1664extern BOOL init_winsock (int load_now);
1665
1666extern Lisp_Object Vsystem_name;
1667
1668DEFUN ("w32-has-winsock", Fw32_has_winsock, Sw32_has_winsock, 0, 1, 0,
1669       doc: /* Test for presence of the Windows socket library `winsock'.
1670Returns non-nil if winsock support is present, nil otherwise.
1671
1672If the optional argument LOAD-NOW is non-nil, the winsock library is
1673also loaded immediately if not already loaded.  If winsock is loaded,
1674the winsock local hostname is returned (since this may be different from
1675the value of `system-name' and should supplant it), otherwise t is
1676returned to indicate winsock support is present.  */)
1677  (load_now)
1678     Lisp_Object load_now;
1679{
1680  int have_winsock;
1681
1682  have_winsock = init_winsock (!NILP (load_now));
1683  if (have_winsock)
1684    {
1685      if (winsock_lib != NULL)
1686	{
1687	  /* Return new value for system-name.  The best way to do this
1688	     is to call init_system_name, saving and restoring the
1689	     original value to avoid side-effects.  */
1690	  Lisp_Object orig_hostname = Vsystem_name;
1691	  Lisp_Object hostname;
1692
1693	  init_system_name ();
1694	  hostname = Vsystem_name;
1695	  Vsystem_name = orig_hostname;
1696	  return hostname;
1697	}
1698      return Qt;
1699    }
1700  return Qnil;
1701}
1702
1703DEFUN ("w32-unload-winsock", Fw32_unload_winsock, Sw32_unload_winsock,
1704       0, 0, 0,
1705       doc: /* Unload the Windows socket library `winsock' if loaded.
1706This is provided to allow dial-up socket connections to be disconnected
1707when no longer needed.  Returns nil without unloading winsock if any
1708socket connections still exist.  */)
1709  ()
1710{
1711  return term_winsock () ? Qt : Qnil;
1712}
1713
1714#endif /* HAVE_SOCKETS */
1715
1716
1717/* Some miscellaneous functions that are Windows specific, but not GUI
1718   specific (ie. are applicable in terminal or batch mode as well).  */
1719
1720/* lifted from fileio.c  */
1721#define CORRECT_DIR_SEPS(s) \
1722  do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
1723       else unixtodos_filename (s); \
1724  } while (0)
1725
1726DEFUN ("w32-short-file-name", Fw32_short_file_name, Sw32_short_file_name, 1, 1, 0,
1727       doc: /* Return the short file name version (8.3) of the full path of FILENAME.
1728If FILENAME does not exist, return nil.
1729All path elements in FILENAME are converted to their short names.  */)
1730     (filename)
1731     Lisp_Object filename;
1732{
1733  char shortname[MAX_PATH];
1734
1735  CHECK_STRING (filename);
1736
1737  /* first expand it.  */
1738  filename = Fexpand_file_name (filename, Qnil);
1739
1740  /* luckily, this returns the short version of each element in the path.  */
1741  if (GetShortPathName (SDATA (filename), shortname, MAX_PATH) == 0)
1742    return Qnil;
1743
1744  CORRECT_DIR_SEPS (shortname);
1745
1746  return build_string (shortname);
1747}
1748
1749
1750DEFUN ("w32-long-file-name", Fw32_long_file_name, Sw32_long_file_name,
1751       1, 1, 0,
1752       doc: /* Return the long file name version of the full path of FILENAME.
1753If FILENAME does not exist, return nil.
1754All path elements in FILENAME are converted to their long names.  */)
1755  (filename)
1756     Lisp_Object filename;
1757{
1758  char longname[ MAX_PATH ];
1759
1760  CHECK_STRING (filename);
1761
1762  /* first expand it.  */
1763  filename = Fexpand_file_name (filename, Qnil);
1764
1765  if (!w32_get_long_filename (SDATA (filename), longname, MAX_PATH))
1766    return Qnil;
1767
1768  CORRECT_DIR_SEPS (longname);
1769
1770  return build_string (longname);
1771}
1772
1773DEFUN ("w32-set-process-priority", Fw32_set_process_priority,
1774       Sw32_set_process_priority, 2, 2, 0,
1775       doc: /* Set the priority of PROCESS to PRIORITY.
1776If PROCESS is nil, the priority of Emacs is changed, otherwise the
1777priority of the process whose pid is PROCESS is changed.
1778PRIORITY should be one of the symbols high, normal, or low;
1779any other symbol will be interpreted as normal.
1780
1781If successful, the return value is t, otherwise nil.  */)
1782  (process, priority)
1783     Lisp_Object process, priority;
1784{
1785  HANDLE proc_handle = GetCurrentProcess ();
1786  DWORD  priority_class = NORMAL_PRIORITY_CLASS;
1787  Lisp_Object result = Qnil;
1788
1789  CHECK_SYMBOL (priority);
1790
1791  if (!NILP (process))
1792    {
1793      DWORD pid;
1794      child_process *cp;
1795
1796      CHECK_NUMBER (process);
1797
1798      /* Allow pid to be an internally generated one, or one obtained
1799	 externally.  This is necessary because real pids on Win95 are
1800	 negative.  */
1801
1802      pid = XINT (process);
1803      cp = find_child_pid (pid);
1804      if (cp != NULL)
1805	pid = cp->procinfo.dwProcessId;
1806
1807      proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
1808    }
1809
1810  if (EQ (priority, Qhigh))
1811    priority_class = HIGH_PRIORITY_CLASS;
1812  else if (EQ (priority, Qlow))
1813    priority_class = IDLE_PRIORITY_CLASS;
1814
1815  if (proc_handle != NULL)
1816    {
1817      if (SetPriorityClass (proc_handle, priority_class))
1818	result = Qt;
1819      if (!NILP (process))
1820	CloseHandle (proc_handle);
1821    }
1822
1823  return result;
1824}
1825
1826#ifdef HAVE_LANGINFO_CODESET
1827/* Emulation of nl_langinfo.  Used in fns.c:Flocale_info.  */
1828char *nl_langinfo (nl_item item)
1829{
1830  /* Conversion of Posix item numbers to their Windows equivalents.  */
1831  static const LCTYPE w32item[] = {
1832    LOCALE_IDEFAULTANSICODEPAGE,
1833    LOCALE_SDAYNAME1, LOCALE_SDAYNAME2, LOCALE_SDAYNAME3,
1834    LOCALE_SDAYNAME4, LOCALE_SDAYNAME5, LOCALE_SDAYNAME6, LOCALE_SDAYNAME7,
1835    LOCALE_SMONTHNAME1, LOCALE_SMONTHNAME2, LOCALE_SMONTHNAME3,
1836    LOCALE_SMONTHNAME4, LOCALE_SMONTHNAME5, LOCALE_SMONTHNAME6,
1837    LOCALE_SMONTHNAME7, LOCALE_SMONTHNAME8, LOCALE_SMONTHNAME9,
1838    LOCALE_SMONTHNAME10, LOCALE_SMONTHNAME11, LOCALE_SMONTHNAME12
1839  };
1840
1841  static char *nl_langinfo_buf = NULL;
1842  static int   nl_langinfo_len = 0;
1843
1844  if (nl_langinfo_len <= 0)
1845    nl_langinfo_buf = xmalloc (nl_langinfo_len = 1);
1846
1847  if (item < 0 || item >= _NL_NUM)
1848    nl_langinfo_buf[0] = 0;
1849  else
1850    {
1851      LCID cloc = GetThreadLocale ();
1852      int need_len = GetLocaleInfo (cloc, w32item[item] | LOCALE_USE_CP_ACP,
1853				    NULL, 0);
1854
1855      if (need_len <= 0)
1856	nl_langinfo_buf[0] = 0;
1857      else
1858	{
1859	  if (item == CODESET)
1860	    {
1861	      need_len += 2;	/* for the "cp" prefix */
1862	      if (need_len < 8)	/* for the case we call GetACP */
1863		need_len = 8;
1864	    }
1865	  if (nl_langinfo_len <= need_len)
1866	    nl_langinfo_buf = xrealloc (nl_langinfo_buf,
1867					nl_langinfo_len = need_len);
1868	  if (!GetLocaleInfo (cloc, w32item[item] | LOCALE_USE_CP_ACP,
1869			      nl_langinfo_buf, nl_langinfo_len))
1870	    nl_langinfo_buf[0] = 0;
1871	  else if (item == CODESET)
1872	    {
1873	      if (strcmp (nl_langinfo_buf, "0") == 0 /* CP_ACP */
1874		  || strcmp (nl_langinfo_buf, "1") == 0) /* CP_OEMCP */
1875		sprintf (nl_langinfo_buf, "cp%u", GetACP ());
1876	      else
1877		{
1878		  memmove (nl_langinfo_buf + 2, nl_langinfo_buf,
1879			   strlen (nl_langinfo_buf) + 1);
1880		  nl_langinfo_buf[0] = 'c';
1881		  nl_langinfo_buf[1] = 'p';
1882		}
1883	    }
1884	}
1885    }
1886  return nl_langinfo_buf;
1887}
1888#endif	/* HAVE_LANGINFO_CODESET */
1889
1890DEFUN ("w32-get-locale-info", Fw32_get_locale_info,
1891       Sw32_get_locale_info, 1, 2, 0,
1892       doc: /* Return information about the Windows locale LCID.
1893By default, return a three letter locale code which encodes the default
1894language as the first two characters, and the country or regionial variant
1895as the third letter.  For example, ENU refers to `English (United States)',
1896while ENC means `English (Canadian)'.
1897
1898If the optional argument LONGFORM is t, the long form of the locale
1899name is returned, e.g. `English (United States)' instead; if LONGFORM
1900is a number, it is interpreted as an LCTYPE constant and the corresponding
1901locale information is returned.
1902
1903If LCID (a 16-bit number) is not a valid locale, the result is nil.  */)
1904     (lcid, longform)
1905     Lisp_Object lcid, longform;
1906{
1907  int got_abbrev;
1908  int got_full;
1909  char abbrev_name[32] = { 0 };
1910  char full_name[256] = { 0 };
1911
1912  CHECK_NUMBER (lcid);
1913
1914  if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
1915    return Qnil;
1916
1917  if (NILP (longform))
1918    {
1919      got_abbrev = GetLocaleInfo (XINT (lcid),
1920				  LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
1921				  abbrev_name, sizeof (abbrev_name));
1922      if (got_abbrev)
1923	return build_string (abbrev_name);
1924    }
1925  else if (EQ (longform, Qt))
1926    {
1927      got_full = GetLocaleInfo (XINT (lcid),
1928				LOCALE_SLANGUAGE | LOCALE_USE_CP_ACP,
1929				full_name, sizeof (full_name));
1930      if (got_full)
1931	return build_string (full_name);
1932    }
1933  else if (NUMBERP (longform))
1934    {
1935      got_full = GetLocaleInfo (XINT (lcid),
1936				XINT (longform),
1937				full_name, sizeof (full_name));
1938      if (got_full)
1939	return make_unibyte_string (full_name, got_full);
1940    }
1941
1942  return Qnil;
1943}
1944
1945
1946DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id,
1947       Sw32_get_current_locale_id, 0, 0, 0,
1948       doc: /* Return Windows locale id for current locale setting.
1949This is a numerical value; use `w32-get-locale-info' to convert to a
1950human-readable form.  */)
1951     ()
1952{
1953  return make_number (GetThreadLocale ());
1954}
1955
1956DWORD int_from_hex (char * s)
1957{
1958  DWORD val = 0;
1959  static char hex[] = "0123456789abcdefABCDEF";
1960  char * p;
1961
1962  while (*s && (p = strchr(hex, *s)) != NULL)
1963    {
1964      unsigned digit = p - hex;
1965      if (digit > 15)
1966	digit -= 6;
1967      val = val * 16 + digit;
1968      s++;
1969    }
1970  return val;
1971}
1972
1973/* We need to build a global list, since the EnumSystemLocale callback
1974   function isn't given a context pointer.  */
1975Lisp_Object Vw32_valid_locale_ids;
1976
1977BOOL CALLBACK enum_locale_fn (LPTSTR localeNum)
1978{
1979  DWORD id = int_from_hex (localeNum);
1980  Vw32_valid_locale_ids = Fcons (make_number (id), Vw32_valid_locale_ids);
1981  return TRUE;
1982}
1983
1984DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids,
1985       Sw32_get_valid_locale_ids, 0, 0, 0,
1986       doc: /* Return list of all valid Windows locale ids.
1987Each id is a numerical value; use `w32-get-locale-info' to convert to a
1988human-readable form.  */)
1989     ()
1990{
1991  Vw32_valid_locale_ids = Qnil;
1992
1993  EnumSystemLocales (enum_locale_fn, LCID_SUPPORTED);
1994
1995  Vw32_valid_locale_ids = Fnreverse (Vw32_valid_locale_ids);
1996  return Vw32_valid_locale_ids;
1997}
1998
1999
2000DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id, Sw32_get_default_locale_id, 0, 1, 0,
2001       doc: /* Return Windows locale id for default locale setting.
2002By default, the system default locale setting is returned; if the optional
2003parameter USERP is non-nil, the user default locale setting is returned.
2004This is a numerical value; use `w32-get-locale-info' to convert to a
2005human-readable form.  */)
2006     (userp)
2007     Lisp_Object userp;
2008{
2009  if (NILP (userp))
2010    return make_number (GetSystemDefaultLCID ());
2011  return make_number (GetUserDefaultLCID ());
2012}
2013
2014
2015DEFUN ("w32-set-current-locale", Fw32_set_current_locale, Sw32_set_current_locale, 1, 1, 0,
2016       doc: /* Make Windows locale LCID be the current locale setting for Emacs.
2017If successful, the new locale id is returned, otherwise nil.  */)
2018     (lcid)
2019     Lisp_Object lcid;
2020{
2021  CHECK_NUMBER (lcid);
2022
2023  if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
2024    return Qnil;
2025
2026  if (!SetThreadLocale (XINT (lcid)))
2027    return Qnil;
2028
2029  /* Need to set input thread locale if present.  */
2030  if (dwWindowsThreadId)
2031    /* Reply is not needed.  */
2032    PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0);
2033
2034  return make_number (GetThreadLocale ());
2035}
2036
2037
2038/* We need to build a global list, since the EnumCodePages callback
2039   function isn't given a context pointer.  */
2040Lisp_Object Vw32_valid_codepages;
2041
2042BOOL CALLBACK enum_codepage_fn (LPTSTR codepageNum)
2043{
2044  DWORD id = atoi (codepageNum);
2045  Vw32_valid_codepages = Fcons (make_number (id), Vw32_valid_codepages);
2046  return TRUE;
2047}
2048
2049DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages,
2050       Sw32_get_valid_codepages, 0, 0, 0,
2051       doc: /* Return list of all valid Windows codepages.  */)
2052     ()
2053{
2054  Vw32_valid_codepages = Qnil;
2055
2056  EnumSystemCodePages (enum_codepage_fn, CP_SUPPORTED);
2057
2058  Vw32_valid_codepages = Fnreverse (Vw32_valid_codepages);
2059  return Vw32_valid_codepages;
2060}
2061
2062
2063DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage,
2064       Sw32_get_console_codepage, 0, 0, 0,
2065       doc: /* Return current Windows codepage for console input.  */)
2066     ()
2067{
2068  return make_number (GetConsoleCP ());
2069}
2070
2071
2072DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage,
2073       Sw32_set_console_codepage, 1, 1, 0,
2074       doc: /* Make Windows codepage CP be the current codepage setting for Emacs.
2075The codepage setting affects keyboard input and display in tty mode.
2076If successful, the new CP is returned, otherwise nil.  */)
2077     (cp)
2078     Lisp_Object cp;
2079{
2080  CHECK_NUMBER (cp);
2081
2082  if (!IsValidCodePage (XINT (cp)))
2083    return Qnil;
2084
2085  if (!SetConsoleCP (XINT (cp)))
2086    return Qnil;
2087
2088  return make_number (GetConsoleCP ());
2089}
2090
2091
2092DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage,
2093       Sw32_get_console_output_codepage, 0, 0, 0,
2094       doc: /* Return current Windows codepage for console output.  */)
2095     ()
2096{
2097  return make_number (GetConsoleOutputCP ());
2098}
2099
2100
2101DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage,
2102       Sw32_set_console_output_codepage, 1, 1, 0,
2103       doc: /* Make Windows codepage CP be the current codepage setting for Emacs.
2104The codepage setting affects keyboard input and display in tty mode.
2105If successful, the new CP is returned, otherwise nil.  */)
2106     (cp)
2107     Lisp_Object cp;
2108{
2109  CHECK_NUMBER (cp);
2110
2111  if (!IsValidCodePage (XINT (cp)))
2112    return Qnil;
2113
2114  if (!SetConsoleOutputCP (XINT (cp)))
2115    return Qnil;
2116
2117  return make_number (GetConsoleOutputCP ());
2118}
2119
2120
2121DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset,
2122       Sw32_get_codepage_charset, 1, 1, 0,
2123       doc: /* Return charset of codepage CP.
2124Returns nil if the codepage is not valid.  */)
2125     (cp)
2126     Lisp_Object cp;
2127{
2128  CHARSETINFO info;
2129
2130  CHECK_NUMBER (cp);
2131
2132  if (!IsValidCodePage (XINT (cp)))
2133    return Qnil;
2134
2135  if (TranslateCharsetInfo ((DWORD *) XINT (cp), &info, TCI_SRCCODEPAGE))
2136    return make_number (info.ciCharset);
2137
2138  return Qnil;
2139}
2140
2141
2142DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts,
2143       Sw32_get_valid_keyboard_layouts, 0, 0, 0,
2144       doc: /* Return list of Windows keyboard languages and layouts.
2145The return value is a list of pairs of language id and layout id.  */)
2146     ()
2147{
2148  int num_layouts = GetKeyboardLayoutList (0, NULL);
2149  HKL * layouts = (HKL *) alloca (num_layouts * sizeof (HKL));
2150  Lisp_Object obj = Qnil;
2151
2152  if (GetKeyboardLayoutList (num_layouts, layouts) == num_layouts)
2153    {
2154      while (--num_layouts >= 0)
2155	{
2156	  DWORD kl = (DWORD) layouts[num_layouts];
2157
2158	  obj = Fcons (Fcons (make_number (kl & 0xffff),
2159			      make_number ((kl >> 16) & 0xffff)),
2160		       obj);
2161	}
2162    }
2163
2164  return obj;
2165}
2166
2167
2168DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout,
2169       Sw32_get_keyboard_layout, 0, 0, 0,
2170       doc: /* Return current Windows keyboard language and layout.
2171The return value is the cons of the language id and the layout id.  */)
2172     ()
2173{
2174  DWORD kl = (DWORD) GetKeyboardLayout (dwWindowsThreadId);
2175
2176  return Fcons (make_number (kl & 0xffff),
2177		make_number ((kl >> 16) & 0xffff));
2178}
2179
2180
2181DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout,
2182       Sw32_set_keyboard_layout, 1, 1, 0,
2183       doc: /* Make LAYOUT be the current keyboard layout for Emacs.
2184The keyboard layout setting affects interpretation of keyboard input.
2185If successful, the new layout id is returned, otherwise nil.  */)
2186     (layout)
2187     Lisp_Object layout;
2188{
2189  DWORD kl;
2190
2191  CHECK_CONS (layout);
2192  CHECK_NUMBER_CAR (layout);
2193  CHECK_NUMBER_CDR (layout);
2194
2195  kl = (XINT (XCAR (layout)) & 0xffff)
2196    | (XINT (XCDR (layout)) << 16);
2197
2198  /* Synchronize layout with input thread.  */
2199  if (dwWindowsThreadId)
2200    {
2201      if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETKEYBOARDLAYOUT,
2202			     (WPARAM) kl, 0))
2203	{
2204	  MSG msg;
2205	  GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
2206
2207	  if (msg.wParam == 0)
2208	    return Qnil;
2209	}
2210    }
2211  else if (!ActivateKeyboardLayout ((HKL) kl, 0))
2212    return Qnil;
2213
2214  return Fw32_get_keyboard_layout ();
2215}
2216
2217
2218syms_of_ntproc ()
2219{
2220  Qhigh = intern ("high");
2221  Qlow = intern ("low");
2222  staticpro (&Qhigh);
2223  staticpro (&Qlow);
2224
2225#ifdef HAVE_SOCKETS
2226  defsubr (&Sw32_has_winsock);
2227  defsubr (&Sw32_unload_winsock);
2228#endif
2229  defsubr (&Sw32_short_file_name);
2230  defsubr (&Sw32_long_file_name);
2231  defsubr (&Sw32_set_process_priority);
2232  defsubr (&Sw32_get_locale_info);
2233  defsubr (&Sw32_get_current_locale_id);
2234  defsubr (&Sw32_get_default_locale_id);
2235  defsubr (&Sw32_get_valid_locale_ids);
2236  defsubr (&Sw32_set_current_locale);
2237
2238  defsubr (&Sw32_get_console_codepage);
2239  defsubr (&Sw32_set_console_codepage);
2240  defsubr (&Sw32_get_console_output_codepage);
2241  defsubr (&Sw32_set_console_output_codepage);
2242  defsubr (&Sw32_get_valid_codepages);
2243  defsubr (&Sw32_get_codepage_charset);
2244
2245  defsubr (&Sw32_get_valid_keyboard_layouts);
2246  defsubr (&Sw32_get_keyboard_layout);
2247  defsubr (&Sw32_set_keyboard_layout);
2248
2249  DEFVAR_LISP ("w32-quote-process-args", &Vw32_quote_process_args,
2250	       doc: /* Non-nil enables quoting of process arguments to ensure correct parsing.
2251Because Windows does not directly pass argv arrays to child processes,
2252programs have to reconstruct the argv array by parsing the command
2253line string.  For an argument to contain a space, it must be enclosed
2254in double quotes or it will be parsed as multiple arguments.
2255
2256If the value is a character, that character will be used to escape any
2257quote characters that appear, otherwise a suitable escape character
2258will be chosen based on the type of the program.  */);
2259  Vw32_quote_process_args = Qt;
2260
2261  DEFVAR_LISP ("w32-start-process-show-window",
2262	       &Vw32_start_process_show_window,
2263	       doc: /* When nil, new child processes hide their windows.
2264When non-nil, they show their window in the method of their choice.
2265This variable doesn't affect GUI applications, which will never be hidden.  */);
2266  Vw32_start_process_show_window = Qnil;
2267
2268  DEFVAR_LISP ("w32-start-process-share-console",
2269	       &Vw32_start_process_share_console,
2270	       doc: /* When nil, new child processes are given a new console.
2271When non-nil, they share the Emacs console; this has the limitation of
2272allowing only one DOS subprocess to run at a time (whether started directly
2273or indirectly by Emacs), and preventing Emacs from cleanly terminating the
2274subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
2275otherwise respond to interrupts from Emacs.  */);
2276  Vw32_start_process_share_console = Qnil;
2277
2278  DEFVAR_LISP ("w32-start-process-inherit-error-mode",
2279	       &Vw32_start_process_inherit_error_mode,
2280	       doc: /* When nil, new child processes revert to the default error mode.
2281When non-nil, they inherit their error mode setting from Emacs, which stops
2282them blocking when trying to access unmounted drives etc.  */);
2283  Vw32_start_process_inherit_error_mode = Qt;
2284
2285  DEFVAR_INT ("w32-pipe-read-delay", &w32_pipe_read_delay,
2286	      doc: /* Forced delay before reading subprocess output.
2287This is done to improve the buffering of subprocess output, by
2288avoiding the inefficiency of frequently reading small amounts of data.
2289
2290If positive, the value is the number of milliseconds to sleep before
2291reading the subprocess output.  If negative, the magnitude is the number
2292of time slices to wait (effectively boosting the priority of the child
2293process temporarily).  A value of zero disables waiting entirely.  */);
2294  w32_pipe_read_delay = 50;
2295
2296  DEFVAR_LISP ("w32-downcase-file-names", &Vw32_downcase_file_names,
2297	       doc: /* Non-nil means convert all-upper case file names to lower case.
2298This applies when performing completions and file name expansion.
2299Note that the value of this setting also affects remote file names,
2300so you probably don't want to set to non-nil if you use case-sensitive
2301filesystems via ange-ftp.  */);
2302  Vw32_downcase_file_names = Qnil;
2303
2304#if 0
2305  DEFVAR_LISP ("w32-generate-fake-inodes", &Vw32_generate_fake_inodes,
2306	       doc: /* Non-nil means attempt to fake realistic inode values.
2307This works by hashing the truename of files, and should detect
2308aliasing between long and short (8.3 DOS) names, but can have
2309false positives because of hash collisions.  Note that determing
2310the truename of a file can be slow.  */);
2311  Vw32_generate_fake_inodes = Qnil;
2312#endif
2313
2314  DEFVAR_LISP ("w32-get-true-file-attributes", &Vw32_get_true_file_attributes,
2315	       doc: /* Non-nil means determine accurate link count in `file-attributes'.
2316Note that this option is only useful for files on NTFS volumes, where hard links
2317are supported.  Moreover, it slows down `file-attributes' noticeably.  */);
2318  Vw32_get_true_file_attributes = Qt;
2319
2320  staticpro (&Vw32_valid_locale_ids);
2321  staticpro (&Vw32_valid_codepages);
2322}
2323/* end of ntproc.c */
2324
2325/* arch-tag: 23d3a34c-06d2-48a1-833b-ac7609aa5250
2326   (do not change this comment) */
2327