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
32 /* must include CRT headers *before* config.h */
43 /* This definition is missing from mingw32 headers. */
44 extern BOOL WINAPI
IsValidLocale (LCID
, DWORD
);
47 #ifdef HAVE_LANGINFO_CODESET
58 #include "syssignal.h"
60 #include "dispextern.h" /* for xstrcasecmp */
63 #define RVA_TO_PTR(var,section,filedata) \
64 ((void *)((section)->PointerToRawData \
65 + ((DWORD)(var) - (section)->VirtualAddress) \
66 + (filedata).file_base))
68 Lisp_Object Qhigh
, Qlow
;
72 _DebPrint (const char *fmt
, ...)
78 vsprintf (buf
, fmt
, args
);
80 OutputDebugString (buf
);
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 /* Improve on the CRT 'signal' implementation so that we could record
90 the SIGCHLD handler. */
92 sys_signal (int sig
, signal_handler handler
)
96 /* SIGCHLD is needed for supporting subprocesses, see sys_kill
97 below. All the others are the only ones supported by the MS
99 if (!(sig
== SIGCHLD
|| sig
== SIGSEGV
|| sig
== SIGILL
100 || sig
== SIGFPE
|| sig
== SIGABRT
|| sig
== SIGTERM
))
105 old
= sig_handlers
[sig
];
106 /* SIGABRT is treated specially because w32.c installs term_ntproc
107 as its handler, so we don't want to override that afterwards.
108 Aborting Emacs works specially anyway: either by calling
109 emacs_abort directly or through terminate_due_to_signal, which
110 calls emacs_abort through emacs_raise. */
111 if (!(sig
== SIGABRT
&& old
== term_ntproc
))
113 sig_handlers
[sig
] = handler
;
115 signal (sig
, handler
);
120 /* Emulate sigaction. */
122 sigaction (int sig
, const struct sigaction
*act
, struct sigaction
*oact
)
124 signal_handler old
= SIG_DFL
;
128 old
= sys_signal (sig
, act
->sa_handler
);
130 old
= sig_handlers
[sig
];
139 oact
->sa_handler
= old
;
141 oact
->sa_mask
= empty_mask
;
146 /* Defined in <process.h> which conflicts with the local copy */
149 /* Child process management list. */
150 int child_proc_count
= 0;
151 child_process child_procs
[ MAX_CHILDREN
];
152 child_process
*dead_child
= NULL
;
154 static DWORD WINAPI
reader_thread (void *arg
);
156 /* Find an unused process slot. */
163 for (cp
= child_procs
+ (child_proc_count
-1); cp
>= child_procs
; cp
--)
164 if (!CHILD_ACTIVE (cp
))
166 if (child_proc_count
== MAX_CHILDREN
)
168 cp
= &child_procs
[child_proc_count
++];
171 memset (cp
, 0, sizeof (*cp
));
174 cp
->procinfo
.hProcess
= NULL
;
175 cp
->status
= STATUS_READ_ERROR
;
177 /* use manual reset event so that select() will function properly */
178 cp
->char_avail
= CreateEvent (NULL
, TRUE
, FALSE
, NULL
);
181 cp
->char_consumed
= CreateEvent (NULL
, FALSE
, FALSE
, NULL
);
182 if (cp
->char_consumed
)
184 /* The 0x00010000 flag is STACK_SIZE_PARAM_IS_A_RESERVATION.
185 It means that the 64K stack we are requesting in the 2nd
186 argument is how much memory should be reserved for the
187 stack. If we don't use this flag, the memory requested
188 by the 2nd argument is the amount actually _committed_,
189 but Windows reserves 8MB of memory for each thread's
190 stack. (The 8MB figure comes from the -stack
191 command-line argument we pass to the linker when building
192 Emacs, but that's because we need a large stack for
193 Emacs's main thread.) Since we request 2GB of reserved
194 memory at startup (see w32heap.c), which is close to the
195 maximum memory available for a 32-bit process on Windows,
196 the 8MB reservation for each thread causes failures in
197 starting subprocesses, because we create a thread running
198 reader_thread for each subprocess. As 8MB of stack is
199 way too much for reader_thread, forcing Windows to
200 reserve less wins the day. */
201 cp
->thrd
= CreateThread (NULL
, 64 * 1024, reader_thread
, cp
,
212 delete_child (child_process
*cp
)
216 /* Should not be deleting a child that is still needed. */
217 for (i
= 0; i
< MAXDESC
; i
++)
218 if (fd_info
[i
].cp
== cp
)
221 if (!CHILD_ACTIVE (cp
))
224 /* reap thread if necessary */
229 if (GetExitCodeThread (cp
->thrd
, &rc
) && rc
== STILL_ACTIVE
)
231 /* let the thread exit cleanly if possible */
232 cp
->status
= STATUS_READ_ERROR
;
233 SetEvent (cp
->char_consumed
);
235 /* We used to forcibly terminate the thread here, but it
236 is normally unnecessary, and in abnormal cases, the worst that
237 will happen is we have an extra idle thread hanging around
238 waiting for the zombie process. */
239 if (WaitForSingleObject (cp
->thrd
, 1000) != WAIT_OBJECT_0
)
241 DebPrint (("delete_child.WaitForSingleObject (thread) failed "
242 "with %lu for fd %ld\n", GetLastError (), cp
->fd
));
243 TerminateThread (cp
->thrd
, 0);
247 CloseHandle (cp
->thrd
);
252 CloseHandle (cp
->char_avail
);
253 cp
->char_avail
= NULL
;
255 if (cp
->char_consumed
)
257 CloseHandle (cp
->char_consumed
);
258 cp
->char_consumed
= NULL
;
261 /* update child_proc_count (highest numbered slot in use plus one) */
262 if (cp
== child_procs
+ child_proc_count
- 1)
264 for (i
= child_proc_count
-1; i
>= 0; i
--)
265 if (CHILD_ACTIVE (&child_procs
[i
]))
267 child_proc_count
= i
+ 1;
272 child_proc_count
= 0;
275 /* Find a child by pid. */
276 static child_process
*
277 find_child_pid (DWORD pid
)
281 for (cp
= child_procs
+ (child_proc_count
-1); cp
>= child_procs
; cp
--)
282 if (CHILD_ACTIVE (cp
) && pid
== cp
->pid
)
288 /* Thread proc for child process and socket reader threads. Each thread
289 is normally blocked until woken by select() to check for input by
290 reading one char. When the read completes, char_avail is signaled
291 to wake up the select emulator and the thread blocks itself again. */
293 reader_thread (void *arg
)
298 cp
= (child_process
*)arg
;
300 /* We have to wait for the go-ahead before we can start */
302 || WaitForSingleObject (cp
->char_consumed
, INFINITE
) != WAIT_OBJECT_0
310 if (fd_info
[cp
->fd
].flags
& FILE_LISTEN
)
311 rc
= _sys_wait_accept (cp
->fd
);
313 rc
= _sys_read_ahead (cp
->fd
);
315 /* The name char_avail is a misnomer - it really just means the
316 read-ahead has completed, whether successfully or not. */
317 if (!SetEvent (cp
->char_avail
))
319 DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld\n",
320 GetLastError (), cp
->fd
));
324 if (rc
== STATUS_READ_ERROR
)
327 /* If the read died, the child has died so let the thread die */
328 if (rc
== STATUS_READ_FAILED
)
331 /* Wait until our input is acknowledged before reading again */
332 if (WaitForSingleObject (cp
->char_consumed
, INFINITE
) != WAIT_OBJECT_0
)
334 DebPrint (("reader_thread.WaitForSingleObject failed with "
335 "%lu for fd %ld\n", GetLastError (), cp
->fd
));
342 /* To avoid Emacs changing directory, we just record here the directory
343 the new process should start in. This is set just before calling
344 sys_spawnve, and is not generally valid at any other time. */
345 static char * process_dir
;
348 create_child (char *exe
, char *cmdline
, char *env
, int is_gui_app
,
349 int * pPid
, child_process
*cp
)
352 SECURITY_ATTRIBUTES sec_attrs
;
354 SECURITY_DESCRIPTOR sec_desc
;
357 char dir
[ MAXPATHLEN
];
359 if (cp
== NULL
) emacs_abort ();
361 memset (&start
, 0, sizeof (start
));
362 start
.cb
= sizeof (start
);
365 if (NILP (Vw32_start_process_show_window
) && !is_gui_app
)
366 start
.dwFlags
= STARTF_USESTDHANDLES
| STARTF_USESHOWWINDOW
;
368 start
.dwFlags
= STARTF_USESTDHANDLES
;
369 start
.wShowWindow
= SW_HIDE
;
371 start
.hStdInput
= GetStdHandle (STD_INPUT_HANDLE
);
372 start
.hStdOutput
= GetStdHandle (STD_OUTPUT_HANDLE
);
373 start
.hStdError
= GetStdHandle (STD_ERROR_HANDLE
);
374 #endif /* HAVE_NTGUI */
377 /* Explicitly specify no security */
378 if (!InitializeSecurityDescriptor (&sec_desc
, SECURITY_DESCRIPTOR_REVISION
))
380 if (!SetSecurityDescriptorDacl (&sec_desc
, TRUE
, NULL
, FALSE
))
383 sec_attrs
.nLength
= sizeof (sec_attrs
);
384 sec_attrs
.lpSecurityDescriptor
= NULL
/* &sec_desc */;
385 sec_attrs
.bInheritHandle
= FALSE
;
387 strcpy (dir
, process_dir
);
388 unixtodos_filename (dir
);
390 flags
= (!NILP (Vw32_start_process_share_console
)
391 ? CREATE_NEW_PROCESS_GROUP
392 : CREATE_NEW_CONSOLE
);
393 if (NILP (Vw32_start_process_inherit_error_mode
))
394 flags
|= CREATE_DEFAULT_ERROR_MODE
;
395 if (!CreateProcess (exe
, cmdline
, &sec_attrs
, NULL
, TRUE
,
396 flags
, env
, dir
, &start
, &cp
->procinfo
))
399 cp
->pid
= (int) cp
->procinfo
.dwProcessId
;
401 /* Hack for Windows 95, which assigns large (ie negative) pids */
405 /* pid must fit in a Lisp_Int */
406 cp
->pid
= cp
->pid
& INTMASK
;
413 DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError ()););
417 /* create_child doesn't know what emacs' file handle will be for waiting
418 on output from the child, so we need to make this additional call
419 to register the handle with the process
420 This way the select emulator knows how to match file handles with
421 entries in child_procs. */
423 register_child (int pid
, int fd
)
427 cp
= find_child_pid (pid
);
430 DebPrint (("register_child unable to find pid %lu\n", pid
));
435 DebPrint (("register_child registered fd %d with pid %lu\n", fd
, pid
));
440 /* thread is initially blocked until select is called; set status so
441 that select will release thread */
442 cp
->status
= STATUS_READ_ACKNOWLEDGED
;
444 /* attach child_process to fd_info */
445 if (fd_info
[fd
].cp
!= NULL
)
447 DebPrint (("register_child: fd_info[%d] apparently in use!\n", fd
));
454 /* When a process dies its pipe will break so the reader thread will
455 signal failure to the select emulator.
456 The select emulator then calls this routine to clean up.
457 Since the thread signaled failure we can assume it is exiting. */
459 reap_subprocess (child_process
*cp
)
461 if (cp
->procinfo
.hProcess
)
463 /* Reap the process */
465 /* Process should have already died before we are called. */
466 if (WaitForSingleObject (cp
->procinfo
.hProcess
, 0) != WAIT_OBJECT_0
)
467 DebPrint (("reap_subprocess: child fpr fd %d has not died yet!", cp
->fd
));
469 CloseHandle (cp
->procinfo
.hProcess
);
470 cp
->procinfo
.hProcess
= NULL
;
471 CloseHandle (cp
->procinfo
.hThread
);
472 cp
->procinfo
.hThread
= NULL
;
475 /* For asynchronous children, the child_proc resources will be freed
476 when the last pipe read descriptor is closed; for synchronous
477 children, we must explicitly free the resources now because
478 register_child has not been called. */
483 /* Wait for any of our existing child processes to die
484 When it does, close its handle
485 Return the pid and fill in the status if non-NULL. */
488 sys_wait (int *status
)
490 DWORD active
, retval
;
493 child_process
*cp
, *cps
[MAX_CHILDREN
];
494 HANDLE wait_hnd
[MAX_CHILDREN
];
497 if (dead_child
!= NULL
)
499 /* We want to wait for a specific child */
500 wait_hnd
[nh
] = dead_child
->procinfo
.hProcess
;
501 cps
[nh
] = dead_child
;
502 if (!wait_hnd
[nh
]) emacs_abort ();
509 for (cp
= child_procs
+ (child_proc_count
-1); cp
>= child_procs
; cp
--)
510 /* some child_procs might be sockets; ignore them */
511 if (CHILD_ACTIVE (cp
) && cp
->procinfo
.hProcess
512 && (cp
->fd
< 0 || (fd_info
[cp
->fd
].flags
& FILE_AT_EOF
) != 0))
514 wait_hnd
[nh
] = cp
->procinfo
.hProcess
;
522 /* Nothing to wait on, so fail */
529 /* Check for quit about once a second. */
531 active
= WaitForMultipleObjects (nh
, wait_hnd
, FALSE
, 1000);
532 } while (active
== WAIT_TIMEOUT
);
534 if (active
== WAIT_FAILED
)
539 else if (active
>= WAIT_OBJECT_0
540 && active
< WAIT_OBJECT_0
+MAXIMUM_WAIT_OBJECTS
)
542 active
-= WAIT_OBJECT_0
;
544 else if (active
>= WAIT_ABANDONED_0
545 && active
< WAIT_ABANDONED_0
+MAXIMUM_WAIT_OBJECTS
)
547 active
-= WAIT_ABANDONED_0
;
553 if (!GetExitCodeProcess (wait_hnd
[active
], &retval
))
555 DebPrint (("Wait.GetExitCodeProcess failed with %lu\n",
559 if (retval
== STILL_ACTIVE
)
561 /* Should never happen */
562 DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
567 /* Massage the exit code from the process to match the format expected
568 by the WIFSTOPPED et al macros in syswait.h. Only WIFSIGNALED and
569 WIFEXITED are supported; WIFSTOPPED doesn't make sense under NT. */
571 if (retval
== STATUS_CONTROL_C_EXIT
)
579 DebPrint (("Wait signaled with process pid %d\n", cp
->pid
));
586 else if (synch_process_alive
)
588 synch_process_alive
= 0;
590 /* Report the status of the synchronous process. */
591 if (WIFEXITED (retval
))
592 synch_process_retcode
= WEXITSTATUS (retval
);
593 else if (WIFSIGNALED (retval
))
595 int code
= WTERMSIG (retval
);
598 synchronize_system_messages_locale ();
599 signame
= strsignal (code
);
604 synch_process_death
= signame
;
607 reap_subprocess (cp
);
610 reap_subprocess (cp
);
615 /* Old versions of w32api headers don't have separate 32-bit and
616 64-bit defines, but the one they have matches the 32-bit variety. */
617 #ifndef IMAGE_NT_OPTIONAL_HDR32_MAGIC
618 # define IMAGE_NT_OPTIONAL_HDR32_MAGIC IMAGE_NT_OPTIONAL_HDR_MAGIC
619 # define IMAGE_OPTIONAL_HEADER32 IMAGE_OPTIONAL_HEADER
623 w32_executable_type (char * filename
,
628 file_data executable
;
631 /* Default values in case we can't tell for sure. */
633 *is_cygnus_app
= FALSE
;
636 if (!open_input_file (&executable
, filename
))
639 p
= strrchr (filename
, '.');
641 /* We can only identify DOS .com programs from the extension. */
642 if (p
&& xstrcasecmp (p
, ".com") == 0)
644 else if (p
&& (xstrcasecmp (p
, ".bat") == 0
645 || xstrcasecmp (p
, ".cmd") == 0))
647 /* A DOS shell script - it appears that CreateProcess is happy to
648 accept this (somewhat surprisingly); presumably it looks at
649 COMSPEC to determine what executable to actually invoke.
650 Therefore, we have to do the same here as well. */
651 /* Actually, I think it uses the program association for that
652 extension, which is defined in the registry. */
653 p
= egetenv ("COMSPEC");
655 w32_executable_type (p
, is_dos_app
, is_cygnus_app
, is_gui_app
);
659 /* Look for DOS .exe signature - if found, we must also check that
660 it isn't really a 16- or 32-bit Windows exe, since both formats
661 start with a DOS program stub. Note that 16-bit Windows
662 executables use the OS/2 1.x format. */
664 IMAGE_DOS_HEADER
* dos_header
;
665 IMAGE_NT_HEADERS
* nt_header
;
667 dos_header
= (PIMAGE_DOS_HEADER
) executable
.file_base
;
668 if (dos_header
->e_magic
!= IMAGE_DOS_SIGNATURE
)
671 nt_header
= (PIMAGE_NT_HEADERS
) ((char *) dos_header
+ dos_header
->e_lfanew
);
673 if ((char *) nt_header
> (char *) dos_header
+ executable
.size
)
675 /* Some dos headers (pkunzip) have bogus e_lfanew fields. */
678 else if (nt_header
->Signature
!= IMAGE_NT_SIGNATURE
679 && LOWORD (nt_header
->Signature
) != IMAGE_OS2_SIGNATURE
)
683 else if (nt_header
->Signature
== IMAGE_NT_SIGNATURE
)
685 IMAGE_DATA_DIRECTORY
*data_dir
= NULL
;
686 if (nt_header
->OptionalHeader
.Magic
== IMAGE_NT_OPTIONAL_HDR32_MAGIC
)
688 /* Ensure we are using the 32 bit structure. */
689 IMAGE_OPTIONAL_HEADER32
*opt
690 = (IMAGE_OPTIONAL_HEADER32
*) &(nt_header
->OptionalHeader
);
691 data_dir
= opt
->DataDirectory
;
692 *is_gui_app
= (opt
->Subsystem
== IMAGE_SUBSYSTEM_WINDOWS_GUI
);
694 /* MingW 3.12 has the required 64 bit structs, but in case older
695 versions don't, only check 64 bit exes if we know how. */
696 #ifdef IMAGE_NT_OPTIONAL_HDR64_MAGIC
697 else if (nt_header
->OptionalHeader
.Magic
698 == IMAGE_NT_OPTIONAL_HDR64_MAGIC
)
700 IMAGE_OPTIONAL_HEADER64
*opt
701 = (IMAGE_OPTIONAL_HEADER64
*) &(nt_header
->OptionalHeader
);
702 data_dir
= opt
->DataDirectory
;
703 *is_gui_app
= (opt
->Subsystem
== IMAGE_SUBSYSTEM_WINDOWS_GUI
);
708 /* Look for cygwin.dll in DLL import list. */
709 IMAGE_DATA_DIRECTORY import_dir
=
710 data_dir
[IMAGE_DIRECTORY_ENTRY_IMPORT
];
711 IMAGE_IMPORT_DESCRIPTOR
* imports
;
712 IMAGE_SECTION_HEADER
* section
;
714 section
= rva_to_section (import_dir
.VirtualAddress
, nt_header
);
715 imports
= RVA_TO_PTR (import_dir
.VirtualAddress
, section
,
718 for ( ; imports
->Name
; imports
++)
720 char * dllname
= RVA_TO_PTR (imports
->Name
, section
,
723 /* The exact name of the cygwin dll has changed with
724 various releases, but hopefully this will be reasonably
726 if (strncmp (dllname
, "cygwin", 6) == 0)
728 *is_cygnus_app
= TRUE
;
737 close_file_data (&executable
);
741 compare_env (const void *strp1
, const void *strp2
)
743 const char *str1
= *(const char **)strp1
, *str2
= *(const char **)strp2
;
745 while (*str1
&& *str2
&& *str1
!= '=' && *str2
!= '=')
747 /* Sort order in command.com/cmd.exe is based on uppercasing
748 names, so do the same here. */
749 if (toupper (*str1
) > toupper (*str2
))
751 else if (toupper (*str1
) < toupper (*str2
))
756 if (*str1
== '=' && *str2
== '=')
758 else if (*str1
== '=')
765 merge_and_sort_env (char **envp1
, char **envp2
, char **new_envp
)
781 qsort (new_envp
, num
, sizeof (char *), compare_env
);
786 /* When a new child process is created we need to register it in our list,
787 so intercept spawn requests. */
789 sys_spawnve (int mode
, char *cmdname
, char **argv
, char **envp
)
791 Lisp_Object program
, full
;
792 char *cmdline
, *env
, *parg
, **targ
;
796 int is_dos_app
, is_cygnus_app
, is_gui_app
;
799 /* We pass our process ID to our children by setting up an environment
800 variable in their environment. */
801 char ppid_env_var_buffer
[64];
802 char *extra_env
[] = {ppid_env_var_buffer
, NULL
};
803 /* These are the characters that cause an argument to need quoting.
804 Arguments with whitespace characters need quoting to prevent the
805 argument being split into two or more. Arguments with wildcards
806 are also quoted, for consistency with posix platforms, where wildcards
807 are not expanded if we run the program directly without a shell.
808 Some extra whitespace characters need quoting in Cygwin programs,
809 so this list is conditionally modified below. */
810 char *sepchars
= " \t*?";
812 /* We don't care about the other modes */
813 if (mode
!= _P_NOWAIT
)
819 /* Handle executable names without an executable suffix. */
820 program
= build_string (cmdname
);
821 if (NILP (Ffile_executable_p (program
)))
827 openp (Vexec_path
, program
, Vexec_suffixes
, &full
, make_number (X_OK
));
837 /* make sure argv[0] and cmdname are both in DOS format */
838 cmdname
= SDATA (program
);
839 unixtodos_filename (cmdname
);
842 /* Determine whether program is a 16-bit DOS executable, or a 32-bit Windows
843 executable that is implicitly linked to the Cygnus dll (implying it
844 was compiled with the Cygnus GNU toolchain and hence relies on
845 cygwin.dll to parse the command line - we use this to decide how to
846 escape quote chars in command line args that must be quoted).
848 Also determine whether it is a GUI app, so that we don't hide its
849 initial window unless specifically requested. */
850 w32_executable_type (cmdname
, &is_dos_app
, &is_cygnus_app
, &is_gui_app
);
852 /* On Windows 95, if cmdname is a DOS app, we invoke a helper
853 application to start it by specifying the helper app as cmdname,
854 while leaving the real app name as argv[0]. */
857 cmdname
= alloca (MAXPATHLEN
);
858 if (egetenv ("CMDPROXY"))
859 strcpy (cmdname
, egetenv ("CMDPROXY"));
862 strcpy (cmdname
, SDATA (Vinvocation_directory
));
863 strcat (cmdname
, "cmdproxy.exe");
865 unixtodos_filename (cmdname
);
868 /* we have to do some conjuring here to put argv and envp into the
869 form CreateProcess wants... argv needs to be a space separated/null
870 terminated list of parameters, and envp is a null
871 separated/double-null terminated list of parameters.
873 Additionally, zero-length args and args containing whitespace or
874 quote chars need to be wrapped in double quotes - for this to work,
875 embedded quotes need to be escaped as well. The aim is to ensure
876 the child process reconstructs the argv array we start with
877 exactly, so we treat quotes at the beginning and end of arguments
880 The w32 GNU-based library from Cygnus doubles quotes to escape
881 them, while MSVC uses backslash for escaping. (Actually the MSVC
882 startup code does attempt to recognize doubled quotes and accept
883 them, but gets it wrong and ends up requiring three quotes to get a
884 single embedded quote!) So by default we decide whether to use
885 quote or backslash as the escape character based on whether the
886 binary is apparently a Cygnus compiled app.
888 Note that using backslash to escape embedded quotes requires
889 additional special handling if an embedded quote is already
890 preceded by backslash, or if an arg requiring quoting ends with
891 backslash. In such cases, the run of escape characters needs to be
892 doubled. For consistency, we apply this special handling as long
893 as the escape character is not quote.
895 Since we have no idea how large argv and envp are likely to be we
896 figure out list lengths on the fly and allocate them. */
898 if (!NILP (Vw32_quote_process_args
))
901 /* Override escape char by binding w32-quote-process-args to
902 desired character, or use t for auto-selection. */
903 if (INTEGERP (Vw32_quote_process_args
))
904 escape_char
= XINT (Vw32_quote_process_args
);
906 escape_char
= is_cygnus_app
? '"' : '\\';
909 /* Cygwin apps needs quoting a bit more often. */
910 if (escape_char
== '"')
911 sepchars
= "\r\n\t\f '";
920 int escape_char_run
= 0;
926 if (escape_char
== '"' && *p
== '\\')
927 /* If it's a Cygwin app, \ needs to be escaped. */
931 /* allow for embedded quotes to be escaped */
934 /* handle the case where the embedded quote is already escaped */
935 if (escape_char_run
> 0)
937 /* To preserve the arg exactly, we need to double the
938 preceding escape characters (plus adding one to
939 escape the quote character itself). */
940 arglen
+= escape_char_run
;
943 else if (strchr (sepchars
, *p
) != NULL
)
948 if (*p
== escape_char
&& escape_char
!= '"')
956 /* handle the case where the arg ends with an escape char - we
957 must not let the enclosing quote be escaped. */
958 if (escape_char_run
> 0)
959 arglen
+= escape_char_run
;
961 arglen
+= strlen (*targ
++) + 1;
963 cmdline
= alloca (arglen
);
977 if ((strchr (sepchars
, *p
) != NULL
) || *p
== '"')
982 int escape_char_run
= 0;
988 last
= p
+ strlen (p
) - 1;
991 /* This version does not escape quotes if they occur at the
992 beginning or end of the arg - this could lead to incorrect
993 behavior when the arg itself represents a command line
994 containing quoted args. I believe this was originally done
995 as a hack to make some things work, before
996 `w32-quote-process-args' was added. */
999 if (*p
== '"' && p
> first
&& p
< last
)
1000 *parg
++ = escape_char
; /* escape embedded quotes */
1008 /* double preceding escape chars if any */
1009 while (escape_char_run
> 0)
1011 *parg
++ = escape_char
;
1014 /* escape all quote chars, even at beginning or end */
1015 *parg
++ = escape_char
;
1017 else if (escape_char
== '"' && *p
== '\\')
1021 if (*p
== escape_char
&& escape_char
!= '"')
1024 escape_char_run
= 0;
1026 /* double escape chars before enclosing quote */
1027 while (escape_char_run
> 0)
1029 *parg
++ = escape_char
;
1037 strcpy (parg
, *targ
);
1038 parg
+= strlen (*targ
);
1048 numenv
= 1; /* for end null */
1051 arglen
+= strlen (*targ
++) + 1;
1054 /* extra env vars... */
1055 sprintf (ppid_env_var_buffer
, "EM_PARENT_PROCESS_ID=%d",
1056 GetCurrentProcessId ());
1057 arglen
+= strlen (ppid_env_var_buffer
) + 1;
1060 /* merge env passed in and extra env into one, and sort it. */
1061 targ
= (char **) alloca (numenv
* sizeof (char *));
1062 merge_and_sort_env (envp
, extra_env
, targ
);
1064 /* concatenate env entries. */
1065 env
= alloca (arglen
);
1069 strcpy (parg
, *targ
);
1070 parg
+= strlen (*targ
++);
1083 /* Now create the process. */
1084 if (!create_child (cmdname
, cmdline
, env
, is_gui_app
, &pid
, cp
))
1094 /* Emulate the select call
1095 Wait for available input on any of the given rfds, or timeout if
1096 a timeout is given and no input is detected
1097 wfds and efds are not supported and must be NULL.
1099 For simplicity, we detect the death of child processes here and
1100 synchronously call the SIGCHLD handler. Since it is possible for
1101 children to be created without a corresponding pipe handle from which
1102 to read output, we wait separately on the process handles as well as
1103 the char_avail events for each process pipe. We only call
1104 wait/reap_process when the process actually terminates.
1106 To reduce the number of places in which Emacs can be hung such that
1107 C-g is not able to interrupt it, we always wait on interrupt_handle
1108 (which is signaled by the input thread when C-g is detected). If we
1109 detect that we were woken up by C-g, we return -1 with errno set to
1110 EINTR as on Unix. */
1112 /* From w32console.c */
1113 extern HANDLE keyboard_handle
;
1115 /* From w32xfns.c */
1116 extern HANDLE interrupt_handle
;
1118 /* From process.c */
1119 extern int proc_buffered_char
[];
1122 sys_select (int nfds
, SELECT_TYPE
*rfds
, SELECT_TYPE
*wfds
, SELECT_TYPE
*efds
,
1123 EMACS_TIME
*timeout
, void *ignored
)
1126 DWORD timeout_ms
, start_time
;
1129 child_process
*cp
, *cps
[MAX_CHILDREN
];
1130 HANDLE wait_hnd
[MAXDESC
+ MAX_CHILDREN
];
1131 int fdindex
[MAXDESC
]; /* mapping from wait handles back to descriptors */
1134 timeout
? (timeout
->tv_sec
* 1000 + timeout
->tv_nsec
/ 1000000) : INFINITE
;
1136 /* If the descriptor sets are NULL but timeout isn't, then just Sleep. */
1137 if (rfds
== NULL
&& wfds
== NULL
&& efds
== NULL
&& timeout
!= NULL
)
1143 /* Otherwise, we only handle rfds, so fail otherwise. */
1144 if (rfds
== NULL
|| wfds
!= NULL
|| efds
!= NULL
)
1154 /* Always wait on interrupt_handle, to detect C-g (quit). */
1155 wait_hnd
[0] = interrupt_handle
;
1158 /* Build a list of pipe handles to wait on. */
1160 for (i
= 0; i
< nfds
; i
++)
1161 if (FD_ISSET (i
, &orfds
))
1165 if (keyboard_handle
)
1167 /* Handle stdin specially */
1168 wait_hnd
[nh
] = keyboard_handle
;
1173 /* Check for any emacs-generated input in the queue since
1174 it won't be detected in the wait */
1175 if (detect_input_pending ())
1183 /* Child process and socket input */
1187 int current_status
= cp
->status
;
1189 if (current_status
== STATUS_READ_ACKNOWLEDGED
)
1191 /* Tell reader thread which file handle to use. */
1193 /* Wake up the reader thread for this process */
1194 cp
->status
= STATUS_READ_READY
;
1195 if (!SetEvent (cp
->char_consumed
))
1196 DebPrint (("nt_select.SetEvent failed with "
1197 "%lu for fd %ld\n", GetLastError (), i
));
1200 #ifdef CHECK_INTERLOCK
1201 /* slightly crude cross-checking of interlock between threads */
1203 current_status
= cp
->status
;
1204 if (WaitForSingleObject (cp
->char_avail
, 0) == WAIT_OBJECT_0
)
1206 /* char_avail has been signaled, so status (which may
1207 have changed) should indicate read has completed
1208 but has not been acknowledged. */
1209 current_status
= cp
->status
;
1210 if (current_status
!= STATUS_READ_SUCCEEDED
1211 && current_status
!= STATUS_READ_FAILED
)
1212 DebPrint (("char_avail set, but read not completed: status %d\n",
1217 /* char_avail has not been signaled, so status should
1218 indicate that read is in progress; small possibility
1219 that read has completed but event wasn't yet signaled
1220 when we tested it (because a context switch occurred
1221 or if running on separate CPUs). */
1222 if (current_status
!= STATUS_READ_READY
1223 && current_status
!= STATUS_READ_IN_PROGRESS
1224 && current_status
!= STATUS_READ_SUCCEEDED
1225 && current_status
!= STATUS_READ_FAILED
)
1226 DebPrint (("char_avail reset, but read status is bad: %d\n",
1230 wait_hnd
[nh
] = cp
->char_avail
;
1232 if (!wait_hnd
[nh
]) emacs_abort ();
1235 DebPrint (("select waiting on child %d fd %d\n",
1236 cp
-child_procs
, i
));
1241 /* Unable to find something to wait on for this fd, skip */
1243 /* Note that this is not a fatal error, and can in fact
1244 happen in unusual circumstances. Specifically, if
1245 sys_spawnve fails, eg. because the program doesn't
1246 exist, and debug-on-error is t so Fsignal invokes a
1247 nested input loop, then the process output pipe is
1248 still included in input_wait_mask with no child_proc
1249 associated with it. (It is removed when the debugger
1250 exits the nested input loop and the error is thrown.) */
1252 DebPrint (("sys_select: fd %ld is invalid! ignoring\n", i
));
1258 /* Add handles of child processes. */
1260 for (cp
= child_procs
+ (child_proc_count
-1); cp
>= child_procs
; cp
--)
1261 /* Some child_procs might be sockets; ignore them. Also some
1262 children may have died already, but we haven't finished reading
1263 the process output; ignore them too. */
1264 if (CHILD_ACTIVE (cp
) && cp
->procinfo
.hProcess
1266 || (fd_info
[cp
->fd
].flags
& FILE_SEND_SIGCHLD
) == 0
1267 || (fd_info
[cp
->fd
].flags
& FILE_AT_EOF
) != 0)
1270 wait_hnd
[nh
+ nc
] = cp
->procinfo
.hProcess
;
1275 /* Nothing to look for, so we didn't find anything */
1283 start_time
= GetTickCount ();
1285 /* Wait for input or child death to be signaled. If user input is
1286 allowed, then also accept window messages. */
1287 if (FD_ISSET (0, &orfds
))
1288 active
= MsgWaitForMultipleObjects (nh
+ nc
, wait_hnd
, FALSE
, timeout_ms
,
1291 active
= WaitForMultipleObjects (nh
+ nc
, wait_hnd
, FALSE
, timeout_ms
);
1293 if (active
== WAIT_FAILED
)
1295 DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n",
1296 nh
+ nc
, timeout_ms
, GetLastError ()));
1297 /* don't return EBADF - this causes wait_reading_process_output to
1298 abort; WAIT_FAILED is returned when single-stepping under
1299 Windows 95 after switching thread focus in debugger, and
1300 possibly at other times. */
1304 else if (active
== WAIT_TIMEOUT
)
1308 else if (active
>= WAIT_OBJECT_0
1309 && active
< WAIT_OBJECT_0
+MAXIMUM_WAIT_OBJECTS
)
1311 active
-= WAIT_OBJECT_0
;
1313 else if (active
>= WAIT_ABANDONED_0
1314 && active
< WAIT_ABANDONED_0
+MAXIMUM_WAIT_OBJECTS
)
1316 active
-= WAIT_ABANDONED_0
;
1321 /* Loop over all handles after active (now officially documented as
1322 being the first signaled handle in the array). We do this to
1323 ensure fairness, so that all channels with data available will be
1324 processed - otherwise higher numbered channels could be starved. */
1327 if (active
== nh
+ nc
)
1329 /* There are messages in the lisp thread's queue; we must
1330 drain the queue now to ensure they are processed promptly,
1331 because if we don't do so, we will not be woken again until
1332 further messages arrive.
1334 NB. If ever we allow window message procedures to callback
1335 into lisp, we will need to ensure messages are dispatched
1336 at a safe time for lisp code to be run (*), and we may also
1337 want to provide some hooks in the dispatch loop to cater
1338 for modeless dialogs created by lisp (ie. to register
1339 window handles to pass to IsDialogMessage).
1341 (*) Note that MsgWaitForMultipleObjects above is an
1342 internal dispatch point for messages that are sent to
1343 windows created by this thread. */
1344 drain_message_queue ();
1346 else if (active
>= nh
)
1348 cp
= cps
[active
- nh
];
1350 /* We cannot always signal SIGCHLD immediately; if we have not
1351 finished reading the process output, we must delay sending
1352 SIGCHLD until we do. */
1354 if (cp
->fd
>= 0 && (fd_info
[cp
->fd
].flags
& FILE_AT_EOF
) == 0)
1355 fd_info
[cp
->fd
].flags
|= FILE_SEND_SIGCHLD
;
1356 /* SIG_DFL for SIGCHLD is ignore */
1357 else if (sig_handlers
[SIGCHLD
] != SIG_DFL
&&
1358 sig_handlers
[SIGCHLD
] != SIG_IGN
)
1361 DebPrint (("select calling SIGCHLD handler for pid %d\n",
1365 sig_handlers
[SIGCHLD
] (SIGCHLD
);
1369 else if (fdindex
[active
] == -1)
1371 /* Quit (C-g) was detected. */
1375 else if (fdindex
[active
] == 0)
1377 /* Keyboard input available */
1383 /* must be a socket or pipe - read ahead should have
1384 completed, either succeeding or failing. */
1385 FD_SET (fdindex
[active
], rfds
);
1389 /* Even though wait_reading_process_output only reads from at most
1390 one channel, we must process all channels here so that we reap
1391 all children that have died. */
1392 while (++active
< nh
+ nc
)
1393 if (WaitForSingleObject (wait_hnd
[active
], 0) == WAIT_OBJECT_0
)
1395 } while (active
< nh
+ nc
);
1397 /* If no input has arrived and timeout hasn't expired, wait again. */
1400 DWORD elapsed
= GetTickCount () - start_time
;
1402 if (timeout_ms
> elapsed
) /* INFINITE is MAX_UINT */
1404 if (timeout_ms
!= INFINITE
)
1405 timeout_ms
-= elapsed
;
1406 goto count_children
;
1413 /* Substitute for certain kill () operations */
1415 static BOOL CALLBACK
1416 find_child_console (HWND hwnd
, LPARAM arg
)
1418 child_process
* cp
= (child_process
*) arg
;
1422 thread_id
= GetWindowThreadProcessId (hwnd
, &process_id
);
1423 if (process_id
== cp
->procinfo
.dwProcessId
)
1425 char window_class
[32];
1427 GetClassName (hwnd
, window_class
, sizeof (window_class
));
1428 if (strcmp (window_class
,
1429 (os_subtype
== OS_9X
)
1431 : "ConsoleWindowClass") == 0)
1441 /* Emulate 'kill', but only for other processes. */
1443 sys_kill (int pid
, int sig
)
1447 int need_to_free
= 0;
1450 /* Only handle signals that will result in the process dying */
1451 if (sig
!= SIGINT
&& sig
!= SIGKILL
&& sig
!= SIGQUIT
&& sig
!= SIGHUP
)
1457 cp
= find_child_pid (pid
);
1460 /* We were passed a PID of something other than our subprocess.
1461 If that is our own PID, we will send to ourself a message to
1462 close the selected frame, which does not necessarily
1463 terminates Emacs. But then we are not supposed to call
1464 sys_kill with our own PID. */
1465 proc_hand
= OpenProcess (PROCESS_TERMINATE
, 0, pid
);
1466 if (proc_hand
== NULL
)
1475 proc_hand
= cp
->procinfo
.hProcess
;
1476 pid
= cp
->procinfo
.dwProcessId
;
1478 /* Try to locate console window for process. */
1479 EnumWindows (find_child_console
, (LPARAM
) cp
);
1482 if (sig
== SIGINT
|| sig
== SIGQUIT
)
1484 if (NILP (Vw32_start_process_share_console
) && cp
&& cp
->hwnd
)
1486 BYTE control_scan_code
= (BYTE
) MapVirtualKey (VK_CONTROL
, 0);
1487 /* Fake Ctrl-C for SIGINT, and Ctrl-Break for SIGQUIT. */
1488 BYTE vk_break_code
= (sig
== SIGINT
) ? 'C' : VK_CANCEL
;
1489 BYTE break_scan_code
= (BYTE
) MapVirtualKey (vk_break_code
, 0);
1490 HWND foreground_window
;
1492 if (break_scan_code
== 0)
1494 /* Fake Ctrl-C for SIGQUIT if we can't manage Ctrl-Break. */
1495 vk_break_code
= 'C';
1496 break_scan_code
= (BYTE
) MapVirtualKey (vk_break_code
, 0);
1499 foreground_window
= GetForegroundWindow ();
1500 if (foreground_window
)
1502 /* NT 5.0, and apparently also Windows 98, will not allow
1503 a Window to be set to foreground directly without the
1504 user's involvement. The workaround is to attach
1505 ourselves to the thread that owns the foreground
1506 window, since that is the only thread that can set the
1507 foreground window. */
1508 DWORD foreground_thread
, child_thread
;
1510 GetWindowThreadProcessId (foreground_window
, NULL
);
1511 if (foreground_thread
== GetCurrentThreadId ()
1512 || !AttachThreadInput (GetCurrentThreadId (),
1513 foreground_thread
, TRUE
))
1514 foreground_thread
= 0;
1516 child_thread
= GetWindowThreadProcessId (cp
->hwnd
, NULL
);
1517 if (child_thread
== GetCurrentThreadId ()
1518 || !AttachThreadInput (GetCurrentThreadId (),
1519 child_thread
, TRUE
))
1522 /* Set the foreground window to the child. */
1523 if (SetForegroundWindow (cp
->hwnd
))
1525 /* Generate keystrokes as if user had typed Ctrl-Break or
1527 keybd_event (VK_CONTROL
, control_scan_code
, 0, 0);
1528 keybd_event (vk_break_code
, break_scan_code
,
1529 (vk_break_code
== 'C' ? 0 : KEYEVENTF_EXTENDEDKEY
), 0);
1530 keybd_event (vk_break_code
, break_scan_code
,
1531 (vk_break_code
== 'C' ? 0 : KEYEVENTF_EXTENDEDKEY
)
1532 | KEYEVENTF_KEYUP
, 0);
1533 keybd_event (VK_CONTROL
, control_scan_code
,
1534 KEYEVENTF_KEYUP
, 0);
1536 /* Sleep for a bit to give time for Emacs frame to respond
1537 to focus change events (if Emacs was active app). */
1540 SetForegroundWindow (foreground_window
);
1542 /* Detach from the foreground and child threads now that
1543 the foreground switching is over. */
1544 if (foreground_thread
)
1545 AttachThreadInput (GetCurrentThreadId (),
1546 foreground_thread
, FALSE
);
1548 AttachThreadInput (GetCurrentThreadId (),
1549 child_thread
, FALSE
);
1552 /* Ctrl-Break is NT equivalent of SIGINT. */
1553 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT
, pid
))
1555 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
1556 "for pid %lu\n", GetLastError (), pid
));
1563 if (NILP (Vw32_start_process_share_console
) && cp
&& cp
->hwnd
)
1566 if (os_subtype
== OS_9X
)
1569 Another possibility is to try terminating the VDM out-right by
1570 calling the Shell VxD (id 0x17) V86 interface, function #4
1571 "SHELL_Destroy_VM", ie.
1577 First need to determine the current VM handle, and then arrange for
1578 the shellapi call to be made from the system vm (by using
1579 Switch_VM_and_callback).
1581 Could try to invoke DestroyVM through CallVxD.
1585 /* On Windows 95, posting WM_QUIT causes the 16-bit subsystem
1586 to hang when cmdproxy is used in conjunction with
1587 command.com for an interactive shell. Posting
1588 WM_CLOSE pops up a dialog that, when Yes is selected,
1589 does the same thing. TerminateProcess is also less
1590 than ideal in that subprocesses tend to stick around
1591 until the machine is shutdown, but at least it
1592 doesn't freeze the 16-bit subsystem. */
1593 PostMessage (cp
->hwnd
, WM_QUIT
, 0xff, 0);
1595 if (!TerminateProcess (proc_hand
, 0xff))
1597 DebPrint (("sys_kill.TerminateProcess returned %d "
1598 "for pid %lu\n", GetLastError (), pid
));
1605 PostMessage (cp
->hwnd
, WM_CLOSE
, 0, 0);
1607 /* Kill the process. On W32 this doesn't kill child processes
1608 so it doesn't work very well for shells which is why it's not
1609 used in every case. */
1610 else if (!TerminateProcess (proc_hand
, 0xff))
1612 DebPrint (("sys_kill.TerminateProcess returned %d "
1613 "for pid %lu\n", GetLastError (), pid
));
1620 CloseHandle (proc_hand
);
1625 /* The following two routines are used to manipulate stdin, stdout, and
1626 stderr of our child processes.
1628 Assuming that in, out, and err are *not* inheritable, we make them
1629 stdin, stdout, and stderr of the child as follows:
1631 - Save the parent's current standard handles.
1632 - Set the std handles to inheritable duplicates of the ones being passed in.
1633 (Note that _get_osfhandle() is an io.h procedure that retrieves the
1634 NT file handle for a crt file descriptor.)
1635 - Spawn the child, which inherits in, out, and err as stdin,
1636 stdout, and stderr. (see Spawnve)
1637 - Close the std handles passed to the child.
1638 - Reset the parent's standard handles to the saved handles.
1639 (see reset_standard_handles)
1640 We assume that the caller closes in, out, and err after calling us. */
1643 prepare_standard_handles (int in
, int out
, int err
, HANDLE handles
[3])
1646 HANDLE newstdin
, newstdout
, newstderr
;
1648 parent
= GetCurrentProcess ();
1650 handles
[0] = GetStdHandle (STD_INPUT_HANDLE
);
1651 handles
[1] = GetStdHandle (STD_OUTPUT_HANDLE
);
1652 handles
[2] = GetStdHandle (STD_ERROR_HANDLE
);
1654 /* make inheritable copies of the new handles */
1655 if (!DuplicateHandle (parent
,
1656 (HANDLE
) _get_osfhandle (in
),
1661 DUPLICATE_SAME_ACCESS
))
1662 report_file_error ("Duplicating input handle for child", Qnil
);
1664 if (!DuplicateHandle (parent
,
1665 (HANDLE
) _get_osfhandle (out
),
1670 DUPLICATE_SAME_ACCESS
))
1671 report_file_error ("Duplicating output handle for child", Qnil
);
1673 if (!DuplicateHandle (parent
,
1674 (HANDLE
) _get_osfhandle (err
),
1679 DUPLICATE_SAME_ACCESS
))
1680 report_file_error ("Duplicating error handle for child", Qnil
);
1682 /* and store them as our std handles */
1683 if (!SetStdHandle (STD_INPUT_HANDLE
, newstdin
))
1684 report_file_error ("Changing stdin handle", Qnil
);
1686 if (!SetStdHandle (STD_OUTPUT_HANDLE
, newstdout
))
1687 report_file_error ("Changing stdout handle", Qnil
);
1689 if (!SetStdHandle (STD_ERROR_HANDLE
, newstderr
))
1690 report_file_error ("Changing stderr handle", Qnil
);
1694 reset_standard_handles (int in
, int out
, int err
, HANDLE handles
[3])
1696 /* close the duplicated handles passed to the child */
1697 CloseHandle (GetStdHandle (STD_INPUT_HANDLE
));
1698 CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE
));
1699 CloseHandle (GetStdHandle (STD_ERROR_HANDLE
));
1701 /* now restore parent's saved std handles */
1702 SetStdHandle (STD_INPUT_HANDLE
, handles
[0]);
1703 SetStdHandle (STD_OUTPUT_HANDLE
, handles
[1]);
1704 SetStdHandle (STD_ERROR_HANDLE
, handles
[2]);
1708 set_process_dir (char * dir
)
1713 /* To avoid problems with winsock implementations that work over dial-up
1714 connections causing or requiring a connection to exist while Emacs is
1715 running, Emacs no longer automatically loads winsock on startup if it
1716 is present. Instead, it will be loaded when open-network-stream is
1719 To allow full control over when winsock is loaded, we provide these
1720 two functions to dynamically load and unload winsock. This allows
1721 dial-up users to only be connected when they actually need to use
1725 extern HANDLE winsock_lib
;
1726 extern BOOL
term_winsock (void);
1727 extern BOOL
init_winsock (int load_now
);
1729 DEFUN ("w32-has-winsock", Fw32_has_winsock
, Sw32_has_winsock
, 0, 1, 0,
1730 doc
: /* Test for presence of the Windows socket library `winsock'.
1731 Returns non-nil if winsock support is present, nil otherwise.
1733 If the optional argument LOAD-NOW is non-nil, the winsock library is
1734 also loaded immediately if not already loaded. If winsock is loaded,
1735 the winsock local hostname is returned (since this may be different from
1736 the value of `system-name' and should supplant it), otherwise t is
1737 returned to indicate winsock support is present. */)
1738 (Lisp_Object load_now
)
1742 have_winsock
= init_winsock (!NILP (load_now
));
1745 if (winsock_lib
!= NULL
)
1747 /* Return new value for system-name. The best way to do this
1748 is to call init_system_name, saving and restoring the
1749 original value to avoid side-effects. */
1750 Lisp_Object orig_hostname
= Vsystem_name
;
1751 Lisp_Object hostname
;
1753 init_system_name ();
1754 hostname
= Vsystem_name
;
1755 Vsystem_name
= orig_hostname
;
1763 DEFUN ("w32-unload-winsock", Fw32_unload_winsock
, Sw32_unload_winsock
,
1765 doc
: /* Unload the Windows socket library `winsock' if loaded.
1766 This is provided to allow dial-up socket connections to be disconnected
1767 when no longer needed. Returns nil without unloading winsock if any
1768 socket connections still exist. */)
1771 return term_winsock () ? Qt
: Qnil
;
1775 /* Some miscellaneous functions that are Windows specific, but not GUI
1776 specific (ie. are applicable in terminal or batch mode as well). */
1778 DEFUN ("w32-short-file-name", Fw32_short_file_name
, Sw32_short_file_name
, 1, 1, 0,
1779 doc
: /* Return the short file name version (8.3) of the full path of FILENAME.
1780 If FILENAME does not exist, return nil.
1781 All path elements in FILENAME are converted to their short names. */)
1782 (Lisp_Object filename
)
1784 char shortname
[MAX_PATH
];
1786 CHECK_STRING (filename
);
1788 /* first expand it. */
1789 filename
= Fexpand_file_name (filename
, Qnil
);
1791 /* luckily, this returns the short version of each element in the path. */
1792 if (GetShortPathName (SDATA (ENCODE_FILE (filename
)), shortname
, MAX_PATH
) == 0)
1795 dostounix_filename (shortname
);
1797 return build_string (shortname
);
1801 DEFUN ("w32-long-file-name", Fw32_long_file_name
, Sw32_long_file_name
,
1803 doc
: /* Return the long file name version of the full path of FILENAME.
1804 If FILENAME does not exist, return nil.
1805 All path elements in FILENAME are converted to their long names. */)
1806 (Lisp_Object filename
)
1808 char longname
[ MAX_PATH
];
1811 CHECK_STRING (filename
);
1813 if (SBYTES (filename
) == 2
1814 && *(SDATA (filename
) + 1) == ':')
1817 /* first expand it. */
1818 filename
= Fexpand_file_name (filename
, Qnil
);
1820 if (!w32_get_long_filename (SDATA (ENCODE_FILE (filename
)), longname
, MAX_PATH
))
1823 dostounix_filename (longname
);
1825 /* If we were passed only a drive, make sure that a slash is not appended
1826 for consistency with directories. Allow for drive mapping via SUBST
1827 in case expand-file-name is ever changed to expand those. */
1828 if (drive_only
&& longname
[1] == ':' && longname
[2] == '/' && !longname
[3])
1831 return DECODE_FILE (build_string (longname
));
1834 DEFUN ("w32-set-process-priority", Fw32_set_process_priority
,
1835 Sw32_set_process_priority
, 2, 2, 0,
1836 doc
: /* Set the priority of PROCESS to PRIORITY.
1837 If PROCESS is nil, the priority of Emacs is changed, otherwise the
1838 priority of the process whose pid is PROCESS is changed.
1839 PRIORITY should be one of the symbols high, normal, or low;
1840 any other symbol will be interpreted as normal.
1842 If successful, the return value is t, otherwise nil. */)
1843 (Lisp_Object process
, Lisp_Object priority
)
1845 HANDLE proc_handle
= GetCurrentProcess ();
1846 DWORD priority_class
= NORMAL_PRIORITY_CLASS
;
1847 Lisp_Object result
= Qnil
;
1849 CHECK_SYMBOL (priority
);
1851 if (!NILP (process
))
1856 CHECK_NUMBER (process
);
1858 /* Allow pid to be an internally generated one, or one obtained
1859 externally. This is necessary because real pids on Windows 95 are
1862 pid
= XINT (process
);
1863 cp
= find_child_pid (pid
);
1865 pid
= cp
->procinfo
.dwProcessId
;
1867 proc_handle
= OpenProcess (PROCESS_SET_INFORMATION
, FALSE
, pid
);
1870 if (EQ (priority
, Qhigh
))
1871 priority_class
= HIGH_PRIORITY_CLASS
;
1872 else if (EQ (priority
, Qlow
))
1873 priority_class
= IDLE_PRIORITY_CLASS
;
1875 if (proc_handle
!= NULL
)
1877 if (SetPriorityClass (proc_handle
, priority_class
))
1879 if (!NILP (process
))
1880 CloseHandle (proc_handle
);
1886 #ifdef HAVE_LANGINFO_CODESET
1887 /* Emulation of nl_langinfo. Used in fns.c:Flocale_info. */
1889 nl_langinfo (nl_item item
)
1891 /* Conversion of Posix item numbers to their Windows equivalents. */
1892 static const LCTYPE w32item
[] = {
1893 LOCALE_IDEFAULTANSICODEPAGE
,
1894 LOCALE_SDAYNAME1
, LOCALE_SDAYNAME2
, LOCALE_SDAYNAME3
,
1895 LOCALE_SDAYNAME4
, LOCALE_SDAYNAME5
, LOCALE_SDAYNAME6
, LOCALE_SDAYNAME7
,
1896 LOCALE_SMONTHNAME1
, LOCALE_SMONTHNAME2
, LOCALE_SMONTHNAME3
,
1897 LOCALE_SMONTHNAME4
, LOCALE_SMONTHNAME5
, LOCALE_SMONTHNAME6
,
1898 LOCALE_SMONTHNAME7
, LOCALE_SMONTHNAME8
, LOCALE_SMONTHNAME9
,
1899 LOCALE_SMONTHNAME10
, LOCALE_SMONTHNAME11
, LOCALE_SMONTHNAME12
1902 static char *nl_langinfo_buf
= NULL
;
1903 static int nl_langinfo_len
= 0;
1905 if (nl_langinfo_len
<= 0)
1906 nl_langinfo_buf
= xmalloc (nl_langinfo_len
= 1);
1908 if (item
< 0 || item
>= _NL_NUM
)
1909 nl_langinfo_buf
[0] = 0;
1912 LCID cloc
= GetThreadLocale ();
1913 int need_len
= GetLocaleInfo (cloc
, w32item
[item
] | LOCALE_USE_CP_ACP
,
1917 nl_langinfo_buf
[0] = 0;
1920 if (item
== CODESET
)
1922 need_len
+= 2; /* for the "cp" prefix */
1923 if (need_len
< 8) /* for the case we call GetACP */
1926 if (nl_langinfo_len
<= need_len
)
1927 nl_langinfo_buf
= xrealloc (nl_langinfo_buf
,
1928 nl_langinfo_len
= need_len
);
1929 if (!GetLocaleInfo (cloc
, w32item
[item
] | LOCALE_USE_CP_ACP
,
1930 nl_langinfo_buf
, nl_langinfo_len
))
1931 nl_langinfo_buf
[0] = 0;
1932 else if (item
== CODESET
)
1934 if (strcmp (nl_langinfo_buf
, "0") == 0 /* CP_ACP */
1935 || strcmp (nl_langinfo_buf
, "1") == 0) /* CP_OEMCP */
1936 sprintf (nl_langinfo_buf
, "cp%u", GetACP ());
1939 memmove (nl_langinfo_buf
+ 2, nl_langinfo_buf
,
1940 strlen (nl_langinfo_buf
) + 1);
1941 nl_langinfo_buf
[0] = 'c';
1942 nl_langinfo_buf
[1] = 'p';
1947 return nl_langinfo_buf
;
1949 #endif /* HAVE_LANGINFO_CODESET */
1951 DEFUN ("w32-get-locale-info", Fw32_get_locale_info
,
1952 Sw32_get_locale_info
, 1, 2, 0,
1953 doc
: /* Return information about the Windows locale LCID.
1954 By default, return a three letter locale code which encodes the default
1955 language as the first two characters, and the country or regional variant
1956 as the third letter. For example, ENU refers to `English (United States)',
1957 while ENC means `English (Canadian)'.
1959 If the optional argument LONGFORM is t, the long form of the locale
1960 name is returned, e.g. `English (United States)' instead; if LONGFORM
1961 is a number, it is interpreted as an LCTYPE constant and the corresponding
1962 locale information is returned.
1964 If LCID (a 16-bit number) is not a valid locale, the result is nil. */)
1965 (Lisp_Object lcid
, Lisp_Object longform
)
1969 char abbrev_name
[32] = { 0 };
1970 char full_name
[256] = { 0 };
1972 CHECK_NUMBER (lcid
);
1974 if (!IsValidLocale (XINT (lcid
), LCID_SUPPORTED
))
1977 if (NILP (longform
))
1979 got_abbrev
= GetLocaleInfo (XINT (lcid
),
1980 LOCALE_SABBREVLANGNAME
| LOCALE_USE_CP_ACP
,
1981 abbrev_name
, sizeof (abbrev_name
));
1983 return build_string (abbrev_name
);
1985 else if (EQ (longform
, Qt
))
1987 got_full
= GetLocaleInfo (XINT (lcid
),
1988 LOCALE_SLANGUAGE
| LOCALE_USE_CP_ACP
,
1989 full_name
, sizeof (full_name
));
1991 return DECODE_SYSTEM (build_string (full_name
));
1993 else if (NUMBERP (longform
))
1995 got_full
= GetLocaleInfo (XINT (lcid
),
1997 full_name
, sizeof (full_name
));
1998 /* GetLocaleInfo's return value includes the terminating null
1999 character, when the returned information is a string, whereas
2000 make_unibyte_string needs the string length without the
2001 terminating null. */
2003 return make_unibyte_string (full_name
, got_full
- 1);
2010 DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id
,
2011 Sw32_get_current_locale_id
, 0, 0, 0,
2012 doc
: /* Return Windows locale id for current locale setting.
2013 This is a numerical value; use `w32-get-locale-info' to convert to a
2014 human-readable form. */)
2017 return make_number (GetThreadLocale ());
2021 int_from_hex (char * s
)
2024 static char hex
[] = "0123456789abcdefABCDEF";
2027 while (*s
&& (p
= strchr (hex
, *s
)) != NULL
)
2029 unsigned digit
= p
- hex
;
2032 val
= val
* 16 + digit
;
2038 /* We need to build a global list, since the EnumSystemLocale callback
2039 function isn't given a context pointer. */
2040 Lisp_Object Vw32_valid_locale_ids
;
2042 static BOOL CALLBACK
2043 enum_locale_fn (LPTSTR localeNum
)
2045 DWORD id
= int_from_hex (localeNum
);
2046 Vw32_valid_locale_ids
= Fcons (make_number (id
), Vw32_valid_locale_ids
);
2050 DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids
,
2051 Sw32_get_valid_locale_ids
, 0, 0, 0,
2052 doc
: /* Return list of all valid Windows locale ids.
2053 Each id is a numerical value; use `w32-get-locale-info' to convert to a
2054 human-readable form. */)
2057 Vw32_valid_locale_ids
= Qnil
;
2059 EnumSystemLocales (enum_locale_fn
, LCID_SUPPORTED
);
2061 Vw32_valid_locale_ids
= Fnreverse (Vw32_valid_locale_ids
);
2062 return Vw32_valid_locale_ids
;
2066 DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id
, Sw32_get_default_locale_id
, 0, 1, 0,
2067 doc
: /* Return Windows locale id for default locale setting.
2068 By default, the system default locale setting is returned; if the optional
2069 parameter USERP is non-nil, the user default locale setting is returned.
2070 This is a numerical value; use `w32-get-locale-info' to convert to a
2071 human-readable form. */)
2075 return make_number (GetSystemDefaultLCID ());
2076 return make_number (GetUserDefaultLCID ());
2080 DEFUN ("w32-set-current-locale", Fw32_set_current_locale
, Sw32_set_current_locale
, 1, 1, 0,
2081 doc
: /* Make Windows locale LCID be the current locale setting for Emacs.
2082 If successful, the new locale id is returned, otherwise nil. */)
2085 CHECK_NUMBER (lcid
);
2087 if (!IsValidLocale (XINT (lcid
), LCID_SUPPORTED
))
2090 if (!SetThreadLocale (XINT (lcid
)))
2093 /* Need to set input thread locale if present. */
2094 if (dwWindowsThreadId
)
2095 /* Reply is not needed. */
2096 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_SETLOCALE
, XINT (lcid
), 0);
2098 return make_number (GetThreadLocale ());
2102 /* We need to build a global list, since the EnumCodePages callback
2103 function isn't given a context pointer. */
2104 Lisp_Object Vw32_valid_codepages
;
2106 static BOOL CALLBACK
2107 enum_codepage_fn (LPTSTR codepageNum
)
2109 DWORD id
= atoi (codepageNum
);
2110 Vw32_valid_codepages
= Fcons (make_number (id
), Vw32_valid_codepages
);
2114 DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages
,
2115 Sw32_get_valid_codepages
, 0, 0, 0,
2116 doc
: /* Return list of all valid Windows codepages. */)
2119 Vw32_valid_codepages
= Qnil
;
2121 EnumSystemCodePages (enum_codepage_fn
, CP_SUPPORTED
);
2123 Vw32_valid_codepages
= Fnreverse (Vw32_valid_codepages
);
2124 return Vw32_valid_codepages
;
2128 DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage
,
2129 Sw32_get_console_codepage
, 0, 0, 0,
2130 doc
: /* Return current Windows codepage for console input. */)
2133 return make_number (GetConsoleCP ());
2137 DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage
,
2138 Sw32_set_console_codepage
, 1, 1, 0,
2139 doc
: /* Make Windows codepage CP be the codepage for Emacs tty keyboard input.
2140 This codepage setting affects keyboard input in tty mode.
2141 If successful, the new CP is returned, otherwise nil. */)
2146 if (!IsValidCodePage (XINT (cp
)))
2149 if (!SetConsoleCP (XINT (cp
)))
2152 return make_number (GetConsoleCP ());
2156 DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage
,
2157 Sw32_get_console_output_codepage
, 0, 0, 0,
2158 doc
: /* Return current Windows codepage for console output. */)
2161 return make_number (GetConsoleOutputCP ());
2165 DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage
,
2166 Sw32_set_console_output_codepage
, 1, 1, 0,
2167 doc
: /* Make Windows codepage CP be the codepage for Emacs console output.
2168 This codepage setting affects display in tty mode.
2169 If successful, the new CP is returned, otherwise nil. */)
2174 if (!IsValidCodePage (XINT (cp
)))
2177 if (!SetConsoleOutputCP (XINT (cp
)))
2180 return make_number (GetConsoleOutputCP ());
2184 DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset
,
2185 Sw32_get_codepage_charset
, 1, 1, 0,
2186 doc
: /* Return charset ID corresponding to codepage CP.
2187 Returns nil if the codepage is not valid. */)
2194 if (!IsValidCodePage (XINT (cp
)))
2197 if (TranslateCharsetInfo ((DWORD
*) XINT (cp
), &info
, TCI_SRCCODEPAGE
))
2198 return make_number (info
.ciCharset
);
2204 DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts
,
2205 Sw32_get_valid_keyboard_layouts
, 0, 0, 0,
2206 doc
: /* Return list of Windows keyboard languages and layouts.
2207 The return value is a list of pairs of language id and layout id. */)
2210 int num_layouts
= GetKeyboardLayoutList (0, NULL
);
2211 HKL
* layouts
= (HKL
*) alloca (num_layouts
* sizeof (HKL
));
2212 Lisp_Object obj
= Qnil
;
2214 if (GetKeyboardLayoutList (num_layouts
, layouts
) == num_layouts
)
2216 while (--num_layouts
>= 0)
2218 DWORD kl
= (DWORD
) layouts
[num_layouts
];
2220 obj
= Fcons (Fcons (make_number (kl
& 0xffff),
2221 make_number ((kl
>> 16) & 0xffff)),
2230 DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout
,
2231 Sw32_get_keyboard_layout
, 0, 0, 0,
2232 doc
: /* Return current Windows keyboard language and layout.
2233 The return value is the cons of the language id and the layout id. */)
2236 DWORD kl
= (DWORD
) GetKeyboardLayout (dwWindowsThreadId
);
2238 return Fcons (make_number (kl
& 0xffff),
2239 make_number ((kl
>> 16) & 0xffff));
2243 DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout
,
2244 Sw32_set_keyboard_layout
, 1, 1, 0,
2245 doc
: /* Make LAYOUT be the current keyboard layout for Emacs.
2246 The keyboard layout setting affects interpretation of keyboard input.
2247 If successful, the new layout id is returned, otherwise nil. */)
2248 (Lisp_Object layout
)
2252 CHECK_CONS (layout
);
2253 CHECK_NUMBER_CAR (layout
);
2254 CHECK_NUMBER_CDR (layout
);
2256 kl
= (XINT (XCAR (layout
)) & 0xffff)
2257 | (XINT (XCDR (layout
)) << 16);
2259 /* Synchronize layout with input thread. */
2260 if (dwWindowsThreadId
)
2262 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_SETKEYBOARDLAYOUT
,
2266 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
2268 if (msg
.wParam
== 0)
2272 else if (!ActivateKeyboardLayout ((HKL
) kl
, 0))
2275 return Fw32_get_keyboard_layout ();
2280 syms_of_ntproc (void)
2282 DEFSYM (Qhigh
, "high");
2283 DEFSYM (Qlow
, "low");
2285 defsubr (&Sw32_has_winsock
);
2286 defsubr (&Sw32_unload_winsock
);
2288 defsubr (&Sw32_short_file_name
);
2289 defsubr (&Sw32_long_file_name
);
2290 defsubr (&Sw32_set_process_priority
);
2291 defsubr (&Sw32_get_locale_info
);
2292 defsubr (&Sw32_get_current_locale_id
);
2293 defsubr (&Sw32_get_default_locale_id
);
2294 defsubr (&Sw32_get_valid_locale_ids
);
2295 defsubr (&Sw32_set_current_locale
);
2297 defsubr (&Sw32_get_console_codepage
);
2298 defsubr (&Sw32_set_console_codepage
);
2299 defsubr (&Sw32_get_console_output_codepage
);
2300 defsubr (&Sw32_set_console_output_codepage
);
2301 defsubr (&Sw32_get_valid_codepages
);
2302 defsubr (&Sw32_get_codepage_charset
);
2304 defsubr (&Sw32_get_valid_keyboard_layouts
);
2305 defsubr (&Sw32_get_keyboard_layout
);
2306 defsubr (&Sw32_set_keyboard_layout
);
2308 DEFVAR_LISP ("w32-quote-process-args", Vw32_quote_process_args
,
2309 doc
: /* Non-nil enables quoting of process arguments to ensure correct parsing.
2310 Because Windows does not directly pass argv arrays to child processes,
2311 programs have to reconstruct the argv array by parsing the command
2312 line string. For an argument to contain a space, it must be enclosed
2313 in double quotes or it will be parsed as multiple arguments.
2315 If the value is a character, that character will be used to escape any
2316 quote characters that appear, otherwise a suitable escape character
2317 will be chosen based on the type of the program. */);
2318 Vw32_quote_process_args
= Qt
;
2320 DEFVAR_LISP ("w32-start-process-show-window",
2321 Vw32_start_process_show_window
,
2322 doc
: /* When nil, new child processes hide their windows.
2323 When non-nil, they show their window in the method of their choice.
2324 This variable doesn't affect GUI applications, which will never be hidden. */);
2325 Vw32_start_process_show_window
= Qnil
;
2327 DEFVAR_LISP ("w32-start-process-share-console",
2328 Vw32_start_process_share_console
,
2329 doc
: /* When nil, new child processes are given a new console.
2330 When non-nil, they share the Emacs console; this has the limitation of
2331 allowing only one DOS subprocess to run at a time (whether started directly
2332 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
2333 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
2334 otherwise respond to interrupts from Emacs. */);
2335 Vw32_start_process_share_console
= Qnil
;
2337 DEFVAR_LISP ("w32-start-process-inherit-error-mode",
2338 Vw32_start_process_inherit_error_mode
,
2339 doc
: /* When nil, new child processes revert to the default error mode.
2340 When non-nil, they inherit their error mode setting from Emacs, which stops
2341 them blocking when trying to access unmounted drives etc. */);
2342 Vw32_start_process_inherit_error_mode
= Qt
;
2344 DEFVAR_INT ("w32-pipe-read-delay", w32_pipe_read_delay
,
2345 doc
: /* Forced delay before reading subprocess output.
2346 This is done to improve the buffering of subprocess output, by
2347 avoiding the inefficiency of frequently reading small amounts of data.
2349 If positive, the value is the number of milliseconds to sleep before
2350 reading the subprocess output. If negative, the magnitude is the number
2351 of time slices to wait (effectively boosting the priority of the child
2352 process temporarily). A value of zero disables waiting entirely. */);
2353 w32_pipe_read_delay
= 50;
2355 DEFVAR_LISP ("w32-downcase-file-names", Vw32_downcase_file_names
,
2356 doc
: /* Non-nil means convert all-upper case file names to lower case.
2357 This applies when performing completions and file name expansion.
2358 Note that the value of this setting also affects remote file names,
2359 so you probably don't want to set to non-nil if you use case-sensitive
2360 filesystems via ange-ftp. */);
2361 Vw32_downcase_file_names
= Qnil
;
2364 DEFVAR_LISP ("w32-generate-fake-inodes", Vw32_generate_fake_inodes
,
2365 doc
: /* Non-nil means attempt to fake realistic inode values.
2366 This works by hashing the truename of files, and should detect
2367 aliasing between long and short (8.3 DOS) names, but can have
2368 false positives because of hash collisions. Note that determining
2369 the truename of a file can be slow. */);
2370 Vw32_generate_fake_inodes
= Qnil
;
2373 DEFVAR_LISP ("w32-get-true-file-attributes", Vw32_get_true_file_attributes
,
2374 doc
: /* Non-nil means determine accurate file attributes in `file-attributes'.
2375 This option controls whether to issue additional system calls to determine
2376 accurate link counts, file type, and ownership information. It is more
2377 useful for files on NTFS volumes, where hard links and file security are
2378 supported, than on volumes of the FAT family.
2380 Without these system calls, link count will always be reported as 1 and file
2381 ownership will be attributed to the current user.
2382 The default value `local' means only issue these system calls for files
2383 on local fixed drives. A value of nil means never issue them.
2384 Any other non-nil value means do this even on remote and removable drives
2385 where the performance impact may be noticeable even on modern hardware. */);
2386 Vw32_get_true_file_attributes
= Qlocal
;
2388 staticpro (&Vw32_valid_locale_ids
);
2389 staticpro (&Vw32_valid_codepages
);
2391 /* end of w32proc.c */