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.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA.
22 Drew Bliss Oct 14, 1993
23 Adapted from alarm.c by Tim Fleehart
34 /* must include CRT headers *before* config.h */
48 /* This definition is missing from mingw32 headers. */
49 extern BOOL WINAPI
IsValidLocale(LCID
, DWORD
);
52 #ifdef HAVE_LANGINFO_CODESET
63 #include "syssignal.h"
66 #define RVA_TO_PTR(var,section,filedata) \
67 ((void *)((section)->PointerToRawData \
68 + ((DWORD)(var) - (section)->VirtualAddress) \
69 + (filedata).file_base))
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). */
75 Lisp_Object Vw32_quote_process_args
;
77 /* Control whether create_child causes the process' window to be
78 hidden. The default is nil. */
79 Lisp_Object Vw32_start_process_show_window
;
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. */
85 Lisp_Object Vw32_start_process_share_console
;
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. */
90 Lisp_Object Vw32_start_process_inherit_error_mode
;
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. */
96 int w32_pipe_read_delay
;
98 /* Control conversion of upper case file names to lower case.
99 nil means no, t means yes. */
100 Lisp_Object Vw32_downcase_file_names
;
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. */
106 Lisp_Object Vw32_generate_fake_inodes
;
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. */
111 Lisp_Object Vw32_get_true_file_attributes
;
113 Lisp_Object Qhigh
, Qlow
;
116 void _DebPrint (const char *fmt
, ...)
121 va_start (args
, fmt
);
122 vsprintf (buf
, fmt
, args
);
124 OutputDebugString (buf
);
128 typedef void (_CALLBACK_
*signal_handler
)(int);
130 /* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */
131 static signal_handler sig_handlers
[NSIG
];
133 /* Fake signal implementation to record the SIGCHLD handler. */
135 sys_signal (int sig
, signal_handler handler
)
144 old
= sig_handlers
[sig
];
145 sig_handlers
[sig
] = handler
;
149 /* Defined in <process.h> which conflicts with the local copy */
152 /* Child process management list. */
153 int child_proc_count
= 0;
154 child_process child_procs
[ MAX_CHILDREN
];
155 child_process
*dead_child
= NULL
;
157 DWORD WINAPI
reader_thread (void *arg
);
159 /* Find an unused process slot. */
166 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
167 if (!CHILD_ACTIVE (cp
))
169 if (child_proc_count
== MAX_CHILDREN
)
171 cp
= &child_procs
[child_proc_count
++];
174 memset (cp
, 0, sizeof(*cp
));
177 cp
->procinfo
.hProcess
= NULL
;
178 cp
->status
= STATUS_READ_ERROR
;
180 /* use manual reset event so that select() will function properly */
181 cp
->char_avail
= CreateEvent (NULL
, TRUE
, FALSE
, NULL
);
184 cp
->char_consumed
= CreateEvent (NULL
, FALSE
, FALSE
, NULL
);
185 if (cp
->char_consumed
)
187 cp
->thrd
= CreateThread (NULL
, 1024, reader_thread
, cp
, 0, &id
);
197 delete_child (child_process
*cp
)
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
)
206 if (!CHILD_ACTIVE (cp
))
209 /* reap thread if necessary */
214 if (GetExitCodeThread (cp
->thrd
, &rc
) && rc
== STILL_ACTIVE
)
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
)
221 DebPrint (("delete_child.WaitForSingleObject (thread) failed "
222 "with %lu for fd %ld\n", GetLastError (), cp
->fd
));
223 TerminateThread (cp
->thrd
, 0);
226 CloseHandle (cp
->thrd
);
231 CloseHandle (cp
->char_avail
);
232 cp
->char_avail
= NULL
;
234 if (cp
->char_consumed
)
236 CloseHandle (cp
->char_consumed
);
237 cp
->char_consumed
= NULL
;
240 /* update child_proc_count (highest numbered slot in use plus one) */
241 if (cp
== child_procs
+ child_proc_count
- 1)
243 for (i
= child_proc_count
-1; i
>= 0; i
--)
244 if (CHILD_ACTIVE (&child_procs
[i
]))
246 child_proc_count
= i
+ 1;
251 child_proc_count
= 0;
254 /* Find a child by pid. */
255 static child_process
*
256 find_child_pid (DWORD pid
)
260 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
261 if (CHILD_ACTIVE (cp
) && pid
== cp
->pid
)
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. */
272 reader_thread (void *arg
)
277 cp
= (child_process
*)arg
;
279 /* We have to wait for the go-ahead before we can start */
281 || WaitForSingleObject (cp
->char_consumed
, INFINITE
) != WAIT_OBJECT_0
)
288 if (fd_info
[cp
->fd
].flags
& FILE_LISTEN
)
289 rc
= _sys_wait_accept (cp
->fd
);
291 rc
= _sys_read_ahead (cp
->fd
);
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
))
297 DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld\n",
298 GetLastError (), cp
->fd
));
302 if (rc
== STATUS_READ_ERROR
)
305 /* If the read died, the child has died so let the thread die */
306 if (rc
== STATUS_READ_FAILED
)
309 /* Wait until our input is acknowledged before reading again */
310 if (WaitForSingleObject (cp
->char_consumed
, INFINITE
) != WAIT_OBJECT_0
)
312 DebPrint (("reader_thread.WaitForSingleObject failed with "
313 "%lu for fd %ld\n", GetLastError (), cp
->fd
));
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. */
323 static char * process_dir
;
326 create_child (char *exe
, char *cmdline
, char *env
, int is_gui_app
,
327 int * pPid
, child_process
*cp
)
330 SECURITY_ATTRIBUTES sec_attrs
;
332 SECURITY_DESCRIPTOR sec_desc
;
335 char dir
[ MAXPATHLEN
];
337 if (cp
== NULL
) abort ();
339 memset (&start
, 0, sizeof (start
));
340 start
.cb
= sizeof (start
);
343 if (NILP (Vw32_start_process_show_window
) && !is_gui_app
)
344 start
.dwFlags
= STARTF_USESTDHANDLES
| STARTF_USESHOWWINDOW
;
346 start
.dwFlags
= STARTF_USESTDHANDLES
;
347 start
.wShowWindow
= SW_HIDE
;
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 */
355 /* Explicitly specify no security */
356 if (!InitializeSecurityDescriptor (&sec_desc
, SECURITY_DESCRIPTOR_REVISION
))
358 if (!SetSecurityDescriptorDacl (&sec_desc
, TRUE
, NULL
, FALSE
))
361 sec_attrs
.nLength
= sizeof (sec_attrs
);
362 sec_attrs
.lpSecurityDescriptor
= NULL
/* &sec_desc */;
363 sec_attrs
.bInheritHandle
= FALSE
;
365 strcpy (dir
, process_dir
);
366 unixtodos_filename (dir
);
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
))
377 cp
->pid
= (int) cp
->procinfo
.dwProcessId
;
379 /* Hack for Windows 95, which assigns large (ie negative) pids */
383 /* pid must fit in a Lisp_Int */
384 cp
->pid
= cp
->pid
& INTMASK
;
391 DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError()););
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. */
401 register_child (int pid
, int fd
)
405 cp
= find_child_pid (pid
);
408 DebPrint (("register_child unable to find pid %lu\n", pid
));
413 DebPrint (("register_child registered fd %d with pid %lu\n", fd
, pid
));
418 /* thread is initially blocked until select is called; set status so
419 that select will release thread */
420 cp
->status
= STATUS_READ_ACKNOWLEDGED
;
422 /* attach child_process to fd_info */
423 if (fd_info
[fd
].cp
!= NULL
)
425 DebPrint (("register_child: fd_info[%d] apparently in use!\n", fd
));
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. */
437 reap_subprocess (child_process
*cp
)
439 if (cp
->procinfo
.hProcess
)
441 /* Reap the process */
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
));
447 CloseHandle (cp
->procinfo
.hProcess
);
448 cp
->procinfo
.hProcess
= NULL
;
449 CloseHandle (cp
->procinfo
.hThread
);
450 cp
->procinfo
.hThread
= NULL
;
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. */
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. */
466 sys_wait (int *status
)
468 DWORD active
, retval
;
471 child_process
*cp
, *cps
[MAX_CHILDREN
];
472 HANDLE wait_hnd
[MAX_CHILDREN
];
475 if (dead_child
!= NULL
)
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 ();
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))
492 wait_hnd
[nh
] = cp
->procinfo
.hProcess
;
500 /* Nothing to wait on, so fail */
507 /* Check for quit about once a second. */
509 active
= WaitForMultipleObjects (nh
, wait_hnd
, FALSE
, 1000);
510 } while (active
== WAIT_TIMEOUT
);
512 if (active
== WAIT_FAILED
)
517 else if (active
>= WAIT_OBJECT_0
518 && active
< WAIT_OBJECT_0
+MAXIMUM_WAIT_OBJECTS
)
520 active
-= WAIT_OBJECT_0
;
522 else if (active
>= WAIT_ABANDONED_0
523 && active
< WAIT_ABANDONED_0
+MAXIMUM_WAIT_OBJECTS
)
525 active
-= WAIT_ABANDONED_0
;
531 if (!GetExitCodeProcess (wait_hnd
[active
], &retval
))
533 DebPrint (("Wait.GetExitCodeProcess failed with %lu\n",
537 if (retval
== STILL_ACTIVE
)
539 /* Should never happen */
540 DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
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. */
549 if (retval
== STATUS_CONTROL_C_EXIT
)
557 DebPrint (("Wait signaled with process pid %d\n", cp
->pid
));
564 else if (synch_process_alive
)
566 synch_process_alive
= 0;
568 /* Report the status of the synchronous process. */
569 if (WIFEXITED (retval
))
570 synch_process_retcode
= WRETCODE (retval
);
571 else if (WIFSIGNALED (retval
))
573 int code
= WTERMSIG (retval
);
576 synchronize_system_messages_locale ();
577 signame
= strsignal (code
);
582 synch_process_death
= signame
;
585 reap_subprocess (cp
);
588 reap_subprocess (cp
);
593 /* Old versions of w32api headers don't have separate 32-bit and
594 64-bit defines, but the one they have matches the 32-bit variety. */
595 #ifndef IMAGE_NT_OPTIONAL_HDR32_MAGIC
596 # define IMAGE_NT_OPTIONAL_HDR32_MAGIC IMAGE_NT_OPTIONAL_HDR_MAGIC
597 # define IMAGE_OPTIONAL_HEADER32 IMAGE_OPTIONAL_HEADER
601 w32_executable_type (char * filename
, int * is_dos_app
, int * is_cygnus_app
, int * is_gui_app
)
603 file_data executable
;
606 /* Default values in case we can't tell for sure. */
608 *is_cygnus_app
= FALSE
;
611 if (!open_input_file (&executable
, filename
))
614 p
= strrchr (filename
, '.');
616 /* We can only identify DOS .com programs from the extension. */
617 if (p
&& stricmp (p
, ".com") == 0)
619 else if (p
&& (stricmp (p
, ".bat") == 0
620 || stricmp (p
, ".cmd") == 0))
622 /* A DOS shell script - it appears that CreateProcess is happy to
623 accept this (somewhat surprisingly); presumably it looks at
624 COMSPEC to determine what executable to actually invoke.
625 Therefore, we have to do the same here as well. */
626 /* Actually, I think it uses the program association for that
627 extension, which is defined in the registry. */
628 p
= egetenv ("COMSPEC");
630 w32_executable_type (p
, is_dos_app
, is_cygnus_app
, is_gui_app
);
634 /* Look for DOS .exe signature - if found, we must also check that
635 it isn't really a 16- or 32-bit Windows exe, since both formats
636 start with a DOS program stub. Note that 16-bit Windows
637 executables use the OS/2 1.x format. */
639 IMAGE_DOS_HEADER
* dos_header
;
640 IMAGE_NT_HEADERS
* nt_header
;
642 dos_header
= (PIMAGE_DOS_HEADER
) executable
.file_base
;
643 if (dos_header
->e_magic
!= IMAGE_DOS_SIGNATURE
)
646 nt_header
= (PIMAGE_NT_HEADERS
) ((char *) dos_header
+ dos_header
->e_lfanew
);
648 if ((char *) nt_header
> (char *) dos_header
+ executable
.size
)
650 /* Some dos headers (pkunzip) have bogus e_lfanew fields. */
653 else if (nt_header
->Signature
!= IMAGE_NT_SIGNATURE
654 && LOWORD (nt_header
->Signature
) != IMAGE_OS2_SIGNATURE
)
658 else if (nt_header
->Signature
== IMAGE_NT_SIGNATURE
)
660 IMAGE_DATA_DIRECTORY
*data_dir
= NULL
;
661 if (nt_header
->OptionalHeader
.Magic
== IMAGE_NT_OPTIONAL_HDR32_MAGIC
)
663 /* Ensure we are using the 32 bit structure. */
664 IMAGE_OPTIONAL_HEADER32
*opt
665 = (IMAGE_OPTIONAL_HEADER32
*) &(nt_header
->OptionalHeader
);
666 data_dir
= opt
->DataDirectory
;
667 *is_gui_app
= (opt
->Subsystem
== IMAGE_SUBSYSTEM_WINDOWS_GUI
);
669 /* MingW 3.12 has the required 64 bit structs, but in case older
670 versions don't, only check 64 bit exes if we know how. */
671 #ifdef IMAGE_NT_OPTIONAL_HDR64_MAGIC
672 else if (nt_header
->OptionalHeader
.Magic
673 == IMAGE_NT_OPTIONAL_HDR64_MAGIC
)
675 IMAGE_OPTIONAL_HEADER64
*opt
676 = (IMAGE_OPTIONAL_HEADER64
*) &(nt_header
->OptionalHeader
);
677 data_dir
= opt
->DataDirectory
;
678 *is_gui_app
= (opt
->Subsystem
== IMAGE_SUBSYSTEM_WINDOWS_GUI
);
683 /* Look for cygwin.dll in DLL import list. */
684 IMAGE_DATA_DIRECTORY import_dir
=
685 data_dir
[IMAGE_DIRECTORY_ENTRY_IMPORT
];
686 IMAGE_IMPORT_DESCRIPTOR
* imports
;
687 IMAGE_SECTION_HEADER
* section
;
689 section
= rva_to_section (import_dir
.VirtualAddress
, nt_header
);
690 imports
= RVA_TO_PTR (import_dir
.VirtualAddress
, section
,
693 for ( ; imports
->Name
; imports
++)
695 char * dllname
= RVA_TO_PTR (imports
->Name
, section
,
698 /* The exact name of the cygwin dll has changed with
699 various releases, but hopefully this will be reasonably
701 if (strncmp (dllname
, "cygwin", 6) == 0)
703 *is_cygnus_app
= TRUE
;
712 close_file_data (&executable
);
716 compare_env (const void *strp1
, const void *strp2
)
718 const char *str1
= *(const char **)strp1
, *str2
= *(const char **)strp2
;
720 while (*str1
&& *str2
&& *str1
!= '=' && *str2
!= '=')
722 /* Sort order in command.com/cmd.exe is based on uppercasing
723 names, so do the same here. */
724 if (toupper (*str1
) > toupper (*str2
))
726 else if (toupper (*str1
) < toupper (*str2
))
731 if (*str1
== '=' && *str2
== '=')
733 else if (*str1
== '=')
740 merge_and_sort_env (char **envp1
, char **envp2
, char **new_envp
)
756 qsort (new_envp
, num
, sizeof (char *), compare_env
);
761 /* When a new child process is created we need to register it in our list,
762 so intercept spawn requests. */
764 sys_spawnve (int mode
, char *cmdname
, char **argv
, char **envp
)
766 Lisp_Object program
, full
;
767 char *cmdline
, *env
, *parg
, **targ
;
771 int is_dos_app
, is_cygnus_app
, is_gui_app
;
774 /* We pass our process ID to our children by setting up an environment
775 variable in their environment. */
776 char ppid_env_var_buffer
[64];
777 char *extra_env
[] = {ppid_env_var_buffer
, NULL
};
778 char *sepchars
= " \t";
780 /* We don't care about the other modes */
781 if (mode
!= _P_NOWAIT
)
787 /* Handle executable names without an executable suffix. */
788 program
= make_string (cmdname
, strlen (cmdname
));
789 if (NILP (Ffile_executable_p (program
)))
795 openp (Vexec_path
, program
, Vexec_suffixes
, &full
, make_number (X_OK
));
805 /* make sure argv[0] and cmdname are both in DOS format */
806 cmdname
= SDATA (program
);
807 unixtodos_filename (cmdname
);
810 /* Determine whether program is a 16-bit DOS executable, or a w32
811 executable that is implicitly linked to the Cygnus dll (implying it
812 was compiled with the Cygnus GNU toolchain and hence relies on
813 cygwin.dll to parse the command line - we use this to decide how to
814 escape quote chars in command line args that must be quoted).
816 Also determine whether it is a GUI app, so that we don't hide its
817 initial window unless specifically requested. */
818 w32_executable_type (cmdname
, &is_dos_app
, &is_cygnus_app
, &is_gui_app
);
820 /* On Windows 95, if cmdname is a DOS app, we invoke a helper
821 application to start it by specifying the helper app as cmdname,
822 while leaving the real app name as argv[0]. */
825 cmdname
= alloca (MAXPATHLEN
);
826 if (egetenv ("CMDPROXY"))
827 strcpy (cmdname
, egetenv ("CMDPROXY"));
830 strcpy (cmdname
, SDATA (Vinvocation_directory
));
831 strcat (cmdname
, "cmdproxy.exe");
833 unixtodos_filename (cmdname
);
836 /* we have to do some conjuring here to put argv and envp into the
837 form CreateProcess wants... argv needs to be a space separated/null
838 terminated list of parameters, and envp is a null
839 separated/double-null terminated list of parameters.
841 Additionally, zero-length args and args containing whitespace or
842 quote chars need to be wrapped in double quotes - for this to work,
843 embedded quotes need to be escaped as well. The aim is to ensure
844 the child process reconstructs the argv array we start with
845 exactly, so we treat quotes at the beginning and end of arguments
848 The w32 GNU-based library from Cygnus doubles quotes to escape
849 them, while MSVC uses backslash for escaping. (Actually the MSVC
850 startup code does attempt to recognise doubled quotes and accept
851 them, but gets it wrong and ends up requiring three quotes to get a
852 single embedded quote!) So by default we decide whether to use
853 quote or backslash as the escape character based on whether the
854 binary is apparently a Cygnus compiled app.
856 Note that using backslash to escape embedded quotes requires
857 additional special handling if an embedded quote is already
858 preceeded by backslash, or if an arg requiring quoting ends with
859 backslash. In such cases, the run of escape characters needs to be
860 doubled. For consistency, we apply this special handling as long
861 as the escape character is not quote.
863 Since we have no idea how large argv and envp are likely to be we
864 figure out list lengths on the fly and allocate them. */
866 if (!NILP (Vw32_quote_process_args
))
869 /* Override escape char by binding w32-quote-process-args to
870 desired character, or use t for auto-selection. */
871 if (INTEGERP (Vw32_quote_process_args
))
872 escape_char
= XINT (Vw32_quote_process_args
);
874 escape_char
= is_cygnus_app
? '"' : '\\';
877 /* Cygwin apps needs quoting a bit more often */
878 if (escape_char
== '"')
879 sepchars
= "\r\n\t\f '";
888 int escape_char_run
= 0;
894 if (escape_char
== '"' && *p
== '\\')
895 /* If it's a Cygwin app, \ needs to be escaped. */
899 /* allow for embedded quotes to be escaped */
902 /* handle the case where the embedded quote is already escaped */
903 if (escape_char_run
> 0)
905 /* To preserve the arg exactly, we need to double the
906 preceding escape characters (plus adding one to
907 escape the quote character itself). */
908 arglen
+= escape_char_run
;
911 else if (strchr (sepchars
, *p
) != NULL
)
916 if (*p
== escape_char
&& escape_char
!= '"')
924 /* handle the case where the arg ends with an escape char - we
925 must not let the enclosing quote be escaped. */
926 if (escape_char_run
> 0)
927 arglen
+= escape_char_run
;
929 arglen
+= strlen (*targ
++) + 1;
931 cmdline
= alloca (arglen
);
945 if ((strchr (sepchars
, *p
) != NULL
) || *p
== '"')
950 int escape_char_run
= 0;
956 last
= p
+ strlen (p
) - 1;
959 /* This version does not escape quotes if they occur at the
960 beginning or end of the arg - this could lead to incorrect
961 behaviour when the arg itself represents a command line
962 containing quoted args. I believe this was originally done
963 as a hack to make some things work, before
964 `w32-quote-process-args' was added. */
967 if (*p
== '"' && p
> first
&& p
< last
)
968 *parg
++ = escape_char
; /* escape embedded quotes */
976 /* double preceding escape chars if any */
977 while (escape_char_run
> 0)
979 *parg
++ = escape_char
;
982 /* escape all quote chars, even at beginning or end */
983 *parg
++ = escape_char
;
985 else if (escape_char
== '"' && *p
== '\\')
989 if (*p
== escape_char
&& escape_char
!= '"')
994 /* double escape chars before enclosing quote */
995 while (escape_char_run
> 0)
997 *parg
++ = escape_char
;
1005 strcpy (parg
, *targ
);
1006 parg
+= strlen (*targ
);
1016 numenv
= 1; /* for end null */
1019 arglen
+= strlen (*targ
++) + 1;
1022 /* extra env vars... */
1023 sprintf (ppid_env_var_buffer
, "EM_PARENT_PROCESS_ID=%d",
1024 GetCurrentProcessId ());
1025 arglen
+= strlen (ppid_env_var_buffer
) + 1;
1028 /* merge env passed in and extra env into one, and sort it. */
1029 targ
= (char **) alloca (numenv
* sizeof (char *));
1030 merge_and_sort_env (envp
, extra_env
, targ
);
1032 /* concatenate env entries. */
1033 env
= alloca (arglen
);
1037 strcpy (parg
, *targ
);
1038 parg
+= strlen (*targ
++);
1051 /* Now create the process. */
1052 if (!create_child (cmdname
, cmdline
, env
, is_gui_app
, &pid
, cp
))
1062 /* Emulate the select call
1063 Wait for available input on any of the given rfds, or timeout if
1064 a timeout is given and no input is detected
1065 wfds and efds are not supported and must be NULL.
1067 For simplicity, we detect the death of child processes here and
1068 synchronously call the SIGCHLD handler. Since it is possible for
1069 children to be created without a corresponding pipe handle from which
1070 to read output, we wait separately on the process handles as well as
1071 the char_avail events for each process pipe. We only call
1072 wait/reap_process when the process actually terminates.
1074 To reduce the number of places in which Emacs can be hung such that
1075 C-g is not able to interrupt it, we always wait on interrupt_handle
1076 (which is signalled by the input thread when C-g is detected). If we
1077 detect that we were woken up by C-g, we return -1 with errno set to
1078 EINTR as on Unix. */
1081 extern HANDLE keyboard_handle
;
1083 /* From w32xfns.c */
1084 extern HANDLE interrupt_handle
;
1086 /* From process.c */
1087 extern int proc_buffered_char
[];
1090 sys_select (int nfds
, SELECT_TYPE
*rfds
, SELECT_TYPE
*wfds
, SELECT_TYPE
*efds
,
1091 EMACS_TIME
*timeout
)
1094 DWORD timeout_ms
, start_time
;
1097 child_process
*cp
, *cps
[MAX_CHILDREN
];
1098 HANDLE wait_hnd
[MAXDESC
+ MAX_CHILDREN
];
1099 int fdindex
[MAXDESC
]; /* mapping from wait handles back to descriptors */
1101 timeout_ms
= timeout
? (timeout
->tv_sec
* 1000 + timeout
->tv_usec
/ 1000) : INFINITE
;
1103 /* If the descriptor sets are NULL but timeout isn't, then just Sleep. */
1104 if (rfds
== NULL
&& wfds
== NULL
&& efds
== NULL
&& timeout
!= NULL
)
1110 /* Otherwise, we only handle rfds, so fail otherwise. */
1111 if (rfds
== NULL
|| wfds
!= NULL
|| efds
!= NULL
)
1121 /* Always wait on interrupt_handle, to detect C-g (quit). */
1122 wait_hnd
[0] = interrupt_handle
;
1125 /* Build a list of pipe handles to wait on. */
1127 for (i
= 0; i
< nfds
; i
++)
1128 if (FD_ISSET (i
, &orfds
))
1132 if (keyboard_handle
)
1134 /* Handle stdin specially */
1135 wait_hnd
[nh
] = keyboard_handle
;
1140 /* Check for any emacs-generated input in the queue since
1141 it won't be detected in the wait */
1142 if (detect_input_pending ())
1150 /* Child process and socket input */
1154 int current_status
= cp
->status
;
1156 if (current_status
== STATUS_READ_ACKNOWLEDGED
)
1158 /* Tell reader thread which file handle to use. */
1160 /* Wake up the reader thread for this process */
1161 cp
->status
= STATUS_READ_READY
;
1162 if (!SetEvent (cp
->char_consumed
))
1163 DebPrint (("nt_select.SetEvent failed with "
1164 "%lu for fd %ld\n", GetLastError (), i
));
1167 #ifdef CHECK_INTERLOCK
1168 /* slightly crude cross-checking of interlock between threads */
1170 current_status
= cp
->status
;
1171 if (WaitForSingleObject (cp
->char_avail
, 0) == WAIT_OBJECT_0
)
1173 /* char_avail has been signalled, so status (which may
1174 have changed) should indicate read has completed
1175 but has not been acknowledged. */
1176 current_status
= cp
->status
;
1177 if (current_status
!= STATUS_READ_SUCCEEDED
1178 && current_status
!= STATUS_READ_FAILED
)
1179 DebPrint (("char_avail set, but read not completed: status %d\n",
1184 /* char_avail has not been signalled, so status should
1185 indicate that read is in progress; small possibility
1186 that read has completed but event wasn't yet signalled
1187 when we tested it (because a context switch occurred
1188 or if running on separate CPUs). */
1189 if (current_status
!= STATUS_READ_READY
1190 && current_status
!= STATUS_READ_IN_PROGRESS
1191 && current_status
!= STATUS_READ_SUCCEEDED
1192 && current_status
!= STATUS_READ_FAILED
)
1193 DebPrint (("char_avail reset, but read status is bad: %d\n",
1197 wait_hnd
[nh
] = cp
->char_avail
;
1199 if (!wait_hnd
[nh
]) abort ();
1202 DebPrint (("select waiting on child %d fd %d\n",
1203 cp
-child_procs
, i
));
1208 /* Unable to find something to wait on for this fd, skip */
1210 /* Note that this is not a fatal error, and can in fact
1211 happen in unusual circumstances. Specifically, if
1212 sys_spawnve fails, eg. because the program doesn't
1213 exist, and debug-on-error is t so Fsignal invokes a
1214 nested input loop, then the process output pipe is
1215 still included in input_wait_mask with no child_proc
1216 associated with it. (It is removed when the debugger
1217 exits the nested input loop and the error is thrown.) */
1219 DebPrint (("sys_select: fd %ld is invalid! ignoring\n", i
));
1225 /* Add handles of child processes. */
1227 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
1228 /* Some child_procs might be sockets; ignore them. Also some
1229 children may have died already, but we haven't finished reading
1230 the process output; ignore them too. */
1231 if (CHILD_ACTIVE (cp
) && cp
->procinfo
.hProcess
1233 || (fd_info
[cp
->fd
].flags
& FILE_SEND_SIGCHLD
) == 0
1234 || (fd_info
[cp
->fd
].flags
& FILE_AT_EOF
) != 0)
1237 wait_hnd
[nh
+ nc
] = cp
->procinfo
.hProcess
;
1242 /* Nothing to look for, so we didn't find anything */
1250 start_time
= GetTickCount ();
1252 /* Wait for input or child death to be signalled. If user input is
1253 allowed, then also accept window messages. */
1254 if (FD_ISSET (0, &orfds
))
1255 active
= MsgWaitForMultipleObjects (nh
+ nc
, wait_hnd
, FALSE
, timeout_ms
,
1258 active
= WaitForMultipleObjects (nh
+ nc
, wait_hnd
, FALSE
, timeout_ms
);
1260 if (active
== WAIT_FAILED
)
1262 DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n",
1263 nh
+ nc
, timeout_ms
, GetLastError ()));
1264 /* don't return EBADF - this causes wait_reading_process_output to
1265 abort; WAIT_FAILED is returned when single-stepping under
1266 Windows 95 after switching thread focus in debugger, and
1267 possibly at other times. */
1271 else if (active
== WAIT_TIMEOUT
)
1275 else if (active
>= WAIT_OBJECT_0
1276 && active
< WAIT_OBJECT_0
+MAXIMUM_WAIT_OBJECTS
)
1278 active
-= WAIT_OBJECT_0
;
1280 else if (active
>= WAIT_ABANDONED_0
1281 && active
< WAIT_ABANDONED_0
+MAXIMUM_WAIT_OBJECTS
)
1283 active
-= WAIT_ABANDONED_0
;
1288 /* Loop over all handles after active (now officially documented as
1289 being the first signalled handle in the array). We do this to
1290 ensure fairness, so that all channels with data available will be
1291 processed - otherwise higher numbered channels could be starved. */
1294 if (active
== nh
+ nc
)
1296 /* There are messages in the lisp thread's queue; we must
1297 drain the queue now to ensure they are processed promptly,
1298 because if we don't do so, we will not be woken again until
1299 further messages arrive.
1301 NB. If ever we allow window message procedures to callback
1302 into lisp, we will need to ensure messages are dispatched
1303 at a safe time for lisp code to be run (*), and we may also
1304 want to provide some hooks in the dispatch loop to cater
1305 for modeless dialogs created by lisp (ie. to register
1306 window handles to pass to IsDialogMessage).
1308 (*) Note that MsgWaitForMultipleObjects above is an
1309 internal dispatch point for messages that are sent to
1310 windows created by this thread. */
1311 drain_message_queue ();
1313 else if (active
>= nh
)
1315 cp
= cps
[active
- nh
];
1317 /* We cannot always signal SIGCHLD immediately; if we have not
1318 finished reading the process output, we must delay sending
1319 SIGCHLD until we do. */
1321 if (cp
->fd
>= 0 && (fd_info
[cp
->fd
].flags
& FILE_AT_EOF
) == 0)
1322 fd_info
[cp
->fd
].flags
|= FILE_SEND_SIGCHLD
;
1323 /* SIG_DFL for SIGCHLD is ignore */
1324 else if (sig_handlers
[SIGCHLD
] != SIG_DFL
&&
1325 sig_handlers
[SIGCHLD
] != SIG_IGN
)
1328 DebPrint (("select calling SIGCHLD handler for pid %d\n",
1332 sig_handlers
[SIGCHLD
] (SIGCHLD
);
1336 else if (fdindex
[active
] == -1)
1338 /* Quit (C-g) was detected. */
1342 else if (fdindex
[active
] == 0)
1344 /* Keyboard input available */
1350 /* must be a socket or pipe - read ahead should have
1351 completed, either succeeding or failing. */
1352 FD_SET (fdindex
[active
], rfds
);
1356 /* Even though wait_reading_process_output only reads from at most
1357 one channel, we must process all channels here so that we reap
1358 all children that have died. */
1359 while (++active
< nh
+ nc
)
1360 if (WaitForSingleObject (wait_hnd
[active
], 0) == WAIT_OBJECT_0
)
1362 } while (active
< nh
+ nc
);
1364 /* If no input has arrived and timeout hasn't expired, wait again. */
1367 DWORD elapsed
= GetTickCount () - start_time
;
1369 if (timeout_ms
> elapsed
) /* INFINITE is MAX_UINT */
1371 if (timeout_ms
!= INFINITE
)
1372 timeout_ms
-= elapsed
;
1373 goto count_children
;
1380 /* Substitute for certain kill () operations */
1382 static BOOL CALLBACK
1383 find_child_console (HWND hwnd
, LPARAM arg
)
1385 child_process
* cp
= (child_process
*) arg
;
1389 thread_id
= GetWindowThreadProcessId (hwnd
, &process_id
);
1390 if (process_id
== cp
->procinfo
.dwProcessId
)
1392 char window_class
[32];
1394 GetClassName (hwnd
, window_class
, sizeof (window_class
));
1395 if (strcmp (window_class
,
1396 (os_subtype
== OS_WIN95
)
1398 : "ConsoleWindowClass") == 0)
1409 sys_kill (int pid
, int sig
)
1413 int need_to_free
= 0;
1416 /* Only handle signals that will result in the process dying */
1417 if (sig
!= SIGINT
&& sig
!= SIGKILL
&& sig
!= SIGQUIT
&& sig
!= SIGHUP
)
1423 cp
= find_child_pid (pid
);
1426 proc_hand
= OpenProcess (PROCESS_TERMINATE
, 0, pid
);
1427 if (proc_hand
== NULL
)
1436 proc_hand
= cp
->procinfo
.hProcess
;
1437 pid
= cp
->procinfo
.dwProcessId
;
1439 /* Try to locate console window for process. */
1440 EnumWindows (find_child_console
, (LPARAM
) cp
);
1443 if (sig
== SIGINT
|| sig
== SIGQUIT
)
1445 if (NILP (Vw32_start_process_share_console
) && cp
&& cp
->hwnd
)
1447 BYTE control_scan_code
= (BYTE
) MapVirtualKey (VK_CONTROL
, 0);
1448 /* Fake Ctrl-C for SIGINT, and Ctrl-Break for SIGQUIT. */
1449 BYTE vk_break_code
= (sig
== SIGINT
) ? 'C' : VK_CANCEL
;
1450 BYTE break_scan_code
= (BYTE
) MapVirtualKey (vk_break_code
, 0);
1451 HWND foreground_window
;
1453 if (break_scan_code
== 0)
1455 /* Fake Ctrl-C for SIGQUIT if we can't manage Ctrl-Break. */
1456 vk_break_code
= 'C';
1457 break_scan_code
= (BYTE
) MapVirtualKey (vk_break_code
, 0);
1460 foreground_window
= GetForegroundWindow ();
1461 if (foreground_window
)
1463 /* NT 5.0, and apparently also Windows 98, will not allow
1464 a Window to be set to foreground directly without the
1465 user's involvement. The workaround is to attach
1466 ourselves to the thread that owns the foreground
1467 window, since that is the only thread that can set the
1468 foreground window. */
1469 DWORD foreground_thread
, child_thread
;
1471 GetWindowThreadProcessId (foreground_window
, NULL
);
1472 if (foreground_thread
== GetCurrentThreadId ()
1473 || !AttachThreadInput (GetCurrentThreadId (),
1474 foreground_thread
, TRUE
))
1475 foreground_thread
= 0;
1477 child_thread
= GetWindowThreadProcessId (cp
->hwnd
, NULL
);
1478 if (child_thread
== GetCurrentThreadId ()
1479 || !AttachThreadInput (GetCurrentThreadId (),
1480 child_thread
, TRUE
))
1483 /* Set the foreground window to the child. */
1484 if (SetForegroundWindow (cp
->hwnd
))
1486 /* Generate keystrokes as if user had typed Ctrl-Break or
1488 keybd_event (VK_CONTROL
, control_scan_code
, 0, 0);
1489 keybd_event (vk_break_code
, break_scan_code
,
1490 (vk_break_code
== 'C' ? 0 : KEYEVENTF_EXTENDEDKEY
), 0);
1491 keybd_event (vk_break_code
, break_scan_code
,
1492 (vk_break_code
== 'C' ? 0 : KEYEVENTF_EXTENDEDKEY
)
1493 | KEYEVENTF_KEYUP
, 0);
1494 keybd_event (VK_CONTROL
, control_scan_code
,
1495 KEYEVENTF_KEYUP
, 0);
1497 /* Sleep for a bit to give time for Emacs frame to respond
1498 to focus change events (if Emacs was active app). */
1501 SetForegroundWindow (foreground_window
);
1503 /* Detach from the foreground and child threads now that
1504 the foreground switching is over. */
1505 if (foreground_thread
)
1506 AttachThreadInput (GetCurrentThreadId (),
1507 foreground_thread
, FALSE
);
1509 AttachThreadInput (GetCurrentThreadId (),
1510 child_thread
, FALSE
);
1513 /* Ctrl-Break is NT equivalent of SIGINT. */
1514 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT
, pid
))
1516 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
1517 "for pid %lu\n", GetLastError (), pid
));
1524 if (NILP (Vw32_start_process_share_console
) && cp
&& cp
->hwnd
)
1527 if (os_subtype
== OS_WIN95
)
1530 Another possibility is to try terminating the VDM out-right by
1531 calling the Shell VxD (id 0x17) V86 interface, function #4
1532 "SHELL_Destroy_VM", ie.
1538 First need to determine the current VM handle, and then arrange for
1539 the shellapi call to be made from the system vm (by using
1540 Switch_VM_and_callback).
1542 Could try to invoke DestroyVM through CallVxD.
1546 /* On Win95, posting WM_QUIT causes the 16-bit subsystem
1547 to hang when cmdproxy is used in conjunction with
1548 command.com for an interactive shell. Posting
1549 WM_CLOSE pops up a dialog that, when Yes is selected,
1550 does the same thing. TerminateProcess is also less
1551 than ideal in that subprocesses tend to stick around
1552 until the machine is shutdown, but at least it
1553 doesn't freeze the 16-bit subsystem. */
1554 PostMessage (cp
->hwnd
, WM_QUIT
, 0xff, 0);
1556 if (!TerminateProcess (proc_hand
, 0xff))
1558 DebPrint (("sys_kill.TerminateProcess returned %d "
1559 "for pid %lu\n", GetLastError (), pid
));
1566 PostMessage (cp
->hwnd
, WM_CLOSE
, 0, 0);
1568 /* Kill the process. On W32 this doesn't kill child processes
1569 so it doesn't work very well for shells which is why it's not
1570 used in every case. */
1571 else if (!TerminateProcess (proc_hand
, 0xff))
1573 DebPrint (("sys_kill.TerminateProcess returned %d "
1574 "for pid %lu\n", GetLastError (), pid
));
1581 CloseHandle (proc_hand
);
1586 /* extern int report_file_error (char *, Lisp_Object); */
1588 /* The following two routines are used to manipulate stdin, stdout, and
1589 stderr of our child processes.
1591 Assuming that in, out, and err are *not* inheritable, we make them
1592 stdin, stdout, and stderr of the child as follows:
1594 - Save the parent's current standard handles.
1595 - Set the std handles to inheritable duplicates of the ones being passed in.
1596 (Note that _get_osfhandle() is an io.h procedure that retrieves the
1597 NT file handle for a crt file descriptor.)
1598 - Spawn the child, which inherits in, out, and err as stdin,
1599 stdout, and stderr. (see Spawnve)
1600 - Close the std handles passed to the child.
1601 - Reset the parent's standard handles to the saved handles.
1602 (see reset_standard_handles)
1603 We assume that the caller closes in, out, and err after calling us. */
1606 prepare_standard_handles (int in
, int out
, int err
, HANDLE handles
[3])
1609 HANDLE newstdin
, newstdout
, newstderr
;
1611 parent
= GetCurrentProcess ();
1613 handles
[0] = GetStdHandle (STD_INPUT_HANDLE
);
1614 handles
[1] = GetStdHandle (STD_OUTPUT_HANDLE
);
1615 handles
[2] = GetStdHandle (STD_ERROR_HANDLE
);
1617 /* make inheritable copies of the new handles */
1618 if (!DuplicateHandle (parent
,
1619 (HANDLE
) _get_osfhandle (in
),
1624 DUPLICATE_SAME_ACCESS
))
1625 report_file_error ("Duplicating input handle for child", Qnil
);
1627 if (!DuplicateHandle (parent
,
1628 (HANDLE
) _get_osfhandle (out
),
1633 DUPLICATE_SAME_ACCESS
))
1634 report_file_error ("Duplicating output handle for child", Qnil
);
1636 if (!DuplicateHandle (parent
,
1637 (HANDLE
) _get_osfhandle (err
),
1642 DUPLICATE_SAME_ACCESS
))
1643 report_file_error ("Duplicating error handle for child", Qnil
);
1645 /* and store them as our std handles */
1646 if (!SetStdHandle (STD_INPUT_HANDLE
, newstdin
))
1647 report_file_error ("Changing stdin handle", Qnil
);
1649 if (!SetStdHandle (STD_OUTPUT_HANDLE
, newstdout
))
1650 report_file_error ("Changing stdout handle", Qnil
);
1652 if (!SetStdHandle (STD_ERROR_HANDLE
, newstderr
))
1653 report_file_error ("Changing stderr handle", Qnil
);
1657 reset_standard_handles (int in
, int out
, int err
, HANDLE handles
[3])
1659 /* close the duplicated handles passed to the child */
1660 CloseHandle (GetStdHandle (STD_INPUT_HANDLE
));
1661 CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE
));
1662 CloseHandle (GetStdHandle (STD_ERROR_HANDLE
));
1664 /* now restore parent's saved std handles */
1665 SetStdHandle (STD_INPUT_HANDLE
, handles
[0]);
1666 SetStdHandle (STD_OUTPUT_HANDLE
, handles
[1]);
1667 SetStdHandle (STD_ERROR_HANDLE
, handles
[2]);
1671 set_process_dir (char * dir
)
1678 /* To avoid problems with winsock implementations that work over dial-up
1679 connections causing or requiring a connection to exist while Emacs is
1680 running, Emacs no longer automatically loads winsock on startup if it
1681 is present. Instead, it will be loaded when open-network-stream is
1684 To allow full control over when winsock is loaded, we provide these
1685 two functions to dynamically load and unload winsock. This allows
1686 dial-up users to only be connected when they actually need to use
1690 extern HANDLE winsock_lib
;
1691 extern BOOL
term_winsock (void);
1692 extern BOOL
init_winsock (int load_now
);
1694 extern Lisp_Object Vsystem_name
;
1696 DEFUN ("w32-has-winsock", Fw32_has_winsock
, Sw32_has_winsock
, 0, 1, 0,
1697 doc
: /* Test for presence of the Windows socket library `winsock'.
1698 Returns non-nil if winsock support is present, nil otherwise.
1700 If the optional argument LOAD-NOW is non-nil, the winsock library is
1701 also loaded immediately if not already loaded. If winsock is loaded,
1702 the winsock local hostname is returned (since this may be different from
1703 the value of `system-name' and should supplant it), otherwise t is
1704 returned to indicate winsock support is present. */)
1706 Lisp_Object load_now
;
1710 have_winsock
= init_winsock (!NILP (load_now
));
1713 if (winsock_lib
!= NULL
)
1715 /* Return new value for system-name. The best way to do this
1716 is to call init_system_name, saving and restoring the
1717 original value to avoid side-effects. */
1718 Lisp_Object orig_hostname
= Vsystem_name
;
1719 Lisp_Object hostname
;
1721 init_system_name ();
1722 hostname
= Vsystem_name
;
1723 Vsystem_name
= orig_hostname
;
1731 DEFUN ("w32-unload-winsock", Fw32_unload_winsock
, Sw32_unload_winsock
,
1733 doc
: /* Unload the Windows socket library `winsock' if loaded.
1734 This is provided to allow dial-up socket connections to be disconnected
1735 when no longer needed. Returns nil without unloading winsock if any
1736 socket connections still exist. */)
1739 return term_winsock () ? Qt
: Qnil
;
1742 #endif /* HAVE_SOCKETS */
1745 /* Some miscellaneous functions that are Windows specific, but not GUI
1746 specific (ie. are applicable in terminal or batch mode as well). */
1748 /* lifted from fileio.c */
1749 #define CORRECT_DIR_SEPS(s) \
1750 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
1751 else unixtodos_filename (s); \
1754 DEFUN ("w32-short-file-name", Fw32_short_file_name
, Sw32_short_file_name
, 1, 1, 0,
1755 doc
: /* Return the short file name version (8.3) of the full path of FILENAME.
1756 If FILENAME does not exist, return nil.
1757 All path elements in FILENAME are converted to their short names. */)
1759 Lisp_Object filename
;
1761 char shortname
[MAX_PATH
];
1763 CHECK_STRING (filename
);
1765 /* first expand it. */
1766 filename
= Fexpand_file_name (filename
, Qnil
);
1768 /* luckily, this returns the short version of each element in the path. */
1769 if (GetShortPathName (SDATA (filename
), shortname
, MAX_PATH
) == 0)
1772 CORRECT_DIR_SEPS (shortname
);
1774 return build_string (shortname
);
1778 DEFUN ("w32-long-file-name", Fw32_long_file_name
, Sw32_long_file_name
,
1780 doc
: /* Return the long file name version of the full path of FILENAME.
1781 If FILENAME does not exist, return nil.
1782 All path elements in FILENAME are converted to their long names. */)
1784 Lisp_Object filename
;
1786 char longname
[ MAX_PATH
];
1788 CHECK_STRING (filename
);
1790 /* first expand it. */
1791 filename
= Fexpand_file_name (filename
, Qnil
);
1793 if (!w32_get_long_filename (SDATA (filename
), longname
, MAX_PATH
))
1796 CORRECT_DIR_SEPS (longname
);
1798 return build_string (longname
);
1801 DEFUN ("w32-set-process-priority", Fw32_set_process_priority
,
1802 Sw32_set_process_priority
, 2, 2, 0,
1803 doc
: /* Set the priority of PROCESS to PRIORITY.
1804 If PROCESS is nil, the priority of Emacs is changed, otherwise the
1805 priority of the process whose pid is PROCESS is changed.
1806 PRIORITY should be one of the symbols high, normal, or low;
1807 any other symbol will be interpreted as normal.
1809 If successful, the return value is t, otherwise nil. */)
1811 Lisp_Object process
, priority
;
1813 HANDLE proc_handle
= GetCurrentProcess ();
1814 DWORD priority_class
= NORMAL_PRIORITY_CLASS
;
1815 Lisp_Object result
= Qnil
;
1817 CHECK_SYMBOL (priority
);
1819 if (!NILP (process
))
1824 CHECK_NUMBER (process
);
1826 /* Allow pid to be an internally generated one, or one obtained
1827 externally. This is necessary because real pids on Win95 are
1830 pid
= XINT (process
);
1831 cp
= find_child_pid (pid
);
1833 pid
= cp
->procinfo
.dwProcessId
;
1835 proc_handle
= OpenProcess (PROCESS_SET_INFORMATION
, FALSE
, pid
);
1838 if (EQ (priority
, Qhigh
))
1839 priority_class
= HIGH_PRIORITY_CLASS
;
1840 else if (EQ (priority
, Qlow
))
1841 priority_class
= IDLE_PRIORITY_CLASS
;
1843 if (proc_handle
!= NULL
)
1845 if (SetPriorityClass (proc_handle
, priority_class
))
1847 if (!NILP (process
))
1848 CloseHandle (proc_handle
);
1854 #ifdef HAVE_LANGINFO_CODESET
1855 /* Emulation of nl_langinfo. Used in fns.c:Flocale_info. */
1856 char *nl_langinfo (nl_item item
)
1858 /* Conversion of Posix item numbers to their Windows equivalents. */
1859 static const LCTYPE w32item
[] = {
1860 LOCALE_IDEFAULTANSICODEPAGE
,
1861 LOCALE_SDAYNAME1
, LOCALE_SDAYNAME2
, LOCALE_SDAYNAME3
,
1862 LOCALE_SDAYNAME4
, LOCALE_SDAYNAME5
, LOCALE_SDAYNAME6
, LOCALE_SDAYNAME7
,
1863 LOCALE_SMONTHNAME1
, LOCALE_SMONTHNAME2
, LOCALE_SMONTHNAME3
,
1864 LOCALE_SMONTHNAME4
, LOCALE_SMONTHNAME5
, LOCALE_SMONTHNAME6
,
1865 LOCALE_SMONTHNAME7
, LOCALE_SMONTHNAME8
, LOCALE_SMONTHNAME9
,
1866 LOCALE_SMONTHNAME10
, LOCALE_SMONTHNAME11
, LOCALE_SMONTHNAME12
1869 static char *nl_langinfo_buf
= NULL
;
1870 static int nl_langinfo_len
= 0;
1872 if (nl_langinfo_len
<= 0)
1873 nl_langinfo_buf
= xmalloc (nl_langinfo_len
= 1);
1875 if (item
< 0 || item
>= _NL_NUM
)
1876 nl_langinfo_buf
[0] = 0;
1879 LCID cloc
= GetThreadLocale ();
1880 int need_len
= GetLocaleInfo (cloc
, w32item
[item
] | LOCALE_USE_CP_ACP
,
1884 nl_langinfo_buf
[0] = 0;
1887 if (item
== CODESET
)
1889 need_len
+= 2; /* for the "cp" prefix */
1890 if (need_len
< 8) /* for the case we call GetACP */
1893 if (nl_langinfo_len
<= need_len
)
1894 nl_langinfo_buf
= xrealloc (nl_langinfo_buf
,
1895 nl_langinfo_len
= need_len
);
1896 if (!GetLocaleInfo (cloc
, w32item
[item
] | LOCALE_USE_CP_ACP
,
1897 nl_langinfo_buf
, nl_langinfo_len
))
1898 nl_langinfo_buf
[0] = 0;
1899 else if (item
== CODESET
)
1901 if (strcmp (nl_langinfo_buf
, "0") == 0 /* CP_ACP */
1902 || strcmp (nl_langinfo_buf
, "1") == 0) /* CP_OEMCP */
1903 sprintf (nl_langinfo_buf
, "cp%u", GetACP ());
1906 memmove (nl_langinfo_buf
+ 2, nl_langinfo_buf
,
1907 strlen (nl_langinfo_buf
) + 1);
1908 nl_langinfo_buf
[0] = 'c';
1909 nl_langinfo_buf
[1] = 'p';
1914 return nl_langinfo_buf
;
1916 #endif /* HAVE_LANGINFO_CODESET */
1918 DEFUN ("w32-get-locale-info", Fw32_get_locale_info
,
1919 Sw32_get_locale_info
, 1, 2, 0,
1920 doc
: /* Return information about the Windows locale LCID.
1921 By default, return a three letter locale code which encodes the default
1922 language as the first two characters, and the country or regionial variant
1923 as the third letter. For example, ENU refers to `English (United States)',
1924 while ENC means `English (Canadian)'.
1926 If the optional argument LONGFORM is t, the long form of the locale
1927 name is returned, e.g. `English (United States)' instead; if LONGFORM
1928 is a number, it is interpreted as an LCTYPE constant and the corresponding
1929 locale information is returned.
1931 If LCID (a 16-bit number) is not a valid locale, the result is nil. */)
1933 Lisp_Object lcid
, longform
;
1937 char abbrev_name
[32] = { 0 };
1938 char full_name
[256] = { 0 };
1940 CHECK_NUMBER (lcid
);
1942 if (!IsValidLocale (XINT (lcid
), LCID_SUPPORTED
))
1945 if (NILP (longform
))
1947 got_abbrev
= GetLocaleInfo (XINT (lcid
),
1948 LOCALE_SABBREVLANGNAME
| LOCALE_USE_CP_ACP
,
1949 abbrev_name
, sizeof (abbrev_name
));
1951 return build_string (abbrev_name
);
1953 else if (EQ (longform
, Qt
))
1955 got_full
= GetLocaleInfo (XINT (lcid
),
1956 LOCALE_SLANGUAGE
| LOCALE_USE_CP_ACP
,
1957 full_name
, sizeof (full_name
));
1959 return build_string (full_name
);
1961 else if (NUMBERP (longform
))
1963 got_full
= GetLocaleInfo (XINT (lcid
),
1965 full_name
, sizeof (full_name
));
1967 return make_unibyte_string (full_name
, got_full
);
1974 DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id
,
1975 Sw32_get_current_locale_id
, 0, 0, 0,
1976 doc
: /* Return Windows locale id for current locale setting.
1977 This is a numerical value; use `w32-get-locale-info' to convert to a
1978 human-readable form. */)
1981 return make_number (GetThreadLocale ());
1984 DWORD
int_from_hex (char * s
)
1987 static char hex
[] = "0123456789abcdefABCDEF";
1990 while (*s
&& (p
= strchr(hex
, *s
)) != NULL
)
1992 unsigned digit
= p
- hex
;
1995 val
= val
* 16 + digit
;
2001 /* We need to build a global list, since the EnumSystemLocale callback
2002 function isn't given a context pointer. */
2003 Lisp_Object Vw32_valid_locale_ids
;
2005 BOOL CALLBACK
enum_locale_fn (LPTSTR localeNum
)
2007 DWORD id
= int_from_hex (localeNum
);
2008 Vw32_valid_locale_ids
= Fcons (make_number (id
), Vw32_valid_locale_ids
);
2012 DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids
,
2013 Sw32_get_valid_locale_ids
, 0, 0, 0,
2014 doc
: /* Return list of all valid Windows locale ids.
2015 Each id is a numerical value; use `w32-get-locale-info' to convert to a
2016 human-readable form. */)
2019 Vw32_valid_locale_ids
= Qnil
;
2021 EnumSystemLocales (enum_locale_fn
, LCID_SUPPORTED
);
2023 Vw32_valid_locale_ids
= Fnreverse (Vw32_valid_locale_ids
);
2024 return Vw32_valid_locale_ids
;
2028 DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id
, Sw32_get_default_locale_id
, 0, 1, 0,
2029 doc
: /* Return Windows locale id for default locale setting.
2030 By default, the system default locale setting is returned; if the optional
2031 parameter USERP is non-nil, the user default locale setting is returned.
2032 This is a numerical value; use `w32-get-locale-info' to convert to a
2033 human-readable form. */)
2038 return make_number (GetSystemDefaultLCID ());
2039 return make_number (GetUserDefaultLCID ());
2043 DEFUN ("w32-set-current-locale", Fw32_set_current_locale
, Sw32_set_current_locale
, 1, 1, 0,
2044 doc
: /* Make Windows locale LCID be the current locale setting for Emacs.
2045 If successful, the new locale id is returned, otherwise nil. */)
2049 CHECK_NUMBER (lcid
);
2051 if (!IsValidLocale (XINT (lcid
), LCID_SUPPORTED
))
2054 if (!SetThreadLocale (XINT (lcid
)))
2057 /* Need to set input thread locale if present. */
2058 if (dwWindowsThreadId
)
2059 /* Reply is not needed. */
2060 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_SETLOCALE
, XINT (lcid
), 0);
2062 return make_number (GetThreadLocale ());
2066 /* We need to build a global list, since the EnumCodePages callback
2067 function isn't given a context pointer. */
2068 Lisp_Object Vw32_valid_codepages
;
2070 BOOL CALLBACK
enum_codepage_fn (LPTSTR codepageNum
)
2072 DWORD id
= atoi (codepageNum
);
2073 Vw32_valid_codepages
= Fcons (make_number (id
), Vw32_valid_codepages
);
2077 DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages
,
2078 Sw32_get_valid_codepages
, 0, 0, 0,
2079 doc
: /* Return list of all valid Windows codepages. */)
2082 Vw32_valid_codepages
= Qnil
;
2084 EnumSystemCodePages (enum_codepage_fn
, CP_SUPPORTED
);
2086 Vw32_valid_codepages
= Fnreverse (Vw32_valid_codepages
);
2087 return Vw32_valid_codepages
;
2091 DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage
,
2092 Sw32_get_console_codepage
, 0, 0, 0,
2093 doc
: /* Return current Windows codepage for console input. */)
2096 return make_number (GetConsoleCP ());
2100 DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage
,
2101 Sw32_set_console_codepage
, 1, 1, 0,
2102 doc
: /* Make Windows codepage CP be the current codepage setting for Emacs.
2103 The codepage setting affects keyboard input and display in tty mode.
2104 If successful, the new CP is returned, otherwise nil. */)
2110 if (!IsValidCodePage (XINT (cp
)))
2113 if (!SetConsoleCP (XINT (cp
)))
2116 return make_number (GetConsoleCP ());
2120 DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage
,
2121 Sw32_get_console_output_codepage
, 0, 0, 0,
2122 doc
: /* Return current Windows codepage for console output. */)
2125 return make_number (GetConsoleOutputCP ());
2129 DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage
,
2130 Sw32_set_console_output_codepage
, 1, 1, 0,
2131 doc
: /* Make Windows codepage CP be the current codepage setting for Emacs.
2132 The codepage setting affects keyboard input and display in tty mode.
2133 If successful, the new CP is returned, otherwise nil. */)
2139 if (!IsValidCodePage (XINT (cp
)))
2142 if (!SetConsoleOutputCP (XINT (cp
)))
2145 return make_number (GetConsoleOutputCP ());
2149 DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset
,
2150 Sw32_get_codepage_charset
, 1, 1, 0,
2151 doc
: /* Return charset of codepage CP.
2152 Returns nil if the codepage is not valid. */)
2160 if (!IsValidCodePage (XINT (cp
)))
2163 if (TranslateCharsetInfo ((DWORD
*) XINT (cp
), &info
, TCI_SRCCODEPAGE
))
2164 return make_number (info
.ciCharset
);
2170 DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts
,
2171 Sw32_get_valid_keyboard_layouts
, 0, 0, 0,
2172 doc
: /* Return list of Windows keyboard languages and layouts.
2173 The return value is a list of pairs of language id and layout id. */)
2176 int num_layouts
= GetKeyboardLayoutList (0, NULL
);
2177 HKL
* layouts
= (HKL
*) alloca (num_layouts
* sizeof (HKL
));
2178 Lisp_Object obj
= Qnil
;
2180 if (GetKeyboardLayoutList (num_layouts
, layouts
) == num_layouts
)
2182 while (--num_layouts
>= 0)
2184 DWORD kl
= (DWORD
) layouts
[num_layouts
];
2186 obj
= Fcons (Fcons (make_number (kl
& 0xffff),
2187 make_number ((kl
>> 16) & 0xffff)),
2196 DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout
,
2197 Sw32_get_keyboard_layout
, 0, 0, 0,
2198 doc
: /* Return current Windows keyboard language and layout.
2199 The return value is the cons of the language id and the layout id. */)
2202 DWORD kl
= (DWORD
) GetKeyboardLayout (dwWindowsThreadId
);
2204 return Fcons (make_number (kl
& 0xffff),
2205 make_number ((kl
>> 16) & 0xffff));
2209 DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout
,
2210 Sw32_set_keyboard_layout
, 1, 1, 0,
2211 doc
: /* Make LAYOUT be the current keyboard layout for Emacs.
2212 The keyboard layout setting affects interpretation of keyboard input.
2213 If successful, the new layout id is returned, otherwise nil. */)
2219 CHECK_CONS (layout
);
2220 CHECK_NUMBER_CAR (layout
);
2221 CHECK_NUMBER_CDR (layout
);
2223 kl
= (XINT (XCAR (layout
)) & 0xffff)
2224 | (XINT (XCDR (layout
)) << 16);
2226 /* Synchronize layout with input thread. */
2227 if (dwWindowsThreadId
)
2229 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_SETKEYBOARDLAYOUT
,
2233 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
2235 if (msg
.wParam
== 0)
2239 else if (!ActivateKeyboardLayout ((HKL
) kl
, 0))
2242 return Fw32_get_keyboard_layout ();
2248 Qhigh
= intern ("high");
2249 Qlow
= intern ("low");
2254 defsubr (&Sw32_has_winsock
);
2255 defsubr (&Sw32_unload_winsock
);
2257 defsubr (&Sw32_short_file_name
);
2258 defsubr (&Sw32_long_file_name
);
2259 defsubr (&Sw32_set_process_priority
);
2260 defsubr (&Sw32_get_locale_info
);
2261 defsubr (&Sw32_get_current_locale_id
);
2262 defsubr (&Sw32_get_default_locale_id
);
2263 defsubr (&Sw32_get_valid_locale_ids
);
2264 defsubr (&Sw32_set_current_locale
);
2266 defsubr (&Sw32_get_console_codepage
);
2267 defsubr (&Sw32_set_console_codepage
);
2268 defsubr (&Sw32_get_console_output_codepage
);
2269 defsubr (&Sw32_set_console_output_codepage
);
2270 defsubr (&Sw32_get_valid_codepages
);
2271 defsubr (&Sw32_get_codepage_charset
);
2273 defsubr (&Sw32_get_valid_keyboard_layouts
);
2274 defsubr (&Sw32_get_keyboard_layout
);
2275 defsubr (&Sw32_set_keyboard_layout
);
2277 DEFVAR_LISP ("w32-quote-process-args", &Vw32_quote_process_args
,
2278 doc
: /* Non-nil enables quoting of process arguments to ensure correct parsing.
2279 Because Windows does not directly pass argv arrays to child processes,
2280 programs have to reconstruct the argv array by parsing the command
2281 line string. For an argument to contain a space, it must be enclosed
2282 in double quotes or it will be parsed as multiple arguments.
2284 If the value is a character, that character will be used to escape any
2285 quote characters that appear, otherwise a suitable escape character
2286 will be chosen based on the type of the program. */);
2287 Vw32_quote_process_args
= Qt
;
2289 DEFVAR_LISP ("w32-start-process-show-window",
2290 &Vw32_start_process_show_window
,
2291 doc
: /* When nil, new child processes hide their windows.
2292 When non-nil, they show their window in the method of their choice.
2293 This variable doesn't affect GUI applications, which will never be hidden. */);
2294 Vw32_start_process_show_window
= Qnil
;
2296 DEFVAR_LISP ("w32-start-process-share-console",
2297 &Vw32_start_process_share_console
,
2298 doc
: /* When nil, new child processes are given a new console.
2299 When non-nil, they share the Emacs console; this has the limitation of
2300 allowing only one DOS subprocess to run at a time (whether started directly
2301 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
2302 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
2303 otherwise respond to interrupts from Emacs. */);
2304 Vw32_start_process_share_console
= Qnil
;
2306 DEFVAR_LISP ("w32-start-process-inherit-error-mode",
2307 &Vw32_start_process_inherit_error_mode
,
2308 doc
: /* When nil, new child processes revert to the default error mode.
2309 When non-nil, they inherit their error mode setting from Emacs, which stops
2310 them blocking when trying to access unmounted drives etc. */);
2311 Vw32_start_process_inherit_error_mode
= Qt
;
2313 DEFVAR_INT ("w32-pipe-read-delay", &w32_pipe_read_delay
,
2314 doc
: /* Forced delay before reading subprocess output.
2315 This is done to improve the buffering of subprocess output, by
2316 avoiding the inefficiency of frequently reading small amounts of data.
2318 If positive, the value is the number of milliseconds to sleep before
2319 reading the subprocess output. If negative, the magnitude is the number
2320 of time slices to wait (effectively boosting the priority of the child
2321 process temporarily). A value of zero disables waiting entirely. */);
2322 w32_pipe_read_delay
= 50;
2324 DEFVAR_LISP ("w32-downcase-file-names", &Vw32_downcase_file_names
,
2325 doc
: /* Non-nil means convert all-upper case file names to lower case.
2326 This applies when performing completions and file name expansion.
2327 Note that the value of this setting also affects remote file names,
2328 so you probably don't want to set to non-nil if you use case-sensitive
2329 filesystems via ange-ftp. */);
2330 Vw32_downcase_file_names
= Qnil
;
2333 DEFVAR_LISP ("w32-generate-fake-inodes", &Vw32_generate_fake_inodes
,
2334 doc
: /* Non-nil means attempt to fake realistic inode values.
2335 This works by hashing the truename of files, and should detect
2336 aliasing between long and short (8.3 DOS) names, but can have
2337 false positives because of hash collisions. Note that determing
2338 the truename of a file can be slow. */);
2339 Vw32_generate_fake_inodes
= Qnil
;
2342 DEFVAR_LISP ("w32-get-true-file-attributes", &Vw32_get_true_file_attributes
,
2343 doc
: /* Non-nil means determine accurate link count in `file-attributes'.
2344 Note that this option is only useful for files on NTFS volumes, where hard links
2345 are supported. Moreover, it slows down `file-attributes' noticeably. */);
2346 Vw32_get_true_file_attributes
= Qt
;
2348 staticpro (&Vw32_valid_locale_ids
);
2349 staticpro (&Vw32_valid_codepages
);
2351 /* end of ntproc.c */
2353 /* arch-tag: 23d3a34c-06d2-48a1-833b-ac7609aa5250
2354 (do not change this comment) */