1 /* Process support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1992, 1995, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
3 2006, 2007, 2008, 2009 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 of the License, or
10 (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>. */
21 Drew Bliss Oct 14, 1993
22 Adapted from alarm.c by Tim Fleehart
33 /* must include CRT headers *before* config.h */
47 /* This definition is missing from mingw32 headers. */
48 extern BOOL WINAPI
IsValidLocale(LCID
, DWORD
);
51 #ifdef HAVE_LANGINFO_CODESET
57 #include "character.h"
63 #include "syssignal.h"
65 #include "dispextern.h" /* for xstrcasecmp */
68 #define RVA_TO_PTR(var,section,filedata) \
69 ((void *)((section)->PointerToRawData \
70 + ((DWORD)(var) - (section)->VirtualAddress) \
71 + (filedata).file_base))
73 /* Control whether spawnve quotes arguments as necessary to ensure
74 correct parsing by child process. Because not all uses of spawnve
75 are careful about constructing argv arrays, we make this behavior
76 conditional (off by default). */
77 Lisp_Object Vw32_quote_process_args
;
79 /* Control whether create_child causes the process' window to be
80 hidden. The default is nil. */
81 Lisp_Object Vw32_start_process_show_window
;
83 /* Control whether create_child causes the process to inherit Emacs'
84 console window, or be given a new one of its own. The default is
85 nil, to allow multiple DOS programs to run on Win95. Having separate
86 consoles also allows Emacs to cleanly terminate process groups. */
87 Lisp_Object Vw32_start_process_share_console
;
89 /* Control whether create_child cause the process to inherit Emacs'
90 error mode setting. The default is t, to minimize the possibility of
91 subprocesses blocking when accessing unmounted drives. */
92 Lisp_Object Vw32_start_process_inherit_error_mode
;
94 /* Time to sleep before reading from a subprocess output pipe - this
95 avoids the inefficiency of frequently reading small amounts of data.
96 This is primarily necessary for handling DOS processes on Windows 95,
97 but is useful for W32 processes on both Windows 95 and NT as well. */
98 int w32_pipe_read_delay
;
100 /* Control conversion of upper case file names to lower case.
101 nil means no, t means yes. */
102 Lisp_Object Vw32_downcase_file_names
;
104 /* Control whether stat() attempts to generate fake but hopefully
105 "accurate" inode values, by hashing the absolute truenames of files.
106 This should detect aliasing between long and short names, but still
107 allows the possibility of hash collisions. */
108 Lisp_Object Vw32_generate_fake_inodes
;
110 /* Control whether stat() attempts to determine file type and link count
111 exactly, at the expense of slower operation. Since true hard links
112 are supported on NTFS volumes, this is only relevant on NT. */
113 Lisp_Object Vw32_get_true_file_attributes
;
114 extern Lisp_Object Qlocal
;
116 Lisp_Object Qhigh
, Qlow
;
119 void _DebPrint (const char *fmt
, ...)
124 va_start (args
, fmt
);
125 vsprintf (buf
, fmt
, args
);
127 OutputDebugString (buf
);
131 typedef void (_CALLBACK_
*signal_handler
)(int);
133 /* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */
134 static signal_handler sig_handlers
[NSIG
];
136 /* Fake signal implementation to record the SIGCHLD handler. */
138 sys_signal (int sig
, signal_handler handler
)
147 old
= sig_handlers
[sig
];
148 sig_handlers
[sig
] = handler
;
152 /* Defined in <process.h> which conflicts with the local copy */
155 /* Child process management list. */
156 int child_proc_count
= 0;
157 child_process child_procs
[ MAX_CHILDREN
];
158 child_process
*dead_child
= NULL
;
160 DWORD WINAPI
reader_thread (void *arg
);
162 /* Find an unused process slot. */
169 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
170 if (!CHILD_ACTIVE (cp
))
172 if (child_proc_count
== MAX_CHILDREN
)
174 cp
= &child_procs
[child_proc_count
++];
177 memset (cp
, 0, sizeof(*cp
));
180 cp
->procinfo
.hProcess
= NULL
;
181 cp
->status
= STATUS_READ_ERROR
;
183 /* use manual reset event so that select() will function properly */
184 cp
->char_avail
= CreateEvent (NULL
, TRUE
, FALSE
, NULL
);
187 cp
->char_consumed
= CreateEvent (NULL
, FALSE
, FALSE
, NULL
);
188 if (cp
->char_consumed
)
190 cp
->thrd
= CreateThread (NULL
, 1024, reader_thread
, cp
, 0, &id
);
200 delete_child (child_process
*cp
)
204 /* Should not be deleting a child that is still needed. */
205 for (i
= 0; i
< MAXDESC
; i
++)
206 if (fd_info
[i
].cp
== cp
)
209 if (!CHILD_ACTIVE (cp
))
212 /* reap thread if necessary */
217 if (GetExitCodeThread (cp
->thrd
, &rc
) && rc
== STILL_ACTIVE
)
219 /* let the thread exit cleanly if possible */
220 cp
->status
= STATUS_READ_ERROR
;
221 SetEvent (cp
->char_consumed
);
223 /* We used to forceably terminate the thread here, but it
224 is normally unnecessary, and in abnormal cases, the worst that
225 will happen is we have an extra idle thread hanging around
226 waiting for the zombie process. */
227 if (WaitForSingleObject (cp
->thrd
, 1000) != WAIT_OBJECT_0
)
229 DebPrint (("delete_child.WaitForSingleObject (thread) failed "
230 "with %lu for fd %ld\n", GetLastError (), cp
->fd
));
231 TerminateThread (cp
->thrd
, 0);
235 CloseHandle (cp
->thrd
);
240 CloseHandle (cp
->char_avail
);
241 cp
->char_avail
= NULL
;
243 if (cp
->char_consumed
)
245 CloseHandle (cp
->char_consumed
);
246 cp
->char_consumed
= NULL
;
249 /* update child_proc_count (highest numbered slot in use plus one) */
250 if (cp
== child_procs
+ child_proc_count
- 1)
252 for (i
= child_proc_count
-1; i
>= 0; i
--)
253 if (CHILD_ACTIVE (&child_procs
[i
]))
255 child_proc_count
= i
+ 1;
260 child_proc_count
= 0;
263 /* Find a child by pid. */
264 static child_process
*
265 find_child_pid (DWORD pid
)
269 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
270 if (CHILD_ACTIVE (cp
) && pid
== cp
->pid
)
276 /* Thread proc for child process and socket reader threads. Each thread
277 is normally blocked until woken by select() to check for input by
278 reading one char. When the read completes, char_avail is signaled
279 to wake up the select emulator and the thread blocks itself again. */
281 reader_thread (void *arg
)
286 cp
= (child_process
*)arg
;
288 /* We have to wait for the go-ahead before we can start */
290 || WaitForSingleObject (cp
->char_consumed
, INFINITE
) != WAIT_OBJECT_0
)
297 if (fd_info
[cp
->fd
].flags
& FILE_LISTEN
)
298 rc
= _sys_wait_accept (cp
->fd
);
300 rc
= _sys_read_ahead (cp
->fd
);
302 /* The name char_avail is a misnomer - it really just means the
303 read-ahead has completed, whether successfully or not. */
304 if (!SetEvent (cp
->char_avail
))
306 DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld\n",
307 GetLastError (), cp
->fd
));
311 if (rc
== STATUS_READ_ERROR
)
314 /* If the read died, the child has died so let the thread die */
315 if (rc
== STATUS_READ_FAILED
)
318 /* Wait until our input is acknowledged before reading again */
319 if (WaitForSingleObject (cp
->char_consumed
, INFINITE
) != WAIT_OBJECT_0
)
321 DebPrint (("reader_thread.WaitForSingleObject failed with "
322 "%lu for fd %ld\n", GetLastError (), cp
->fd
));
329 /* To avoid Emacs changing directory, we just record here the directory
330 the new process should start in. This is set just before calling
331 sys_spawnve, and is not generally valid at any other time. */
332 static char * process_dir
;
335 create_child (char *exe
, char *cmdline
, char *env
, int is_gui_app
,
336 int * pPid
, child_process
*cp
)
339 SECURITY_ATTRIBUTES sec_attrs
;
341 SECURITY_DESCRIPTOR sec_desc
;
344 char dir
[ MAXPATHLEN
];
346 if (cp
== NULL
) abort ();
348 memset (&start
, 0, sizeof (start
));
349 start
.cb
= sizeof (start
);
352 if (NILP (Vw32_start_process_show_window
) && !is_gui_app
)
353 start
.dwFlags
= STARTF_USESTDHANDLES
| STARTF_USESHOWWINDOW
;
355 start
.dwFlags
= STARTF_USESTDHANDLES
;
356 start
.wShowWindow
= SW_HIDE
;
358 start
.hStdInput
= GetStdHandle (STD_INPUT_HANDLE
);
359 start
.hStdOutput
= GetStdHandle (STD_OUTPUT_HANDLE
);
360 start
.hStdError
= GetStdHandle (STD_ERROR_HANDLE
);
361 #endif /* HAVE_NTGUI */
364 /* Explicitly specify no security */
365 if (!InitializeSecurityDescriptor (&sec_desc
, SECURITY_DESCRIPTOR_REVISION
))
367 if (!SetSecurityDescriptorDacl (&sec_desc
, TRUE
, NULL
, FALSE
))
370 sec_attrs
.nLength
= sizeof (sec_attrs
);
371 sec_attrs
.lpSecurityDescriptor
= NULL
/* &sec_desc */;
372 sec_attrs
.bInheritHandle
= FALSE
;
374 strcpy (dir
, process_dir
);
375 unixtodos_filename (dir
);
377 flags
= (!NILP (Vw32_start_process_share_console
)
378 ? CREATE_NEW_PROCESS_GROUP
379 : CREATE_NEW_CONSOLE
);
380 if (NILP (Vw32_start_process_inherit_error_mode
))
381 flags
|= CREATE_DEFAULT_ERROR_MODE
;
382 if (!CreateProcess (exe
, cmdline
, &sec_attrs
, NULL
, TRUE
,
383 flags
, env
, dir
, &start
, &cp
->procinfo
))
386 cp
->pid
= (int) cp
->procinfo
.dwProcessId
;
388 /* Hack for Windows 95, which assigns large (ie negative) pids */
392 /* pid must fit in a Lisp_Int */
393 cp
->pid
= cp
->pid
& INTMASK
;
400 DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError()););
404 /* create_child doesn't know what emacs' file handle will be for waiting
405 on output from the child, so we need to make this additional call
406 to register the handle with the process
407 This way the select emulator knows how to match file handles with
408 entries in child_procs. */
410 register_child (int pid
, int fd
)
414 cp
= find_child_pid (pid
);
417 DebPrint (("register_child unable to find pid %lu\n", pid
));
422 DebPrint (("register_child registered fd %d with pid %lu\n", fd
, pid
));
427 /* thread is initially blocked until select is called; set status so
428 that select will release thread */
429 cp
->status
= STATUS_READ_ACKNOWLEDGED
;
431 /* attach child_process to fd_info */
432 if (fd_info
[fd
].cp
!= NULL
)
434 DebPrint (("register_child: fd_info[%d] apparently in use!\n", fd
));
441 /* When a process dies its pipe will break so the reader thread will
442 signal failure to the select emulator.
443 The select emulator then calls this routine to clean up.
444 Since the thread signaled failure we can assume it is exiting. */
446 reap_subprocess (child_process
*cp
)
448 if (cp
->procinfo
.hProcess
)
450 /* Reap the process */
452 /* Process should have already died before we are called. */
453 if (WaitForSingleObject (cp
->procinfo
.hProcess
, 0) != WAIT_OBJECT_0
)
454 DebPrint (("reap_subprocess: child fpr fd %d has not died yet!", cp
->fd
));
456 CloseHandle (cp
->procinfo
.hProcess
);
457 cp
->procinfo
.hProcess
= NULL
;
458 CloseHandle (cp
->procinfo
.hThread
);
459 cp
->procinfo
.hThread
= NULL
;
462 /* For asynchronous children, the child_proc resources will be freed
463 when the last pipe read descriptor is closed; for synchronous
464 children, we must explicitly free the resources now because
465 register_child has not been called. */
470 /* Wait for any of our existing child processes to die
471 When it does, close its handle
472 Return the pid and fill in the status if non-NULL. */
475 sys_wait (int *status
)
477 DWORD active
, retval
;
480 child_process
*cp
, *cps
[MAX_CHILDREN
];
481 HANDLE wait_hnd
[MAX_CHILDREN
];
484 if (dead_child
!= NULL
)
486 /* We want to wait for a specific child */
487 wait_hnd
[nh
] = dead_child
->procinfo
.hProcess
;
488 cps
[nh
] = dead_child
;
489 if (!wait_hnd
[nh
]) abort ();
496 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
497 /* some child_procs might be sockets; ignore them */
498 if (CHILD_ACTIVE (cp
) && cp
->procinfo
.hProcess
499 && (cp
->fd
< 0 || (fd_info
[cp
->fd
].flags
& FILE_AT_EOF
) != 0))
501 wait_hnd
[nh
] = cp
->procinfo
.hProcess
;
509 /* Nothing to wait on, so fail */
516 /* Check for quit about once a second. */
518 active
= WaitForMultipleObjects (nh
, wait_hnd
, FALSE
, 1000);
519 } while (active
== WAIT_TIMEOUT
);
521 if (active
== WAIT_FAILED
)
526 else if (active
>= WAIT_OBJECT_0
527 && active
< WAIT_OBJECT_0
+MAXIMUM_WAIT_OBJECTS
)
529 active
-= WAIT_OBJECT_0
;
531 else if (active
>= WAIT_ABANDONED_0
532 && active
< WAIT_ABANDONED_0
+MAXIMUM_WAIT_OBJECTS
)
534 active
-= WAIT_ABANDONED_0
;
540 if (!GetExitCodeProcess (wait_hnd
[active
], &retval
))
542 DebPrint (("Wait.GetExitCodeProcess failed with %lu\n",
546 if (retval
== STILL_ACTIVE
)
548 /* Should never happen */
549 DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
554 /* Massage the exit code from the process to match the format expected
555 by the WIFSTOPPED et al macros in syswait.h. Only WIFSIGNALED and
556 WIFEXITED are supported; WIFSTOPPED doesn't make sense under NT. */
558 if (retval
== STATUS_CONTROL_C_EXIT
)
566 DebPrint (("Wait signaled with process pid %d\n", cp
->pid
));
573 else if (synch_process_alive
)
575 synch_process_alive
= 0;
577 /* Report the status of the synchronous process. */
578 if (WIFEXITED (retval
))
579 synch_process_retcode
= WRETCODE (retval
);
580 else if (WIFSIGNALED (retval
))
582 int code
= WTERMSIG (retval
);
585 synchronize_system_messages_locale ();
586 signame
= strsignal (code
);
591 synch_process_death
= signame
;
594 reap_subprocess (cp
);
597 reap_subprocess (cp
);
602 /* Old versions of w32api headers don't have separate 32-bit and
603 64-bit defines, but the one they have matches the 32-bit variety. */
604 #ifndef IMAGE_NT_OPTIONAL_HDR32_MAGIC
605 # define IMAGE_NT_OPTIONAL_HDR32_MAGIC IMAGE_NT_OPTIONAL_HDR_MAGIC
606 # define IMAGE_OPTIONAL_HEADER32 IMAGE_OPTIONAL_HEADER
610 w32_executable_type (char * filename
, int * is_dos_app
, int * is_cygnus_app
, int * is_gui_app
)
612 file_data executable
;
615 /* Default values in case we can't tell for sure. */
617 *is_cygnus_app
= FALSE
;
620 if (!open_input_file (&executable
, filename
))
623 p
= strrchr (filename
, '.');
625 /* We can only identify DOS .com programs from the extension. */
626 if (p
&& xstrcasecmp (p
, ".com") == 0)
628 else if (p
&& (xstrcasecmp (p
, ".bat") == 0
629 || xstrcasecmp (p
, ".cmd") == 0))
631 /* A DOS shell script - it appears that CreateProcess is happy to
632 accept this (somewhat surprisingly); presumably it looks at
633 COMSPEC to determine what executable to actually invoke.
634 Therefore, we have to do the same here as well. */
635 /* Actually, I think it uses the program association for that
636 extension, which is defined in the registry. */
637 p
= egetenv ("COMSPEC");
639 w32_executable_type (p
, is_dos_app
, is_cygnus_app
, is_gui_app
);
643 /* Look for DOS .exe signature - if found, we must also check that
644 it isn't really a 16- or 32-bit Windows exe, since both formats
645 start with a DOS program stub. Note that 16-bit Windows
646 executables use the OS/2 1.x format. */
648 IMAGE_DOS_HEADER
* dos_header
;
649 IMAGE_NT_HEADERS
* nt_header
;
651 dos_header
= (PIMAGE_DOS_HEADER
) executable
.file_base
;
652 if (dos_header
->e_magic
!= IMAGE_DOS_SIGNATURE
)
655 nt_header
= (PIMAGE_NT_HEADERS
) ((char *) dos_header
+ dos_header
->e_lfanew
);
657 if ((char *) nt_header
> (char *) dos_header
+ executable
.size
)
659 /* Some dos headers (pkunzip) have bogus e_lfanew fields. */
662 else if (nt_header
->Signature
!= IMAGE_NT_SIGNATURE
663 && LOWORD (nt_header
->Signature
) != IMAGE_OS2_SIGNATURE
)
667 else if (nt_header
->Signature
== IMAGE_NT_SIGNATURE
)
669 IMAGE_DATA_DIRECTORY
*data_dir
= NULL
;
670 if (nt_header
->OptionalHeader
.Magic
== IMAGE_NT_OPTIONAL_HDR32_MAGIC
)
672 /* Ensure we are using the 32 bit structure. */
673 IMAGE_OPTIONAL_HEADER32
*opt
674 = (IMAGE_OPTIONAL_HEADER32
*) &(nt_header
->OptionalHeader
);
675 data_dir
= opt
->DataDirectory
;
676 *is_gui_app
= (opt
->Subsystem
== IMAGE_SUBSYSTEM_WINDOWS_GUI
);
678 /* MingW 3.12 has the required 64 bit structs, but in case older
679 versions don't, only check 64 bit exes if we know how. */
680 #ifdef IMAGE_NT_OPTIONAL_HDR64_MAGIC
681 else if (nt_header
->OptionalHeader
.Magic
682 == IMAGE_NT_OPTIONAL_HDR64_MAGIC
)
684 IMAGE_OPTIONAL_HEADER64
*opt
685 = (IMAGE_OPTIONAL_HEADER64
*) &(nt_header
->OptionalHeader
);
686 data_dir
= opt
->DataDirectory
;
687 *is_gui_app
= (opt
->Subsystem
== IMAGE_SUBSYSTEM_WINDOWS_GUI
);
692 /* Look for cygwin.dll in DLL import list. */
693 IMAGE_DATA_DIRECTORY import_dir
=
694 data_dir
[IMAGE_DIRECTORY_ENTRY_IMPORT
];
695 IMAGE_IMPORT_DESCRIPTOR
* imports
;
696 IMAGE_SECTION_HEADER
* section
;
698 section
= rva_to_section (import_dir
.VirtualAddress
, nt_header
);
699 imports
= RVA_TO_PTR (import_dir
.VirtualAddress
, section
,
702 for ( ; imports
->Name
; imports
++)
704 char * dllname
= RVA_TO_PTR (imports
->Name
, section
,
707 /* The exact name of the cygwin dll has changed with
708 various releases, but hopefully this will be reasonably
710 if (strncmp (dllname
, "cygwin", 6) == 0)
712 *is_cygnus_app
= TRUE
;
721 close_file_data (&executable
);
725 compare_env (const void *strp1
, const void *strp2
)
727 const char *str1
= *(const char **)strp1
, *str2
= *(const char **)strp2
;
729 while (*str1
&& *str2
&& *str1
!= '=' && *str2
!= '=')
731 /* Sort order in command.com/cmd.exe is based on uppercasing
732 names, so do the same here. */
733 if (toupper (*str1
) > toupper (*str2
))
735 else if (toupper (*str1
) < toupper (*str2
))
740 if (*str1
== '=' && *str2
== '=')
742 else if (*str1
== '=')
749 merge_and_sort_env (char **envp1
, char **envp2
, char **new_envp
)
765 qsort (new_envp
, num
, sizeof (char *), compare_env
);
770 /* When a new child process is created we need to register it in our list,
771 so intercept spawn requests. */
773 sys_spawnve (int mode
, char *cmdname
, char **argv
, char **envp
)
775 Lisp_Object program
, full
;
776 char *cmdline
, *env
, *parg
, **targ
;
780 int is_dos_app
, is_cygnus_app
, is_gui_app
;
783 /* We pass our process ID to our children by setting up an environment
784 variable in their environment. */
785 char ppid_env_var_buffer
[64];
786 char *extra_env
[] = {ppid_env_var_buffer
, NULL
};
787 /* These are the characters that cause an argument to need quoting.
788 Arguments with whitespace characters need quoting to prevent the
789 argument being split into two or more. Arguments with wildcards
790 are also quoted, for consistency with posix platforms, where wildcards
791 are not expanded if we run the program directly without a shell.
792 Some extra whitespace characters need quoting in Cygwin programs,
793 so this list is conditionally modified below. */
794 char *sepchars
= " \t*?";
796 /* We don't care about the other modes */
797 if (mode
!= _P_NOWAIT
)
803 /* Handle executable names without an executable suffix. */
804 program
= make_string (cmdname
, strlen (cmdname
));
805 if (NILP (Ffile_executable_p (program
)))
811 openp (Vexec_path
, program
, Vexec_suffixes
, &full
, make_number (X_OK
));
821 /* make sure argv[0] and cmdname are both in DOS format */
822 cmdname
= SDATA (program
);
823 unixtodos_filename (cmdname
);
826 /* Determine whether program is a 16-bit DOS executable, or a w32
827 executable that is implicitly linked to the Cygnus dll (implying it
828 was compiled with the Cygnus GNU toolchain and hence relies on
829 cygwin.dll to parse the command line - we use this to decide how to
830 escape quote chars in command line args that must be quoted).
832 Also determine whether it is a GUI app, so that we don't hide its
833 initial window unless specifically requested. */
834 w32_executable_type (cmdname
, &is_dos_app
, &is_cygnus_app
, &is_gui_app
);
836 /* On Windows 95, if cmdname is a DOS app, we invoke a helper
837 application to start it by specifying the helper app as cmdname,
838 while leaving the real app name as argv[0]. */
841 cmdname
= alloca (MAXPATHLEN
);
842 if (egetenv ("CMDPROXY"))
843 strcpy (cmdname
, egetenv ("CMDPROXY"));
846 strcpy (cmdname
, SDATA (Vinvocation_directory
));
847 strcat (cmdname
, "cmdproxy.exe");
849 unixtodos_filename (cmdname
);
852 /* we have to do some conjuring here to put argv and envp into the
853 form CreateProcess wants... argv needs to be a space separated/null
854 terminated list of parameters, and envp is a null
855 separated/double-null terminated list of parameters.
857 Additionally, zero-length args and args containing whitespace or
858 quote chars need to be wrapped in double quotes - for this to work,
859 embedded quotes need to be escaped as well. The aim is to ensure
860 the child process reconstructs the argv array we start with
861 exactly, so we treat quotes at the beginning and end of arguments
864 The w32 GNU-based library from Cygnus doubles quotes to escape
865 them, while MSVC uses backslash for escaping. (Actually the MSVC
866 startup code does attempt to recognise doubled quotes and accept
867 them, but gets it wrong and ends up requiring three quotes to get a
868 single embedded quote!) So by default we decide whether to use
869 quote or backslash as the escape character based on whether the
870 binary is apparently a Cygnus compiled app.
872 Note that using backslash to escape embedded quotes requires
873 additional special handling if an embedded quote is already
874 preceeded by backslash, or if an arg requiring quoting ends with
875 backslash. In such cases, the run of escape characters needs to be
876 doubled. For consistency, we apply this special handling as long
877 as the escape character is not quote.
879 Since we have no idea how large argv and envp are likely to be we
880 figure out list lengths on the fly and allocate them. */
882 if (!NILP (Vw32_quote_process_args
))
885 /* Override escape char by binding w32-quote-process-args to
886 desired character, or use t for auto-selection. */
887 if (INTEGERP (Vw32_quote_process_args
))
888 escape_char
= XINT (Vw32_quote_process_args
);
890 escape_char
= is_cygnus_app
? '"' : '\\';
893 /* Cygwin apps needs quoting a bit more often */
894 if (escape_char
== '"')
895 sepchars
= "\r\n\t\f '";
904 int escape_char_run
= 0;
910 if (escape_char
== '"' && *p
== '\\')
911 /* If it's a Cygwin app, \ needs to be escaped. */
915 /* allow for embedded quotes to be escaped */
918 /* handle the case where the embedded quote is already escaped */
919 if (escape_char_run
> 0)
921 /* To preserve the arg exactly, we need to double the
922 preceding escape characters (plus adding one to
923 escape the quote character itself). */
924 arglen
+= escape_char_run
;
927 else if (strchr (sepchars
, *p
) != NULL
)
932 if (*p
== escape_char
&& escape_char
!= '"')
940 /* handle the case where the arg ends with an escape char - we
941 must not let the enclosing quote be escaped. */
942 if (escape_char_run
> 0)
943 arglen
+= escape_char_run
;
945 arglen
+= strlen (*targ
++) + 1;
947 cmdline
= alloca (arglen
);
961 if ((strchr (sepchars
, *p
) != NULL
) || *p
== '"')
966 int escape_char_run
= 0;
972 last
= p
+ strlen (p
) - 1;
975 /* This version does not escape quotes if they occur at the
976 beginning or end of the arg - this could lead to incorrect
977 behavior when the arg itself represents a command line
978 containing quoted args. I believe this was originally done
979 as a hack to make some things work, before
980 `w32-quote-process-args' was added. */
983 if (*p
== '"' && p
> first
&& p
< last
)
984 *parg
++ = escape_char
; /* escape embedded quotes */
992 /* double preceding escape chars if any */
993 while (escape_char_run
> 0)
995 *parg
++ = escape_char
;
998 /* escape all quote chars, even at beginning or end */
999 *parg
++ = escape_char
;
1001 else if (escape_char
== '"' && *p
== '\\')
1005 if (*p
== escape_char
&& escape_char
!= '"')
1008 escape_char_run
= 0;
1010 /* double escape chars before enclosing quote */
1011 while (escape_char_run
> 0)
1013 *parg
++ = escape_char
;
1021 strcpy (parg
, *targ
);
1022 parg
+= strlen (*targ
);
1032 numenv
= 1; /* for end null */
1035 arglen
+= strlen (*targ
++) + 1;
1038 /* extra env vars... */
1039 sprintf (ppid_env_var_buffer
, "EM_PARENT_PROCESS_ID=%d",
1040 GetCurrentProcessId ());
1041 arglen
+= strlen (ppid_env_var_buffer
) + 1;
1044 /* merge env passed in and extra env into one, and sort it. */
1045 targ
= (char **) alloca (numenv
* sizeof (char *));
1046 merge_and_sort_env (envp
, extra_env
, targ
);
1048 /* concatenate env entries. */
1049 env
= alloca (arglen
);
1053 strcpy (parg
, *targ
);
1054 parg
+= strlen (*targ
++);
1067 /* Now create the process. */
1068 if (!create_child (cmdname
, cmdline
, env
, is_gui_app
, &pid
, cp
))
1078 /* Emulate the select call
1079 Wait for available input on any of the given rfds, or timeout if
1080 a timeout is given and no input is detected
1081 wfds and efds are not supported and must be NULL.
1083 For simplicity, we detect the death of child processes here and
1084 synchronously call the SIGCHLD handler. Since it is possible for
1085 children to be created without a corresponding pipe handle from which
1086 to read output, we wait separately on the process handles as well as
1087 the char_avail events for each process pipe. We only call
1088 wait/reap_process when the process actually terminates.
1090 To reduce the number of places in which Emacs can be hung such that
1091 C-g is not able to interrupt it, we always wait on interrupt_handle
1092 (which is signaled by the input thread when C-g is detected). If we
1093 detect that we were woken up by C-g, we return -1 with errno set to
1094 EINTR as on Unix. */
1097 extern HANDLE keyboard_handle
;
1099 /* From w32xfns.c */
1100 extern HANDLE interrupt_handle
;
1102 /* From process.c */
1103 extern int proc_buffered_char
[];
1106 sys_select (int nfds
, SELECT_TYPE
*rfds
, SELECT_TYPE
*wfds
, SELECT_TYPE
*efds
,
1107 EMACS_TIME
*timeout
)
1110 DWORD timeout_ms
, start_time
;
1113 child_process
*cp
, *cps
[MAX_CHILDREN
];
1114 HANDLE wait_hnd
[MAXDESC
+ MAX_CHILDREN
];
1115 int fdindex
[MAXDESC
]; /* mapping from wait handles back to descriptors */
1117 timeout_ms
= timeout
? (timeout
->tv_sec
* 1000 + timeout
->tv_usec
/ 1000) : INFINITE
;
1119 /* If the descriptor sets are NULL but timeout isn't, then just Sleep. */
1120 if (rfds
== NULL
&& wfds
== NULL
&& efds
== NULL
&& timeout
!= NULL
)
1126 /* Otherwise, we only handle rfds, so fail otherwise. */
1127 if (rfds
== NULL
|| wfds
!= NULL
|| efds
!= NULL
)
1137 /* Always wait on interrupt_handle, to detect C-g (quit). */
1138 wait_hnd
[0] = interrupt_handle
;
1141 /* Build a list of pipe handles to wait on. */
1143 for (i
= 0; i
< nfds
; i
++)
1144 if (FD_ISSET (i
, &orfds
))
1148 if (keyboard_handle
)
1150 /* Handle stdin specially */
1151 wait_hnd
[nh
] = keyboard_handle
;
1156 /* Check for any emacs-generated input in the queue since
1157 it won't be detected in the wait */
1158 if (detect_input_pending ())
1166 /* Child process and socket input */
1170 int current_status
= cp
->status
;
1172 if (current_status
== STATUS_READ_ACKNOWLEDGED
)
1174 /* Tell reader thread which file handle to use. */
1176 /* Wake up the reader thread for this process */
1177 cp
->status
= STATUS_READ_READY
;
1178 if (!SetEvent (cp
->char_consumed
))
1179 DebPrint (("nt_select.SetEvent failed with "
1180 "%lu for fd %ld\n", GetLastError (), i
));
1183 #ifdef CHECK_INTERLOCK
1184 /* slightly crude cross-checking of interlock between threads */
1186 current_status
= cp
->status
;
1187 if (WaitForSingleObject (cp
->char_avail
, 0) == WAIT_OBJECT_0
)
1189 /* char_avail has been signaled, so status (which may
1190 have changed) should indicate read has completed
1191 but has not been acknowledged. */
1192 current_status
= cp
->status
;
1193 if (current_status
!= STATUS_READ_SUCCEEDED
1194 && current_status
!= STATUS_READ_FAILED
)
1195 DebPrint (("char_avail set, but read not completed: status %d\n",
1200 /* char_avail has not been signaled, so status should
1201 indicate that read is in progress; small possibility
1202 that read has completed but event wasn't yet signaled
1203 when we tested it (because a context switch occurred
1204 or if running on separate CPUs). */
1205 if (current_status
!= STATUS_READ_READY
1206 && current_status
!= STATUS_READ_IN_PROGRESS
1207 && current_status
!= STATUS_READ_SUCCEEDED
1208 && current_status
!= STATUS_READ_FAILED
)
1209 DebPrint (("char_avail reset, but read status is bad: %d\n",
1213 wait_hnd
[nh
] = cp
->char_avail
;
1215 if (!wait_hnd
[nh
]) abort ();
1218 DebPrint (("select waiting on child %d fd %d\n",
1219 cp
-child_procs
, i
));
1224 /* Unable to find something to wait on for this fd, skip */
1226 /* Note that this is not a fatal error, and can in fact
1227 happen in unusual circumstances. Specifically, if
1228 sys_spawnve fails, eg. because the program doesn't
1229 exist, and debug-on-error is t so Fsignal invokes a
1230 nested input loop, then the process output pipe is
1231 still included in input_wait_mask with no child_proc
1232 associated with it. (It is removed when the debugger
1233 exits the nested input loop and the error is thrown.) */
1235 DebPrint (("sys_select: fd %ld is invalid! ignoring\n", i
));
1241 /* Add handles of child processes. */
1243 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
1244 /* Some child_procs might be sockets; ignore them. Also some
1245 children may have died already, but we haven't finished reading
1246 the process output; ignore them too. */
1247 if (CHILD_ACTIVE (cp
) && cp
->procinfo
.hProcess
1249 || (fd_info
[cp
->fd
].flags
& FILE_SEND_SIGCHLD
) == 0
1250 || (fd_info
[cp
->fd
].flags
& FILE_AT_EOF
) != 0)
1253 wait_hnd
[nh
+ nc
] = cp
->procinfo
.hProcess
;
1258 /* Nothing to look for, so we didn't find anything */
1266 start_time
= GetTickCount ();
1268 /* Wait for input or child death to be signaled. If user input is
1269 allowed, then also accept window messages. */
1270 if (FD_ISSET (0, &orfds
))
1271 active
= MsgWaitForMultipleObjects (nh
+ nc
, wait_hnd
, FALSE
, timeout_ms
,
1274 active
= WaitForMultipleObjects (nh
+ nc
, wait_hnd
, FALSE
, timeout_ms
);
1276 if (active
== WAIT_FAILED
)
1278 DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n",
1279 nh
+ nc
, timeout_ms
, GetLastError ()));
1280 /* don't return EBADF - this causes wait_reading_process_output to
1281 abort; WAIT_FAILED is returned when single-stepping under
1282 Windows 95 after switching thread focus in debugger, and
1283 possibly at other times. */
1287 else if (active
== WAIT_TIMEOUT
)
1291 else if (active
>= WAIT_OBJECT_0
1292 && active
< WAIT_OBJECT_0
+MAXIMUM_WAIT_OBJECTS
)
1294 active
-= WAIT_OBJECT_0
;
1296 else if (active
>= WAIT_ABANDONED_0
1297 && active
< WAIT_ABANDONED_0
+MAXIMUM_WAIT_OBJECTS
)
1299 active
-= WAIT_ABANDONED_0
;
1304 /* Loop over all handles after active (now officially documented as
1305 being the first signaled handle in the array). We do this to
1306 ensure fairness, so that all channels with data available will be
1307 processed - otherwise higher numbered channels could be starved. */
1310 if (active
== nh
+ nc
)
1312 /* There are messages in the lisp thread's queue; we must
1313 drain the queue now to ensure they are processed promptly,
1314 because if we don't do so, we will not be woken again until
1315 further messages arrive.
1317 NB. If ever we allow window message procedures to callback
1318 into lisp, we will need to ensure messages are dispatched
1319 at a safe time for lisp code to be run (*), and we may also
1320 want to provide some hooks in the dispatch loop to cater
1321 for modeless dialogs created by lisp (ie. to register
1322 window handles to pass to IsDialogMessage).
1324 (*) Note that MsgWaitForMultipleObjects above is an
1325 internal dispatch point for messages that are sent to
1326 windows created by this thread. */
1327 drain_message_queue ();
1329 else if (active
>= nh
)
1331 cp
= cps
[active
- nh
];
1333 /* We cannot always signal SIGCHLD immediately; if we have not
1334 finished reading the process output, we must delay sending
1335 SIGCHLD until we do. */
1337 if (cp
->fd
>= 0 && (fd_info
[cp
->fd
].flags
& FILE_AT_EOF
) == 0)
1338 fd_info
[cp
->fd
].flags
|= FILE_SEND_SIGCHLD
;
1339 /* SIG_DFL for SIGCHLD is ignore */
1340 else if (sig_handlers
[SIGCHLD
] != SIG_DFL
&&
1341 sig_handlers
[SIGCHLD
] != SIG_IGN
)
1344 DebPrint (("select calling SIGCHLD handler for pid %d\n",
1348 sig_handlers
[SIGCHLD
] (SIGCHLD
);
1352 else if (fdindex
[active
] == -1)
1354 /* Quit (C-g) was detected. */
1358 else if (fdindex
[active
] == 0)
1360 /* Keyboard input available */
1366 /* must be a socket or pipe - read ahead should have
1367 completed, either succeeding or failing. */
1368 FD_SET (fdindex
[active
], rfds
);
1372 /* Even though wait_reading_process_output only reads from at most
1373 one channel, we must process all channels here so that we reap
1374 all children that have died. */
1375 while (++active
< nh
+ nc
)
1376 if (WaitForSingleObject (wait_hnd
[active
], 0) == WAIT_OBJECT_0
)
1378 } while (active
< nh
+ nc
);
1380 /* If no input has arrived and timeout hasn't expired, wait again. */
1383 DWORD elapsed
= GetTickCount () - start_time
;
1385 if (timeout_ms
> elapsed
) /* INFINITE is MAX_UINT */
1387 if (timeout_ms
!= INFINITE
)
1388 timeout_ms
-= elapsed
;
1389 goto count_children
;
1396 /* Substitute for certain kill () operations */
1398 static BOOL CALLBACK
1399 find_child_console (HWND hwnd
, LPARAM arg
)
1401 child_process
* cp
= (child_process
*) arg
;
1405 thread_id
= GetWindowThreadProcessId (hwnd
, &process_id
);
1406 if (process_id
== cp
->procinfo
.dwProcessId
)
1408 char window_class
[32];
1410 GetClassName (hwnd
, window_class
, sizeof (window_class
));
1411 if (strcmp (window_class
,
1412 (os_subtype
== OS_WIN95
)
1414 : "ConsoleWindowClass") == 0)
1425 sys_kill (int pid
, int sig
)
1429 int need_to_free
= 0;
1432 /* Only handle signals that will result in the process dying */
1433 if (sig
!= SIGINT
&& sig
!= SIGKILL
&& sig
!= SIGQUIT
&& sig
!= SIGHUP
)
1439 cp
= find_child_pid (pid
);
1442 proc_hand
= OpenProcess (PROCESS_TERMINATE
, 0, pid
);
1443 if (proc_hand
== NULL
)
1452 proc_hand
= cp
->procinfo
.hProcess
;
1453 pid
= cp
->procinfo
.dwProcessId
;
1455 /* Try to locate console window for process. */
1456 EnumWindows (find_child_console
, (LPARAM
) cp
);
1459 if (sig
== SIGINT
|| sig
== SIGQUIT
)
1461 if (NILP (Vw32_start_process_share_console
) && cp
&& cp
->hwnd
)
1463 BYTE control_scan_code
= (BYTE
) MapVirtualKey (VK_CONTROL
, 0);
1464 /* Fake Ctrl-C for SIGINT, and Ctrl-Break for SIGQUIT. */
1465 BYTE vk_break_code
= (sig
== SIGINT
) ? 'C' : VK_CANCEL
;
1466 BYTE break_scan_code
= (BYTE
) MapVirtualKey (vk_break_code
, 0);
1467 HWND foreground_window
;
1469 if (break_scan_code
== 0)
1471 /* Fake Ctrl-C for SIGQUIT if we can't manage Ctrl-Break. */
1472 vk_break_code
= 'C';
1473 break_scan_code
= (BYTE
) MapVirtualKey (vk_break_code
, 0);
1476 foreground_window
= GetForegroundWindow ();
1477 if (foreground_window
)
1479 /* NT 5.0, and apparently also Windows 98, will not allow
1480 a Window to be set to foreground directly without the
1481 user's involvement. The workaround is to attach
1482 ourselves to the thread that owns the foreground
1483 window, since that is the only thread that can set the
1484 foreground window. */
1485 DWORD foreground_thread
, child_thread
;
1487 GetWindowThreadProcessId (foreground_window
, NULL
);
1488 if (foreground_thread
== GetCurrentThreadId ()
1489 || !AttachThreadInput (GetCurrentThreadId (),
1490 foreground_thread
, TRUE
))
1491 foreground_thread
= 0;
1493 child_thread
= GetWindowThreadProcessId (cp
->hwnd
, NULL
);
1494 if (child_thread
== GetCurrentThreadId ()
1495 || !AttachThreadInput (GetCurrentThreadId (),
1496 child_thread
, TRUE
))
1499 /* Set the foreground window to the child. */
1500 if (SetForegroundWindow (cp
->hwnd
))
1502 /* Generate keystrokes as if user had typed Ctrl-Break or
1504 keybd_event (VK_CONTROL
, control_scan_code
, 0, 0);
1505 keybd_event (vk_break_code
, break_scan_code
,
1506 (vk_break_code
== 'C' ? 0 : KEYEVENTF_EXTENDEDKEY
), 0);
1507 keybd_event (vk_break_code
, break_scan_code
,
1508 (vk_break_code
== 'C' ? 0 : KEYEVENTF_EXTENDEDKEY
)
1509 | KEYEVENTF_KEYUP
, 0);
1510 keybd_event (VK_CONTROL
, control_scan_code
,
1511 KEYEVENTF_KEYUP
, 0);
1513 /* Sleep for a bit to give time for Emacs frame to respond
1514 to focus change events (if Emacs was active app). */
1517 SetForegroundWindow (foreground_window
);
1519 /* Detach from the foreground and child threads now that
1520 the foreground switching is over. */
1521 if (foreground_thread
)
1522 AttachThreadInput (GetCurrentThreadId (),
1523 foreground_thread
, FALSE
);
1525 AttachThreadInput (GetCurrentThreadId (),
1526 child_thread
, FALSE
);
1529 /* Ctrl-Break is NT equivalent of SIGINT. */
1530 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT
, pid
))
1532 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
1533 "for pid %lu\n", GetLastError (), pid
));
1540 if (NILP (Vw32_start_process_share_console
) && cp
&& cp
->hwnd
)
1543 if (os_subtype
== OS_WIN95
)
1546 Another possibility is to try terminating the VDM out-right by
1547 calling the Shell VxD (id 0x17) V86 interface, function #4
1548 "SHELL_Destroy_VM", ie.
1554 First need to determine the current VM handle, and then arrange for
1555 the shellapi call to be made from the system vm (by using
1556 Switch_VM_and_callback).
1558 Could try to invoke DestroyVM through CallVxD.
1562 /* On Win95, posting WM_QUIT causes the 16-bit subsystem
1563 to hang when cmdproxy is used in conjunction with
1564 command.com for an interactive shell. Posting
1565 WM_CLOSE pops up a dialog that, when Yes is selected,
1566 does the same thing. TerminateProcess is also less
1567 than ideal in that subprocesses tend to stick around
1568 until the machine is shutdown, but at least it
1569 doesn't freeze the 16-bit subsystem. */
1570 PostMessage (cp
->hwnd
, WM_QUIT
, 0xff, 0);
1572 if (!TerminateProcess (proc_hand
, 0xff))
1574 DebPrint (("sys_kill.TerminateProcess returned %d "
1575 "for pid %lu\n", GetLastError (), pid
));
1582 PostMessage (cp
->hwnd
, WM_CLOSE
, 0, 0);
1584 /* Kill the process. On W32 this doesn't kill child processes
1585 so it doesn't work very well for shells which is why it's not
1586 used in every case. */
1587 else if (!TerminateProcess (proc_hand
, 0xff))
1589 DebPrint (("sys_kill.TerminateProcess returned %d "
1590 "for pid %lu\n", GetLastError (), pid
));
1597 CloseHandle (proc_hand
);
1602 /* extern int report_file_error (char *, Lisp_Object); */
1604 /* The following two routines are used to manipulate stdin, stdout, and
1605 stderr of our child processes.
1607 Assuming that in, out, and err are *not* inheritable, we make them
1608 stdin, stdout, and stderr of the child as follows:
1610 - Save the parent's current standard handles.
1611 - Set the std handles to inheritable duplicates of the ones being passed in.
1612 (Note that _get_osfhandle() is an io.h procedure that retrieves the
1613 NT file handle for a crt file descriptor.)
1614 - Spawn the child, which inherits in, out, and err as stdin,
1615 stdout, and stderr. (see Spawnve)
1616 - Close the std handles passed to the child.
1617 - Reset the parent's standard handles to the saved handles.
1618 (see reset_standard_handles)
1619 We assume that the caller closes in, out, and err after calling us. */
1622 prepare_standard_handles (int in
, int out
, int err
, HANDLE handles
[3])
1625 HANDLE newstdin
, newstdout
, newstderr
;
1627 parent
= GetCurrentProcess ();
1629 handles
[0] = GetStdHandle (STD_INPUT_HANDLE
);
1630 handles
[1] = GetStdHandle (STD_OUTPUT_HANDLE
);
1631 handles
[2] = GetStdHandle (STD_ERROR_HANDLE
);
1633 /* make inheritable copies of the new handles */
1634 if (!DuplicateHandle (parent
,
1635 (HANDLE
) _get_osfhandle (in
),
1640 DUPLICATE_SAME_ACCESS
))
1641 report_file_error ("Duplicating input handle for child", Qnil
);
1643 if (!DuplicateHandle (parent
,
1644 (HANDLE
) _get_osfhandle (out
),
1649 DUPLICATE_SAME_ACCESS
))
1650 report_file_error ("Duplicating output handle for child", Qnil
);
1652 if (!DuplicateHandle (parent
,
1653 (HANDLE
) _get_osfhandle (err
),
1658 DUPLICATE_SAME_ACCESS
))
1659 report_file_error ("Duplicating error handle for child", Qnil
);
1661 /* and store them as our std handles */
1662 if (!SetStdHandle (STD_INPUT_HANDLE
, newstdin
))
1663 report_file_error ("Changing stdin handle", Qnil
);
1665 if (!SetStdHandle (STD_OUTPUT_HANDLE
, newstdout
))
1666 report_file_error ("Changing stdout handle", Qnil
);
1668 if (!SetStdHandle (STD_ERROR_HANDLE
, newstderr
))
1669 report_file_error ("Changing stderr handle", Qnil
);
1673 reset_standard_handles (int in
, int out
, int err
, HANDLE handles
[3])
1675 /* close the duplicated handles passed to the child */
1676 CloseHandle (GetStdHandle (STD_INPUT_HANDLE
));
1677 CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE
));
1678 CloseHandle (GetStdHandle (STD_ERROR_HANDLE
));
1680 /* now restore parent's saved std handles */
1681 SetStdHandle (STD_INPUT_HANDLE
, handles
[0]);
1682 SetStdHandle (STD_OUTPUT_HANDLE
, handles
[1]);
1683 SetStdHandle (STD_ERROR_HANDLE
, handles
[2]);
1687 set_process_dir (char * dir
)
1694 /* To avoid problems with winsock implementations that work over dial-up
1695 connections causing or requiring a connection to exist while Emacs is
1696 running, Emacs no longer automatically loads winsock on startup if it
1697 is present. Instead, it will be loaded when open-network-stream is
1700 To allow full control over when winsock is loaded, we provide these
1701 two functions to dynamically load and unload winsock. This allows
1702 dial-up users to only be connected when they actually need to use
1706 extern HANDLE winsock_lib
;
1707 extern BOOL
term_winsock (void);
1708 extern BOOL
init_winsock (int load_now
);
1710 extern Lisp_Object Vsystem_name
;
1712 DEFUN ("w32-has-winsock", Fw32_has_winsock
, Sw32_has_winsock
, 0, 1, 0,
1713 doc
: /* Test for presence of the Windows socket library `winsock'.
1714 Returns non-nil if winsock support is present, nil otherwise.
1716 If the optional argument LOAD-NOW is non-nil, the winsock library is
1717 also loaded immediately if not already loaded. If winsock is loaded,
1718 the winsock local hostname is returned (since this may be different from
1719 the value of `system-name' and should supplant it), otherwise t is
1720 returned to indicate winsock support is present. */)
1722 Lisp_Object load_now
;
1726 have_winsock
= init_winsock (!NILP (load_now
));
1729 if (winsock_lib
!= NULL
)
1731 /* Return new value for system-name. The best way to do this
1732 is to call init_system_name, saving and restoring the
1733 original value to avoid side-effects. */
1734 Lisp_Object orig_hostname
= Vsystem_name
;
1735 Lisp_Object hostname
;
1737 init_system_name ();
1738 hostname
= Vsystem_name
;
1739 Vsystem_name
= orig_hostname
;
1747 DEFUN ("w32-unload-winsock", Fw32_unload_winsock
, Sw32_unload_winsock
,
1749 doc
: /* Unload the Windows socket library `winsock' if loaded.
1750 This is provided to allow dial-up socket connections to be disconnected
1751 when no longer needed. Returns nil without unloading winsock if any
1752 socket connections still exist. */)
1755 return term_winsock () ? Qt
: Qnil
;
1758 #endif /* HAVE_SOCKETS */
1761 /* Some miscellaneous functions that are Windows specific, but not GUI
1762 specific (ie. are applicable in terminal or batch mode as well). */
1764 /* lifted from fileio.c */
1765 #define CORRECT_DIR_SEPS(s) \
1766 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
1767 else unixtodos_filename (s); \
1770 DEFUN ("w32-short-file-name", Fw32_short_file_name
, Sw32_short_file_name
, 1, 1, 0,
1771 doc
: /* Return the short file name version (8.3) of the full path of FILENAME.
1772 If FILENAME does not exist, return nil.
1773 All path elements in FILENAME are converted to their short names. */)
1775 Lisp_Object filename
;
1777 char shortname
[MAX_PATH
];
1779 CHECK_STRING (filename
);
1781 /* first expand it. */
1782 filename
= Fexpand_file_name (filename
, Qnil
);
1784 /* luckily, this returns the short version of each element in the path. */
1785 if (GetShortPathName (SDATA (ENCODE_FILE (filename
)), shortname
, MAX_PATH
) == 0)
1788 CORRECT_DIR_SEPS (shortname
);
1790 return build_string (shortname
);
1794 DEFUN ("w32-long-file-name", Fw32_long_file_name
, Sw32_long_file_name
,
1796 doc
: /* Return the long file name version of the full path of FILENAME.
1797 If FILENAME does not exist, return nil.
1798 All path elements in FILENAME are converted to their long names. */)
1800 Lisp_Object filename
;
1802 char longname
[ MAX_PATH
];
1805 CHECK_STRING (filename
);
1807 if (SBYTES (filename
) == 2
1808 && *(SDATA (filename
) + 1) == ':')
1811 /* first expand it. */
1812 filename
= Fexpand_file_name (filename
, Qnil
);
1814 if (!w32_get_long_filename (SDATA (ENCODE_FILE (filename
)), longname
, MAX_PATH
))
1817 CORRECT_DIR_SEPS (longname
);
1819 /* If we were passed only a drive, make sure that a slash is not appended
1820 for consistency with directories. Allow for drive mapping via SUBST
1821 in case expand-file-name is ever changed to expand those. */
1822 if (drive_only
&& longname
[1] == ':' && longname
[2] == '/' && !longname
[3])
1825 return DECODE_FILE (build_string (longname
));
1828 DEFUN ("w32-set-process-priority", Fw32_set_process_priority
,
1829 Sw32_set_process_priority
, 2, 2, 0,
1830 doc
: /* Set the priority of PROCESS to PRIORITY.
1831 If PROCESS is nil, the priority of Emacs is changed, otherwise the
1832 priority of the process whose pid is PROCESS is changed.
1833 PRIORITY should be one of the symbols high, normal, or low;
1834 any other symbol will be interpreted as normal.
1836 If successful, the return value is t, otherwise nil. */)
1838 Lisp_Object process
, priority
;
1840 HANDLE proc_handle
= GetCurrentProcess ();
1841 DWORD priority_class
= NORMAL_PRIORITY_CLASS
;
1842 Lisp_Object result
= Qnil
;
1844 CHECK_SYMBOL (priority
);
1846 if (!NILP (process
))
1851 CHECK_NUMBER (process
);
1853 /* Allow pid to be an internally generated one, or one obtained
1854 externally. This is necessary because real pids on Win95 are
1857 pid
= XINT (process
);
1858 cp
= find_child_pid (pid
);
1860 pid
= cp
->procinfo
.dwProcessId
;
1862 proc_handle
= OpenProcess (PROCESS_SET_INFORMATION
, FALSE
, pid
);
1865 if (EQ (priority
, Qhigh
))
1866 priority_class
= HIGH_PRIORITY_CLASS
;
1867 else if (EQ (priority
, Qlow
))
1868 priority_class
= IDLE_PRIORITY_CLASS
;
1870 if (proc_handle
!= NULL
)
1872 if (SetPriorityClass (proc_handle
, priority_class
))
1874 if (!NILP (process
))
1875 CloseHandle (proc_handle
);
1881 #ifdef HAVE_LANGINFO_CODESET
1882 /* Emulation of nl_langinfo. Used in fns.c:Flocale_info. */
1883 char *nl_langinfo (nl_item item
)
1885 /* Conversion of Posix item numbers to their Windows equivalents. */
1886 static const LCTYPE w32item
[] = {
1887 LOCALE_IDEFAULTANSICODEPAGE
,
1888 LOCALE_SDAYNAME1
, LOCALE_SDAYNAME2
, LOCALE_SDAYNAME3
,
1889 LOCALE_SDAYNAME4
, LOCALE_SDAYNAME5
, LOCALE_SDAYNAME6
, LOCALE_SDAYNAME7
,
1890 LOCALE_SMONTHNAME1
, LOCALE_SMONTHNAME2
, LOCALE_SMONTHNAME3
,
1891 LOCALE_SMONTHNAME4
, LOCALE_SMONTHNAME5
, LOCALE_SMONTHNAME6
,
1892 LOCALE_SMONTHNAME7
, LOCALE_SMONTHNAME8
, LOCALE_SMONTHNAME9
,
1893 LOCALE_SMONTHNAME10
, LOCALE_SMONTHNAME11
, LOCALE_SMONTHNAME12
1896 static char *nl_langinfo_buf
= NULL
;
1897 static int nl_langinfo_len
= 0;
1899 if (nl_langinfo_len
<= 0)
1900 nl_langinfo_buf
= xmalloc (nl_langinfo_len
= 1);
1902 if (item
< 0 || item
>= _NL_NUM
)
1903 nl_langinfo_buf
[0] = 0;
1906 LCID cloc
= GetThreadLocale ();
1907 int need_len
= GetLocaleInfo (cloc
, w32item
[item
] | LOCALE_USE_CP_ACP
,
1911 nl_langinfo_buf
[0] = 0;
1914 if (item
== CODESET
)
1916 need_len
+= 2; /* for the "cp" prefix */
1917 if (need_len
< 8) /* for the case we call GetACP */
1920 if (nl_langinfo_len
<= need_len
)
1921 nl_langinfo_buf
= xrealloc (nl_langinfo_buf
,
1922 nl_langinfo_len
= need_len
);
1923 if (!GetLocaleInfo (cloc
, w32item
[item
] | LOCALE_USE_CP_ACP
,
1924 nl_langinfo_buf
, nl_langinfo_len
))
1925 nl_langinfo_buf
[0] = 0;
1926 else if (item
== CODESET
)
1928 if (strcmp (nl_langinfo_buf
, "0") == 0 /* CP_ACP */
1929 || strcmp (nl_langinfo_buf
, "1") == 0) /* CP_OEMCP */
1930 sprintf (nl_langinfo_buf
, "cp%u", GetACP ());
1933 memmove (nl_langinfo_buf
+ 2, nl_langinfo_buf
,
1934 strlen (nl_langinfo_buf
) + 1);
1935 nl_langinfo_buf
[0] = 'c';
1936 nl_langinfo_buf
[1] = 'p';
1941 return nl_langinfo_buf
;
1943 #endif /* HAVE_LANGINFO_CODESET */
1945 DEFUN ("w32-get-locale-info", Fw32_get_locale_info
,
1946 Sw32_get_locale_info
, 1, 2, 0,
1947 doc
: /* Return information about the Windows locale LCID.
1948 By default, return a three letter locale code which encodes the default
1949 language as the first two characters, and the country or regional variant
1950 as the third letter. For example, ENU refers to `English (United States)',
1951 while ENC means `English (Canadian)'.
1953 If the optional argument LONGFORM is t, the long form of the locale
1954 name is returned, e.g. `English (United States)' instead; if LONGFORM
1955 is a number, it is interpreted as an LCTYPE constant and the corresponding
1956 locale information is returned.
1958 If LCID (a 16-bit number) is not a valid locale, the result is nil. */)
1960 Lisp_Object lcid
, longform
;
1964 char abbrev_name
[32] = { 0 };
1965 char full_name
[256] = { 0 };
1967 CHECK_NUMBER (lcid
);
1969 if (!IsValidLocale (XINT (lcid
), LCID_SUPPORTED
))
1972 if (NILP (longform
))
1974 got_abbrev
= GetLocaleInfo (XINT (lcid
),
1975 LOCALE_SABBREVLANGNAME
| LOCALE_USE_CP_ACP
,
1976 abbrev_name
, sizeof (abbrev_name
));
1978 return build_string (abbrev_name
);
1980 else if (EQ (longform
, Qt
))
1982 got_full
= GetLocaleInfo (XINT (lcid
),
1983 LOCALE_SLANGUAGE
| LOCALE_USE_CP_ACP
,
1984 full_name
, sizeof (full_name
));
1986 return DECODE_SYSTEM (build_string (full_name
));
1988 else if (NUMBERP (longform
))
1990 got_full
= GetLocaleInfo (XINT (lcid
),
1992 full_name
, sizeof (full_name
));
1994 return make_unibyte_string (full_name
, got_full
);
2001 DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id
,
2002 Sw32_get_current_locale_id
, 0, 0, 0,
2003 doc
: /* Return Windows locale id for current locale setting.
2004 This is a numerical value; use `w32-get-locale-info' to convert to a
2005 human-readable form. */)
2008 return make_number (GetThreadLocale ());
2011 DWORD
int_from_hex (char * s
)
2014 static char hex
[] = "0123456789abcdefABCDEF";
2017 while (*s
&& (p
= strchr(hex
, *s
)) != NULL
)
2019 unsigned digit
= p
- hex
;
2022 val
= val
* 16 + digit
;
2028 /* We need to build a global list, since the EnumSystemLocale callback
2029 function isn't given a context pointer. */
2030 Lisp_Object Vw32_valid_locale_ids
;
2032 BOOL CALLBACK
enum_locale_fn (LPTSTR localeNum
)
2034 DWORD id
= int_from_hex (localeNum
);
2035 Vw32_valid_locale_ids
= Fcons (make_number (id
), Vw32_valid_locale_ids
);
2039 DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids
,
2040 Sw32_get_valid_locale_ids
, 0, 0, 0,
2041 doc
: /* Return list of all valid Windows locale ids.
2042 Each id is a numerical value; use `w32-get-locale-info' to convert to a
2043 human-readable form. */)
2046 Vw32_valid_locale_ids
= Qnil
;
2048 EnumSystemLocales (enum_locale_fn
, LCID_SUPPORTED
);
2050 Vw32_valid_locale_ids
= Fnreverse (Vw32_valid_locale_ids
);
2051 return Vw32_valid_locale_ids
;
2055 DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id
, Sw32_get_default_locale_id
, 0, 1, 0,
2056 doc
: /* Return Windows locale id for default locale setting.
2057 By default, the system default locale setting is returned; if the optional
2058 parameter USERP is non-nil, the user default locale setting is returned.
2059 This is a numerical value; use `w32-get-locale-info' to convert to a
2060 human-readable form. */)
2065 return make_number (GetSystemDefaultLCID ());
2066 return make_number (GetUserDefaultLCID ());
2070 DEFUN ("w32-set-current-locale", Fw32_set_current_locale
, Sw32_set_current_locale
, 1, 1, 0,
2071 doc
: /* Make Windows locale LCID be the current locale setting for Emacs.
2072 If successful, the new locale id is returned, otherwise nil. */)
2076 CHECK_NUMBER (lcid
);
2078 if (!IsValidLocale (XINT (lcid
), LCID_SUPPORTED
))
2081 if (!SetThreadLocale (XINT (lcid
)))
2084 /* Need to set input thread locale if present. */
2085 if (dwWindowsThreadId
)
2086 /* Reply is not needed. */
2087 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_SETLOCALE
, XINT (lcid
), 0);
2089 return make_number (GetThreadLocale ());
2093 /* We need to build a global list, since the EnumCodePages callback
2094 function isn't given a context pointer. */
2095 Lisp_Object Vw32_valid_codepages
;
2097 BOOL CALLBACK
enum_codepage_fn (LPTSTR codepageNum
)
2099 DWORD id
= atoi (codepageNum
);
2100 Vw32_valid_codepages
= Fcons (make_number (id
), Vw32_valid_codepages
);
2104 DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages
,
2105 Sw32_get_valid_codepages
, 0, 0, 0,
2106 doc
: /* Return list of all valid Windows codepages. */)
2109 Vw32_valid_codepages
= Qnil
;
2111 EnumSystemCodePages (enum_codepage_fn
, CP_SUPPORTED
);
2113 Vw32_valid_codepages
= Fnreverse (Vw32_valid_codepages
);
2114 return Vw32_valid_codepages
;
2118 DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage
,
2119 Sw32_get_console_codepage
, 0, 0, 0,
2120 doc
: /* Return current Windows codepage for console input. */)
2123 return make_number (GetConsoleCP ());
2127 DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage
,
2128 Sw32_set_console_codepage
, 1, 1, 0,
2129 doc
: /* Make Windows codepage CP be the current codepage setting for Emacs.
2130 The codepage setting affects keyboard input and display in tty mode.
2131 If successful, the new CP is returned, otherwise nil. */)
2137 if (!IsValidCodePage (XINT (cp
)))
2140 if (!SetConsoleCP (XINT (cp
)))
2143 return make_number (GetConsoleCP ());
2147 DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage
,
2148 Sw32_get_console_output_codepage
, 0, 0, 0,
2149 doc
: /* Return current Windows codepage for console output. */)
2152 return make_number (GetConsoleOutputCP ());
2156 DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage
,
2157 Sw32_set_console_output_codepage
, 1, 1, 0,
2158 doc
: /* Make Windows codepage CP be the current codepage setting for Emacs.
2159 The codepage setting affects keyboard input and display in tty mode.
2160 If successful, the new CP is returned, otherwise nil. */)
2166 if (!IsValidCodePage (XINT (cp
)))
2169 if (!SetConsoleOutputCP (XINT (cp
)))
2172 return make_number (GetConsoleOutputCP ());
2176 DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset
,
2177 Sw32_get_codepage_charset
, 1, 1, 0,
2178 doc
: /* Return charset of codepage CP.
2179 Returns nil if the codepage is not valid. */)
2187 if (!IsValidCodePage (XINT (cp
)))
2190 if (TranslateCharsetInfo ((DWORD
*) XINT (cp
), &info
, TCI_SRCCODEPAGE
))
2191 return make_number (info
.ciCharset
);
2197 DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts
,
2198 Sw32_get_valid_keyboard_layouts
, 0, 0, 0,
2199 doc
: /* Return list of Windows keyboard languages and layouts.
2200 The return value is a list of pairs of language id and layout id. */)
2203 int num_layouts
= GetKeyboardLayoutList (0, NULL
);
2204 HKL
* layouts
= (HKL
*) alloca (num_layouts
* sizeof (HKL
));
2205 Lisp_Object obj
= Qnil
;
2207 if (GetKeyboardLayoutList (num_layouts
, layouts
) == num_layouts
)
2209 while (--num_layouts
>= 0)
2211 DWORD kl
= (DWORD
) layouts
[num_layouts
];
2213 obj
= Fcons (Fcons (make_number (kl
& 0xffff),
2214 make_number ((kl
>> 16) & 0xffff)),
2223 DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout
,
2224 Sw32_get_keyboard_layout
, 0, 0, 0,
2225 doc
: /* Return current Windows keyboard language and layout.
2226 The return value is the cons of the language id and the layout id. */)
2229 DWORD kl
= (DWORD
) GetKeyboardLayout (dwWindowsThreadId
);
2231 return Fcons (make_number (kl
& 0xffff),
2232 make_number ((kl
>> 16) & 0xffff));
2236 DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout
,
2237 Sw32_set_keyboard_layout
, 1, 1, 0,
2238 doc
: /* Make LAYOUT be the current keyboard layout for Emacs.
2239 The keyboard layout setting affects interpretation of keyboard input.
2240 If successful, the new layout id is returned, otherwise nil. */)
2246 CHECK_CONS (layout
);
2247 CHECK_NUMBER_CAR (layout
);
2248 CHECK_NUMBER_CDR (layout
);
2250 kl
= (XINT (XCAR (layout
)) & 0xffff)
2251 | (XINT (XCDR (layout
)) << 16);
2253 /* Synchronize layout with input thread. */
2254 if (dwWindowsThreadId
)
2256 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_SETKEYBOARDLAYOUT
,
2260 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
2262 if (msg
.wParam
== 0)
2266 else if (!ActivateKeyboardLayout ((HKL
) kl
, 0))
2269 return Fw32_get_keyboard_layout ();
2275 DEFSYM (Qhigh
, "high");
2276 DEFSYM (Qlow
, "low");
2279 defsubr (&Sw32_has_winsock
);
2280 defsubr (&Sw32_unload_winsock
);
2282 defsubr (&Sw32_short_file_name
);
2283 defsubr (&Sw32_long_file_name
);
2284 defsubr (&Sw32_set_process_priority
);
2285 defsubr (&Sw32_get_locale_info
);
2286 defsubr (&Sw32_get_current_locale_id
);
2287 defsubr (&Sw32_get_default_locale_id
);
2288 defsubr (&Sw32_get_valid_locale_ids
);
2289 defsubr (&Sw32_set_current_locale
);
2291 defsubr (&Sw32_get_console_codepage
);
2292 defsubr (&Sw32_set_console_codepage
);
2293 defsubr (&Sw32_get_console_output_codepage
);
2294 defsubr (&Sw32_set_console_output_codepage
);
2295 defsubr (&Sw32_get_valid_codepages
);
2296 defsubr (&Sw32_get_codepage_charset
);
2298 defsubr (&Sw32_get_valid_keyboard_layouts
);
2299 defsubr (&Sw32_get_keyboard_layout
);
2300 defsubr (&Sw32_set_keyboard_layout
);
2302 DEFVAR_LISP ("w32-quote-process-args", &Vw32_quote_process_args
,
2303 doc
: /* Non-nil enables quoting of process arguments to ensure correct parsing.
2304 Because Windows does not directly pass argv arrays to child processes,
2305 programs have to reconstruct the argv array by parsing the command
2306 line string. For an argument to contain a space, it must be enclosed
2307 in double quotes or it will be parsed as multiple arguments.
2309 If the value is a character, that character will be used to escape any
2310 quote characters that appear, otherwise a suitable escape character
2311 will be chosen based on the type of the program. */);
2312 Vw32_quote_process_args
= Qt
;
2314 DEFVAR_LISP ("w32-start-process-show-window",
2315 &Vw32_start_process_show_window
,
2316 doc
: /* When nil, new child processes hide their windows.
2317 When non-nil, they show their window in the method of their choice.
2318 This variable doesn't affect GUI applications, which will never be hidden. */);
2319 Vw32_start_process_show_window
= Qnil
;
2321 DEFVAR_LISP ("w32-start-process-share-console",
2322 &Vw32_start_process_share_console
,
2323 doc
: /* When nil, new child processes are given a new console.
2324 When non-nil, they share the Emacs console; this has the limitation of
2325 allowing only one DOS subprocess to run at a time (whether started directly
2326 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
2327 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
2328 otherwise respond to interrupts from Emacs. */);
2329 Vw32_start_process_share_console
= Qnil
;
2331 DEFVAR_LISP ("w32-start-process-inherit-error-mode",
2332 &Vw32_start_process_inherit_error_mode
,
2333 doc
: /* When nil, new child processes revert to the default error mode.
2334 When non-nil, they inherit their error mode setting from Emacs, which stops
2335 them blocking when trying to access unmounted drives etc. */);
2336 Vw32_start_process_inherit_error_mode
= Qt
;
2338 DEFVAR_INT ("w32-pipe-read-delay", &w32_pipe_read_delay
,
2339 doc
: /* Forced delay before reading subprocess output.
2340 This is done to improve the buffering of subprocess output, by
2341 avoiding the inefficiency of frequently reading small amounts of data.
2343 If positive, the value is the number of milliseconds to sleep before
2344 reading the subprocess output. If negative, the magnitude is the number
2345 of time slices to wait (effectively boosting the priority of the child
2346 process temporarily). A value of zero disables waiting entirely. */);
2347 w32_pipe_read_delay
= 50;
2349 DEFVAR_LISP ("w32-downcase-file-names", &Vw32_downcase_file_names
,
2350 doc
: /* Non-nil means convert all-upper case file names to lower case.
2351 This applies when performing completions and file name expansion.
2352 Note that the value of this setting also affects remote file names,
2353 so you probably don't want to set to non-nil if you use case-sensitive
2354 filesystems via ange-ftp. */);
2355 Vw32_downcase_file_names
= Qnil
;
2358 DEFVAR_LISP ("w32-generate-fake-inodes", &Vw32_generate_fake_inodes
,
2359 doc
: /* Non-nil means attempt to fake realistic inode values.
2360 This works by hashing the truename of files, and should detect
2361 aliasing between long and short (8.3 DOS) names, but can have
2362 false positives because of hash collisions. Note that determing
2363 the truename of a file can be slow. */);
2364 Vw32_generate_fake_inodes
= Qnil
;
2367 DEFVAR_LISP ("w32-get-true-file-attributes", &Vw32_get_true_file_attributes
,
2368 doc
: /* Non-nil means determine accurate file attributes in `file-attributes'.
2369 This option controls whether to issue additional system calls to determine
2370 accurate link counts, file type, and ownership information. It is more
2371 useful for files on NTFS volumes, where hard links and file security are
2372 supported, than on volumes of the FAT family.
2374 Without these system calls, link count will always be reported as 1 and file
2375 ownership will be attributed to the current user.
2376 The default value `local' means only issue these system calls for files
2377 on local fixed drives. A value of nil means never issue them.
2378 Any other non-nil value means do this even on remote and removable drives
2379 where the performance impact may be noticeable even on modern hardware. */);
2380 Vw32_get_true_file_attributes
= Qlocal
;
2382 staticpro (&Vw32_valid_locale_ids
);
2383 staticpro (&Vw32_valid_codepages
);
2385 /* end of ntproc.c */
2387 /* arch-tag: 23d3a34c-06d2-48a1-833b-ac7609aa5250
2388 (do not change this comment) */