1 /* Process support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1992, 95, 99, 2000, 01, 04 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
19 Boston, MA 02110-1301, USA.
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
);
57 #include "syssignal.h"
60 #define RVA_TO_PTR(var,section,filedata) \
61 ((void *)((section)->PointerToRawData \
62 + ((DWORD)(var) - (section)->VirtualAddress) \
63 + (filedata).file_base))
65 /* Control whether spawnve quotes arguments as necessary to ensure
66 correct parsing by child process. Because not all uses of spawnve
67 are careful about constructing argv arrays, we make this behaviour
68 conditional (off by default). */
69 Lisp_Object Vw32_quote_process_args
;
71 /* Control whether create_child causes the process' window to be
72 hidden. The default is nil. */
73 Lisp_Object Vw32_start_process_show_window
;
75 /* Control whether create_child causes the process to inherit Emacs'
76 console window, or be given a new one of its own. The default is
77 nil, to allow multiple DOS programs to run on Win95. Having separate
78 consoles also allows Emacs to cleanly terminate process groups. */
79 Lisp_Object Vw32_start_process_share_console
;
81 /* Control whether create_child cause the process to inherit Emacs'
82 error mode setting. The default is t, to minimize the possibility of
83 subprocesses blocking when accessing unmounted drives. */
84 Lisp_Object Vw32_start_process_inherit_error_mode
;
86 /* Time to sleep before reading from a subprocess output pipe - this
87 avoids the inefficiency of frequently reading small amounts of data.
88 This is primarily necessary for handling DOS processes on Windows 95,
89 but is useful for W32 processes on both Windows 95 and NT as well. */
90 int w32_pipe_read_delay
;
92 /* Control conversion of upper case file names to lower case.
93 nil means no, t means yes. */
94 Lisp_Object Vw32_downcase_file_names
;
96 /* Control whether stat() attempts to generate fake but hopefully
97 "accurate" inode values, by hashing the absolute truenames of files.
98 This should detect aliasing between long and short names, but still
99 allows the possibility of hash collisions. */
100 Lisp_Object Vw32_generate_fake_inodes
;
102 /* Control whether stat() attempts to determine file type and link count
103 exactly, at the expense of slower operation. Since true hard links
104 are supported on NTFS volumes, this is only relevant on NT. */
105 Lisp_Object Vw32_get_true_file_attributes
;
107 Lisp_Object Qhigh
, Qlow
;
110 void _DebPrint (const char *fmt
, ...)
115 va_start (args
, fmt
);
116 vsprintf (buf
, fmt
, args
);
118 OutputDebugString (buf
);
122 typedef void (_CALLBACK_
*signal_handler
)(int);
124 /* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */
125 static signal_handler sig_handlers
[NSIG
];
127 /* Fake signal implementation to record the SIGCHLD handler. */
129 sys_signal (int sig
, signal_handler handler
)
138 old
= sig_handlers
[sig
];
139 sig_handlers
[sig
] = handler
;
143 /* Defined in <process.h> which conflicts with the local copy */
146 /* Child process management list. */
147 int child_proc_count
= 0;
148 child_process child_procs
[ MAX_CHILDREN
];
149 child_process
*dead_child
= NULL
;
151 DWORD WINAPI
reader_thread (void *arg
);
153 /* Find an unused process slot. */
160 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
161 if (!CHILD_ACTIVE (cp
))
163 if (child_proc_count
== MAX_CHILDREN
)
165 cp
= &child_procs
[child_proc_count
++];
168 memset (cp
, 0, sizeof(*cp
));
171 cp
->procinfo
.hProcess
= NULL
;
172 cp
->status
= STATUS_READ_ERROR
;
174 /* use manual reset event so that select() will function properly */
175 cp
->char_avail
= CreateEvent (NULL
, TRUE
, FALSE
, NULL
);
178 cp
->char_consumed
= CreateEvent (NULL
, FALSE
, FALSE
, NULL
);
179 if (cp
->char_consumed
)
181 cp
->thrd
= CreateThread (NULL
, 1024, reader_thread
, cp
, 0, &id
);
191 delete_child (child_process
*cp
)
195 /* Should not be deleting a child that is still needed. */
196 for (i
= 0; i
< MAXDESC
; i
++)
197 if (fd_info
[i
].cp
== cp
)
200 if (!CHILD_ACTIVE (cp
))
203 /* reap thread if necessary */
208 if (GetExitCodeThread (cp
->thrd
, &rc
) && rc
== STILL_ACTIVE
)
210 /* let the thread exit cleanly if possible */
211 cp
->status
= STATUS_READ_ERROR
;
212 SetEvent (cp
->char_consumed
);
213 if (WaitForSingleObject (cp
->thrd
, 1000) != WAIT_OBJECT_0
)
215 DebPrint (("delete_child.WaitForSingleObject (thread) failed "
216 "with %lu for fd %ld\n", GetLastError (), cp
->fd
));
217 TerminateThread (cp
->thrd
, 0);
220 CloseHandle (cp
->thrd
);
225 CloseHandle (cp
->char_avail
);
226 cp
->char_avail
= NULL
;
228 if (cp
->char_consumed
)
230 CloseHandle (cp
->char_consumed
);
231 cp
->char_consumed
= NULL
;
234 /* update child_proc_count (highest numbered slot in use plus one) */
235 if (cp
== child_procs
+ child_proc_count
- 1)
237 for (i
= child_proc_count
-1; i
>= 0; i
--)
238 if (CHILD_ACTIVE (&child_procs
[i
]))
240 child_proc_count
= i
+ 1;
245 child_proc_count
= 0;
248 /* Find a child by pid. */
249 static child_process
*
250 find_child_pid (DWORD pid
)
254 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
255 if (CHILD_ACTIVE (cp
) && pid
== cp
->pid
)
261 /* Thread proc for child process and socket reader threads. Each thread
262 is normally blocked until woken by select() to check for input by
263 reading one char. When the read completes, char_avail is signalled
264 to wake up the select emulator and the thread blocks itself again. */
266 reader_thread (void *arg
)
271 cp
= (child_process
*)arg
;
273 /* We have to wait for the go-ahead before we can start */
275 || WaitForSingleObject (cp
->char_consumed
, INFINITE
) != WAIT_OBJECT_0
)
282 rc
= _sys_read_ahead (cp
->fd
);
284 /* The name char_avail is a misnomer - it really just means the
285 read-ahead has completed, whether successfully or not. */
286 if (!SetEvent (cp
->char_avail
))
288 DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld\n",
289 GetLastError (), cp
->fd
));
293 if (rc
== STATUS_READ_ERROR
)
296 /* If the read died, the child has died so let the thread die */
297 if (rc
== STATUS_READ_FAILED
)
300 /* Wait until our input is acknowledged before reading again */
301 if (WaitForSingleObject (cp
->char_consumed
, INFINITE
) != WAIT_OBJECT_0
)
303 DebPrint (("reader_thread.WaitForSingleObject failed with "
304 "%lu for fd %ld\n", GetLastError (), cp
->fd
));
311 /* To avoid Emacs changing directory, we just record here the directory
312 the new process should start in. This is set just before calling
313 sys_spawnve, and is not generally valid at any other time. */
314 static char * process_dir
;
317 create_child (char *exe
, char *cmdline
, char *env
, int is_gui_app
,
318 int * pPid
, child_process
*cp
)
321 SECURITY_ATTRIBUTES sec_attrs
;
323 SECURITY_DESCRIPTOR sec_desc
;
326 char dir
[ MAXPATHLEN
];
328 if (cp
== NULL
) abort ();
330 memset (&start
, 0, sizeof (start
));
331 start
.cb
= sizeof (start
);
334 if (NILP (Vw32_start_process_show_window
) && !is_gui_app
)
335 start
.dwFlags
= STARTF_USESTDHANDLES
| STARTF_USESHOWWINDOW
;
337 start
.dwFlags
= STARTF_USESTDHANDLES
;
338 start
.wShowWindow
= SW_HIDE
;
340 start
.hStdInput
= GetStdHandle (STD_INPUT_HANDLE
);
341 start
.hStdOutput
= GetStdHandle (STD_OUTPUT_HANDLE
);
342 start
.hStdError
= GetStdHandle (STD_ERROR_HANDLE
);
343 #endif /* HAVE_NTGUI */
346 /* Explicitly specify no security */
347 if (!InitializeSecurityDescriptor (&sec_desc
, SECURITY_DESCRIPTOR_REVISION
))
349 if (!SetSecurityDescriptorDacl (&sec_desc
, TRUE
, NULL
, FALSE
))
352 sec_attrs
.nLength
= sizeof (sec_attrs
);
353 sec_attrs
.lpSecurityDescriptor
= NULL
/* &sec_desc */;
354 sec_attrs
.bInheritHandle
= FALSE
;
356 strcpy (dir
, process_dir
);
357 unixtodos_filename (dir
);
359 flags
= (!NILP (Vw32_start_process_share_console
)
360 ? CREATE_NEW_PROCESS_GROUP
361 : CREATE_NEW_CONSOLE
);
362 if (NILP (Vw32_start_process_inherit_error_mode
))
363 flags
|= CREATE_DEFAULT_ERROR_MODE
;
364 if (!CreateProcess (exe
, cmdline
, &sec_attrs
, NULL
, TRUE
,
365 flags
, env
, dir
, &start
, &cp
->procinfo
))
368 cp
->pid
= (int) cp
->procinfo
.dwProcessId
;
370 /* Hack for Windows 95, which assigns large (ie negative) pids */
374 /* pid must fit in a Lisp_Int */
375 cp
->pid
= cp
->pid
& INTMASK
;
382 DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError()););
386 /* create_child doesn't know what emacs' file handle will be for waiting
387 on output from the child, so we need to make this additional call
388 to register the handle with the process
389 This way the select emulator knows how to match file handles with
390 entries in child_procs. */
392 register_child (int pid
, int fd
)
396 cp
= find_child_pid (pid
);
399 DebPrint (("register_child unable to find pid %lu\n", pid
));
404 DebPrint (("register_child registered fd %d with pid %lu\n", fd
, pid
));
409 /* thread is initially blocked until select is called; set status so
410 that select will release thread */
411 cp
->status
= STATUS_READ_ACKNOWLEDGED
;
413 /* attach child_process to fd_info */
414 if (fd_info
[fd
].cp
!= NULL
)
416 DebPrint (("register_child: fd_info[%d] apparently in use!\n", fd
));
423 /* When a process dies its pipe will break so the reader thread will
424 signal failure to the select emulator.
425 The select emulator then calls this routine to clean up.
426 Since the thread signaled failure we can assume it is exiting. */
428 reap_subprocess (child_process
*cp
)
430 if (cp
->procinfo
.hProcess
)
432 /* Reap the process */
434 /* Process should have already died before we are called. */
435 if (WaitForSingleObject (cp
->procinfo
.hProcess
, 0) != WAIT_OBJECT_0
)
436 DebPrint (("reap_subprocess: child fpr fd %d has not died yet!", cp
->fd
));
438 CloseHandle (cp
->procinfo
.hProcess
);
439 cp
->procinfo
.hProcess
= NULL
;
440 CloseHandle (cp
->procinfo
.hThread
);
441 cp
->procinfo
.hThread
= NULL
;
444 /* For asynchronous children, the child_proc resources will be freed
445 when the last pipe read descriptor is closed; for synchronous
446 children, we must explicitly free the resources now because
447 register_child has not been called. */
452 /* Wait for any of our existing child processes to die
453 When it does, close its handle
454 Return the pid and fill in the status if non-NULL. */
457 sys_wait (int *status
)
459 DWORD active
, retval
;
462 child_process
*cp
, *cps
[MAX_CHILDREN
];
463 HANDLE wait_hnd
[MAX_CHILDREN
];
466 if (dead_child
!= NULL
)
468 /* We want to wait for a specific child */
469 wait_hnd
[nh
] = dead_child
->procinfo
.hProcess
;
470 cps
[nh
] = dead_child
;
471 if (!wait_hnd
[nh
]) abort ();
478 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
479 /* some child_procs might be sockets; ignore them */
480 if (CHILD_ACTIVE (cp
) && cp
->procinfo
.hProcess
)
482 wait_hnd
[nh
] = cp
->procinfo
.hProcess
;
490 /* Nothing to wait on, so fail */
497 /* Check for quit about once a second. */
499 active
= WaitForMultipleObjects (nh
, wait_hnd
, FALSE
, 1000);
500 } while (active
== WAIT_TIMEOUT
);
502 if (active
== WAIT_FAILED
)
507 else if (active
>= WAIT_OBJECT_0
508 && active
< WAIT_OBJECT_0
+MAXIMUM_WAIT_OBJECTS
)
510 active
-= WAIT_OBJECT_0
;
512 else if (active
>= WAIT_ABANDONED_0
513 && active
< WAIT_ABANDONED_0
+MAXIMUM_WAIT_OBJECTS
)
515 active
-= WAIT_ABANDONED_0
;
521 if (!GetExitCodeProcess (wait_hnd
[active
], &retval
))
523 DebPrint (("Wait.GetExitCodeProcess failed with %lu\n",
527 if (retval
== STILL_ACTIVE
)
529 /* Should never happen */
530 DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
535 /* Massage the exit code from the process to match the format expected
536 by the WIFSTOPPED et al macros in syswait.h. Only WIFSIGNALED and
537 WIFEXITED are supported; WIFSTOPPED doesn't make sense under NT. */
539 if (retval
== STATUS_CONTROL_C_EXIT
)
547 DebPrint (("Wait signaled with process pid %d\n", cp
->pid
));
554 else if (synch_process_alive
)
556 synch_process_alive
= 0;
558 /* Report the status of the synchronous process. */
559 if (WIFEXITED (retval
))
560 synch_process_retcode
= WRETCODE (retval
);
561 else if (WIFSIGNALED (retval
))
563 int code
= WTERMSIG (retval
);
566 synchronize_system_messages_locale ();
567 signame
= strsignal (code
);
572 synch_process_death
= signame
;
575 reap_subprocess (cp
);
578 reap_subprocess (cp
);
584 w32_executable_type (char * filename
, int * is_dos_app
, int * is_cygnus_app
, int * is_gui_app
)
586 file_data executable
;
589 /* Default values in case we can't tell for sure. */
591 *is_cygnus_app
= FALSE
;
594 if (!open_input_file (&executable
, filename
))
597 p
= strrchr (filename
, '.');
599 /* We can only identify DOS .com programs from the extension. */
600 if (p
&& stricmp (p
, ".com") == 0)
602 else if (p
&& (stricmp (p
, ".bat") == 0
603 || stricmp (p
, ".cmd") == 0))
605 /* A DOS shell script - it appears that CreateProcess is happy to
606 accept this (somewhat surprisingly); presumably it looks at
607 COMSPEC to determine what executable to actually invoke.
608 Therefore, we have to do the same here as well. */
609 /* Actually, I think it uses the program association for that
610 extension, which is defined in the registry. */
611 p
= egetenv ("COMSPEC");
613 w32_executable_type (p
, is_dos_app
, is_cygnus_app
, is_gui_app
);
617 /* Look for DOS .exe signature - if found, we must also check that
618 it isn't really a 16- or 32-bit Windows exe, since both formats
619 start with a DOS program stub. Note that 16-bit Windows
620 executables use the OS/2 1.x format. */
622 IMAGE_DOS_HEADER
* dos_header
;
623 IMAGE_NT_HEADERS
* nt_header
;
625 dos_header
= (PIMAGE_DOS_HEADER
) executable
.file_base
;
626 if (dos_header
->e_magic
!= IMAGE_DOS_SIGNATURE
)
629 nt_header
= (PIMAGE_NT_HEADERS
) ((char *) dos_header
+ dos_header
->e_lfanew
);
631 if ((char *) nt_header
> (char *) dos_header
+ executable
.size
)
633 /* Some dos headers (pkunzip) have bogus e_lfanew fields. */
636 else if (nt_header
->Signature
!= IMAGE_NT_SIGNATURE
637 && LOWORD (nt_header
->Signature
) != IMAGE_OS2_SIGNATURE
)
641 else if (nt_header
->Signature
== IMAGE_NT_SIGNATURE
)
643 /* Look for cygwin.dll in DLL import list. */
644 IMAGE_DATA_DIRECTORY import_dir
=
645 nt_header
->OptionalHeader
.DataDirectory
[IMAGE_DIRECTORY_ENTRY_IMPORT
];
646 IMAGE_IMPORT_DESCRIPTOR
* imports
;
647 IMAGE_SECTION_HEADER
* section
;
649 section
= rva_to_section (import_dir
.VirtualAddress
, nt_header
);
650 imports
= RVA_TO_PTR (import_dir
.VirtualAddress
, section
, executable
);
652 for ( ; imports
->Name
; imports
++)
654 char * dllname
= RVA_TO_PTR (imports
->Name
, section
, executable
);
656 /* The exact name of the cygwin dll has changed with
657 various releases, but hopefully this will be reasonably
659 if (strncmp (dllname
, "cygwin", 6) == 0)
661 *is_cygnus_app
= TRUE
;
666 /* Check whether app is marked as a console or windowed (aka
667 GUI) app. Accept Posix and OS2 subsytem apps as console
669 *is_gui_app
= (nt_header
->OptionalHeader
.Subsystem
== IMAGE_SUBSYSTEM_WINDOWS_GUI
);
674 close_file_data (&executable
);
678 compare_env (const void *strp1
, const void *strp2
)
680 const char *str1
= *(const char **)strp1
, *str2
= *(const char **)strp2
;
682 while (*str1
&& *str2
&& *str1
!= '=' && *str2
!= '=')
684 /* Sort order in command.com/cmd.exe is based on uppercasing
685 names, so do the same here. */
686 if (toupper (*str1
) > toupper (*str2
))
688 else if (toupper (*str1
) < toupper (*str2
))
693 if (*str1
== '=' && *str2
== '=')
695 else if (*str1
== '=')
702 merge_and_sort_env (char **envp1
, char **envp2
, char **new_envp
)
718 qsort (new_envp
, num
, sizeof (char *), compare_env
);
723 /* When a new child process is created we need to register it in our list,
724 so intercept spawn requests. */
726 sys_spawnve (int mode
, char *cmdname
, char **argv
, char **envp
)
728 Lisp_Object program
, full
;
729 char *cmdline
, *env
, *parg
, **targ
;
733 int is_dos_app
, is_cygnus_app
, is_gui_app
;
736 /* We pass our process ID to our children by setting up an environment
737 variable in their environment. */
738 char ppid_env_var_buffer
[64];
739 char *extra_env
[] = {ppid_env_var_buffer
, NULL
};
740 char *sepchars
= " \t";
742 /* We don't care about the other modes */
743 if (mode
!= _P_NOWAIT
)
749 /* Handle executable names without an executable suffix. */
750 program
= make_string (cmdname
, strlen (cmdname
));
751 if (NILP (Ffile_executable_p (program
)))
757 openp (Vexec_path
, program
, Vexec_suffixes
, &full
, make_number (X_OK
));
767 /* make sure argv[0] and cmdname are both in DOS format */
768 cmdname
= SDATA (program
);
769 unixtodos_filename (cmdname
);
772 /* Determine whether program is a 16-bit DOS executable, or a w32
773 executable that is implicitly linked to the Cygnus dll (implying it
774 was compiled with the Cygnus GNU toolchain and hence relies on
775 cygwin.dll to parse the command line - we use this to decide how to
776 escape quote chars in command line args that must be quoted).
778 Also determine whether it is a GUI app, so that we don't hide its
779 initial window unless specifically requested. */
780 w32_executable_type (cmdname
, &is_dos_app
, &is_cygnus_app
, &is_gui_app
);
782 /* On Windows 95, if cmdname is a DOS app, we invoke a helper
783 application to start it by specifying the helper app as cmdname,
784 while leaving the real app name as argv[0]. */
787 cmdname
= alloca (MAXPATHLEN
);
788 if (egetenv ("CMDPROXY"))
789 strcpy (cmdname
, egetenv ("CMDPROXY"));
792 strcpy (cmdname
, SDATA (Vinvocation_directory
));
793 strcat (cmdname
, "cmdproxy.exe");
795 unixtodos_filename (cmdname
);
798 /* we have to do some conjuring here to put argv and envp into the
799 form CreateProcess wants... argv needs to be a space separated/null
800 terminated list of parameters, and envp is a null
801 separated/double-null terminated list of parameters.
803 Additionally, zero-length args and args containing whitespace or
804 quote chars need to be wrapped in double quotes - for this to work,
805 embedded quotes need to be escaped as well. The aim is to ensure
806 the child process reconstructs the argv array we start with
807 exactly, so we treat quotes at the beginning and end of arguments
810 The w32 GNU-based library from Cygnus doubles quotes to escape
811 them, while MSVC uses backslash for escaping. (Actually the MSVC
812 startup code does attempt to recognise doubled quotes and accept
813 them, but gets it wrong and ends up requiring three quotes to get a
814 single embedded quote!) So by default we decide whether to use
815 quote or backslash as the escape character based on whether the
816 binary is apparently a Cygnus compiled app.
818 Note that using backslash to escape embedded quotes requires
819 additional special handling if an embedded quote is already
820 preceeded by backslash, or if an arg requiring quoting ends with
821 backslash. In such cases, the run of escape characters needs to be
822 doubled. For consistency, we apply this special handling as long
823 as the escape character is not quote.
825 Since we have no idea how large argv and envp are likely to be we
826 figure out list lengths on the fly and allocate them. */
828 if (!NILP (Vw32_quote_process_args
))
831 /* Override escape char by binding w32-quote-process-args to
832 desired character, or use t for auto-selection. */
833 if (INTEGERP (Vw32_quote_process_args
))
834 escape_char
= XINT (Vw32_quote_process_args
);
836 escape_char
= is_cygnus_app
? '"' : '\\';
839 /* Cygwin apps needs quoting a bit more often */
840 if (escape_char
== '"')
841 sepchars
= "\r\n\t\f '";
850 int escape_char_run
= 0;
856 if (escape_char
== '"' && *p
== '\\')
857 /* If it's a Cygwin app, \ needs to be escaped. */
861 /* allow for embedded quotes to be escaped */
864 /* handle the case where the embedded quote is already escaped */
865 if (escape_char_run
> 0)
867 /* To preserve the arg exactly, we need to double the
868 preceding escape characters (plus adding one to
869 escape the quote character itself). */
870 arglen
+= escape_char_run
;
873 else if (strchr (sepchars
, *p
) != NULL
)
878 if (*p
== escape_char
&& escape_char
!= '"')
886 /* handle the case where the arg ends with an escape char - we
887 must not let the enclosing quote be escaped. */
888 if (escape_char_run
> 0)
889 arglen
+= escape_char_run
;
891 arglen
+= strlen (*targ
++) + 1;
893 cmdline
= alloca (arglen
);
907 if ((strchr (sepchars
, *p
) != NULL
) || *p
== '"')
912 int escape_char_run
= 0;
918 last
= p
+ strlen (p
) - 1;
921 /* This version does not escape quotes if they occur at the
922 beginning or end of the arg - this could lead to incorrect
923 behaviour when the arg itself represents a command line
924 containing quoted args. I believe this was originally done
925 as a hack to make some things work, before
926 `w32-quote-process-args' was added. */
929 if (*p
== '"' && p
> first
&& p
< last
)
930 *parg
++ = escape_char
; /* escape embedded quotes */
938 /* double preceding escape chars if any */
939 while (escape_char_run
> 0)
941 *parg
++ = escape_char
;
944 /* escape all quote chars, even at beginning or end */
945 *parg
++ = escape_char
;
947 else if (escape_char
== '"' && *p
== '\\')
951 if (*p
== escape_char
&& escape_char
!= '"')
956 /* double escape chars before enclosing quote */
957 while (escape_char_run
> 0)
959 *parg
++ = escape_char
;
967 strcpy (parg
, *targ
);
968 parg
+= strlen (*targ
);
978 numenv
= 1; /* for end null */
981 arglen
+= strlen (*targ
++) + 1;
984 /* extra env vars... */
985 sprintf (ppid_env_var_buffer
, "EM_PARENT_PROCESS_ID=%d",
986 GetCurrentProcessId ());
987 arglen
+= strlen (ppid_env_var_buffer
) + 1;
990 /* merge env passed in and extra env into one, and sort it. */
991 targ
= (char **) alloca (numenv
* sizeof (char *));
992 merge_and_sort_env (envp
, extra_env
, targ
);
994 /* concatenate env entries. */
995 env
= alloca (arglen
);
999 strcpy (parg
, *targ
);
1000 parg
+= strlen (*targ
++);
1013 /* Now create the process. */
1014 if (!create_child (cmdname
, cmdline
, env
, is_gui_app
, &pid
, cp
))
1024 /* Emulate the select call
1025 Wait for available input on any of the given rfds, or timeout if
1026 a timeout is given and no input is detected
1027 wfds and efds are not supported and must be NULL.
1029 For simplicity, we detect the death of child processes here and
1030 synchronously call the SIGCHLD handler. Since it is possible for
1031 children to be created without a corresponding pipe handle from which
1032 to read output, we wait separately on the process handles as well as
1033 the char_avail events for each process pipe. We only call
1034 wait/reap_process when the process actually terminates.
1036 To reduce the number of places in which Emacs can be hung such that
1037 C-g is not able to interrupt it, we always wait on interrupt_handle
1038 (which is signalled by the input thread when C-g is detected). If we
1039 detect that we were woken up by C-g, we return -1 with errno set to
1040 EINTR as on Unix. */
1043 extern HANDLE keyboard_handle
;
1045 /* From w32xfns.c */
1046 extern HANDLE interrupt_handle
;
1048 /* From process.c */
1049 extern int proc_buffered_char
[];
1052 sys_select (int nfds
, SELECT_TYPE
*rfds
, SELECT_TYPE
*wfds
, SELECT_TYPE
*efds
,
1053 EMACS_TIME
*timeout
)
1056 DWORD timeout_ms
, start_time
;
1059 child_process
*cp
, *cps
[MAX_CHILDREN
];
1060 HANDLE wait_hnd
[MAXDESC
+ MAX_CHILDREN
];
1061 int fdindex
[MAXDESC
]; /* mapping from wait handles back to descriptors */
1063 timeout_ms
= timeout
? (timeout
->tv_sec
* 1000 + timeout
->tv_usec
/ 1000) : INFINITE
;
1065 /* If the descriptor sets are NULL but timeout isn't, then just Sleep. */
1066 if (rfds
== NULL
&& wfds
== NULL
&& efds
== NULL
&& timeout
!= NULL
)
1072 /* Otherwise, we only handle rfds, so fail otherwise. */
1073 if (rfds
== NULL
|| wfds
!= NULL
|| efds
!= NULL
)
1083 /* Always wait on interrupt_handle, to detect C-g (quit). */
1084 wait_hnd
[0] = interrupt_handle
;
1087 /* Build a list of pipe handles to wait on. */
1089 for (i
= 0; i
< nfds
; i
++)
1090 if (FD_ISSET (i
, &orfds
))
1094 if (keyboard_handle
)
1096 /* Handle stdin specially */
1097 wait_hnd
[nh
] = keyboard_handle
;
1102 /* Check for any emacs-generated input in the queue since
1103 it won't be detected in the wait */
1104 if (detect_input_pending ())
1112 /* Child process and socket input */
1116 int current_status
= cp
->status
;
1118 if (current_status
== STATUS_READ_ACKNOWLEDGED
)
1120 /* Tell reader thread which file handle to use. */
1122 /* Wake up the reader thread for this process */
1123 cp
->status
= STATUS_READ_READY
;
1124 if (!SetEvent (cp
->char_consumed
))
1125 DebPrint (("nt_select.SetEvent failed with "
1126 "%lu for fd %ld\n", GetLastError (), i
));
1129 #ifdef CHECK_INTERLOCK
1130 /* slightly crude cross-checking of interlock between threads */
1132 current_status
= cp
->status
;
1133 if (WaitForSingleObject (cp
->char_avail
, 0) == WAIT_OBJECT_0
)
1135 /* char_avail has been signalled, so status (which may
1136 have changed) should indicate read has completed
1137 but has not been acknowledged. */
1138 current_status
= cp
->status
;
1139 if (current_status
!= STATUS_READ_SUCCEEDED
1140 && current_status
!= STATUS_READ_FAILED
)
1141 DebPrint (("char_avail set, but read not completed: status %d\n",
1146 /* char_avail has not been signalled, so status should
1147 indicate that read is in progress; small possibility
1148 that read has completed but event wasn't yet signalled
1149 when we tested it (because a context switch occurred
1150 or if running on separate CPUs). */
1151 if (current_status
!= STATUS_READ_READY
1152 && current_status
!= STATUS_READ_IN_PROGRESS
1153 && current_status
!= STATUS_READ_SUCCEEDED
1154 && current_status
!= STATUS_READ_FAILED
)
1155 DebPrint (("char_avail reset, but read status is bad: %d\n",
1159 wait_hnd
[nh
] = cp
->char_avail
;
1161 if (!wait_hnd
[nh
]) abort ();
1164 DebPrint (("select waiting on child %d fd %d\n",
1165 cp
-child_procs
, i
));
1170 /* Unable to find something to wait on for this fd, skip */
1172 /* Note that this is not a fatal error, and can in fact
1173 happen in unusual circumstances. Specifically, if
1174 sys_spawnve fails, eg. because the program doesn't
1175 exist, and debug-on-error is t so Fsignal invokes a
1176 nested input loop, then the process output pipe is
1177 still included in input_wait_mask with no child_proc
1178 associated with it. (It is removed when the debugger
1179 exits the nested input loop and the error is thrown.) */
1181 DebPrint (("sys_select: fd %ld is invalid! ignoring\n", i
));
1187 /* Add handles of child processes. */
1189 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
1190 /* Some child_procs might be sockets; ignore them. Also some
1191 children may have died already, but we haven't finished reading
1192 the process output; ignore them too. */
1193 if (CHILD_ACTIVE (cp
) && cp
->procinfo
.hProcess
1195 || (fd_info
[cp
->fd
].flags
& FILE_SEND_SIGCHLD
) == 0
1196 || (fd_info
[cp
->fd
].flags
& FILE_AT_EOF
) != 0)
1199 wait_hnd
[nh
+ nc
] = cp
->procinfo
.hProcess
;
1204 /* Nothing to look for, so we didn't find anything */
1212 start_time
= GetTickCount ();
1214 /* Wait for input or child death to be signalled. If user input is
1215 allowed, then also accept window messages. */
1216 if (FD_ISSET (0, &orfds
))
1217 active
= MsgWaitForMultipleObjects (nh
+ nc
, wait_hnd
, FALSE
, timeout_ms
,
1220 active
= WaitForMultipleObjects (nh
+ nc
, wait_hnd
, FALSE
, timeout_ms
);
1222 if (active
== WAIT_FAILED
)
1224 DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n",
1225 nh
+ nc
, timeout_ms
, GetLastError ()));
1226 /* don't return EBADF - this causes wait_reading_process_output to
1227 abort; WAIT_FAILED is returned when single-stepping under
1228 Windows 95 after switching thread focus in debugger, and
1229 possibly at other times. */
1233 else if (active
== WAIT_TIMEOUT
)
1237 else if (active
>= WAIT_OBJECT_0
1238 && active
< WAIT_OBJECT_0
+MAXIMUM_WAIT_OBJECTS
)
1240 active
-= WAIT_OBJECT_0
;
1242 else if (active
>= WAIT_ABANDONED_0
1243 && active
< WAIT_ABANDONED_0
+MAXIMUM_WAIT_OBJECTS
)
1245 active
-= WAIT_ABANDONED_0
;
1250 /* Loop over all handles after active (now officially documented as
1251 being the first signalled handle in the array). We do this to
1252 ensure fairness, so that all channels with data available will be
1253 processed - otherwise higher numbered channels could be starved. */
1256 if (active
== nh
+ nc
)
1258 /* There are messages in the lisp thread's queue; we must
1259 drain the queue now to ensure they are processed promptly,
1260 because if we don't do so, we will not be woken again until
1261 further messages arrive.
1263 NB. If ever we allow window message procedures to callback
1264 into lisp, we will need to ensure messages are dispatched
1265 at a safe time for lisp code to be run (*), and we may also
1266 want to provide some hooks in the dispatch loop to cater
1267 for modeless dialogs created by lisp (ie. to register
1268 window handles to pass to IsDialogMessage).
1270 (*) Note that MsgWaitForMultipleObjects above is an
1271 internal dispatch point for messages that are sent to
1272 windows created by this thread. */
1273 drain_message_queue ();
1275 else if (active
>= nh
)
1277 cp
= cps
[active
- nh
];
1279 /* We cannot always signal SIGCHLD immediately; if we have not
1280 finished reading the process output, we must delay sending
1281 SIGCHLD until we do. */
1283 if (cp
->fd
>= 0 && (fd_info
[cp
->fd
].flags
& FILE_AT_EOF
) == 0)
1284 fd_info
[cp
->fd
].flags
|= FILE_SEND_SIGCHLD
;
1285 /* SIG_DFL for SIGCHLD is ignore */
1286 else if (sig_handlers
[SIGCHLD
] != SIG_DFL
&&
1287 sig_handlers
[SIGCHLD
] != SIG_IGN
)
1290 DebPrint (("select calling SIGCHLD handler for pid %d\n",
1294 sig_handlers
[SIGCHLD
] (SIGCHLD
);
1298 else if (fdindex
[active
] == -1)
1300 /* Quit (C-g) was detected. */
1304 else if (fdindex
[active
] == 0)
1306 /* Keyboard input available */
1312 /* must be a socket or pipe - read ahead should have
1313 completed, either succeeding or failing. */
1314 FD_SET (fdindex
[active
], rfds
);
1318 /* Even though wait_reading_process_output only reads from at most
1319 one channel, we must process all channels here so that we reap
1320 all children that have died. */
1321 while (++active
< nh
+ nc
)
1322 if (WaitForSingleObject (wait_hnd
[active
], 0) == WAIT_OBJECT_0
)
1324 } while (active
< nh
+ nc
);
1326 /* If no input has arrived and timeout hasn't expired, wait again. */
1329 DWORD elapsed
= GetTickCount () - start_time
;
1331 if (timeout_ms
> elapsed
) /* INFINITE is MAX_UINT */
1333 if (timeout_ms
!= INFINITE
)
1334 timeout_ms
-= elapsed
;
1335 goto count_children
;
1342 /* Substitute for certain kill () operations */
1344 static BOOL CALLBACK
1345 find_child_console (HWND hwnd
, LPARAM arg
)
1347 child_process
* cp
= (child_process
*) arg
;
1351 thread_id
= GetWindowThreadProcessId (hwnd
, &process_id
);
1352 if (process_id
== cp
->procinfo
.dwProcessId
)
1354 char window_class
[32];
1356 GetClassName (hwnd
, window_class
, sizeof (window_class
));
1357 if (strcmp (window_class
,
1358 (os_subtype
== OS_WIN95
)
1360 : "ConsoleWindowClass") == 0)
1371 sys_kill (int pid
, int sig
)
1375 int need_to_free
= 0;
1378 /* Only handle signals that will result in the process dying */
1379 if (sig
!= SIGINT
&& sig
!= SIGKILL
&& sig
!= SIGQUIT
&& sig
!= SIGHUP
)
1385 cp
= find_child_pid (pid
);
1388 proc_hand
= OpenProcess (PROCESS_TERMINATE
, 0, pid
);
1389 if (proc_hand
== NULL
)
1398 proc_hand
= cp
->procinfo
.hProcess
;
1399 pid
= cp
->procinfo
.dwProcessId
;
1401 /* Try to locate console window for process. */
1402 EnumWindows (find_child_console
, (LPARAM
) cp
);
1405 if (sig
== SIGINT
|| sig
== SIGQUIT
)
1407 if (NILP (Vw32_start_process_share_console
) && cp
&& cp
->hwnd
)
1409 BYTE control_scan_code
= (BYTE
) MapVirtualKey (VK_CONTROL
, 0);
1410 /* Fake Ctrl-C for SIGINT, and Ctrl-Break for SIGQUIT. */
1411 BYTE vk_break_code
= (sig
== SIGINT
) ? 'C' : VK_CANCEL
;
1412 BYTE break_scan_code
= (BYTE
) MapVirtualKey (vk_break_code
, 0);
1413 HWND foreground_window
;
1415 if (break_scan_code
== 0)
1417 /* Fake Ctrl-C for SIGQUIT if we can't manage Ctrl-Break. */
1418 vk_break_code
= 'C';
1419 break_scan_code
= (BYTE
) MapVirtualKey (vk_break_code
, 0);
1422 foreground_window
= GetForegroundWindow ();
1423 if (foreground_window
)
1425 /* NT 5.0, and apparently also Windows 98, will not allow
1426 a Window to be set to foreground directly without the
1427 user's involvement. The workaround is to attach
1428 ourselves to the thread that owns the foreground
1429 window, since that is the only thread that can set the
1430 foreground window. */
1431 DWORD foreground_thread
, child_thread
;
1433 GetWindowThreadProcessId (foreground_window
, NULL
);
1434 if (foreground_thread
== GetCurrentThreadId ()
1435 || !AttachThreadInput (GetCurrentThreadId (),
1436 foreground_thread
, TRUE
))
1437 foreground_thread
= 0;
1439 child_thread
= GetWindowThreadProcessId (cp
->hwnd
, NULL
);
1440 if (child_thread
== GetCurrentThreadId ()
1441 || !AttachThreadInput (GetCurrentThreadId (),
1442 child_thread
, TRUE
))
1445 /* Set the foreground window to the child. */
1446 if (SetForegroundWindow (cp
->hwnd
))
1448 /* Generate keystrokes as if user had typed Ctrl-Break or
1450 keybd_event (VK_CONTROL
, control_scan_code
, 0, 0);
1451 keybd_event (vk_break_code
, break_scan_code
,
1452 (vk_break_code
== 'C' ? 0 : KEYEVENTF_EXTENDEDKEY
), 0);
1453 keybd_event (vk_break_code
, break_scan_code
,
1454 (vk_break_code
== 'C' ? 0 : KEYEVENTF_EXTENDEDKEY
)
1455 | KEYEVENTF_KEYUP
, 0);
1456 keybd_event (VK_CONTROL
, control_scan_code
,
1457 KEYEVENTF_KEYUP
, 0);
1459 /* Sleep for a bit to give time for Emacs frame to respond
1460 to focus change events (if Emacs was active app). */
1463 SetForegroundWindow (foreground_window
);
1465 /* Detach from the foreground and child threads now that
1466 the foreground switching is over. */
1467 if (foreground_thread
)
1468 AttachThreadInput (GetCurrentThreadId (),
1469 foreground_thread
, FALSE
);
1471 AttachThreadInput (GetCurrentThreadId (),
1472 child_thread
, FALSE
);
1475 /* Ctrl-Break is NT equivalent of SIGINT. */
1476 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT
, pid
))
1478 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
1479 "for pid %lu\n", GetLastError (), pid
));
1486 if (NILP (Vw32_start_process_share_console
) && cp
&& cp
->hwnd
)
1489 if (os_subtype
== OS_WIN95
)
1492 Another possibility is to try terminating the VDM out-right by
1493 calling the Shell VxD (id 0x17) V86 interface, function #4
1494 "SHELL_Destroy_VM", ie.
1500 First need to determine the current VM handle, and then arrange for
1501 the shellapi call to be made from the system vm (by using
1502 Switch_VM_and_callback).
1504 Could try to invoke DestroyVM through CallVxD.
1508 /* On Win95, posting WM_QUIT causes the 16-bit subsystem
1509 to hang when cmdproxy is used in conjunction with
1510 command.com for an interactive shell. Posting
1511 WM_CLOSE pops up a dialog that, when Yes is selected,
1512 does the same thing. TerminateProcess is also less
1513 than ideal in that subprocesses tend to stick around
1514 until the machine is shutdown, but at least it
1515 doesn't freeze the 16-bit subsystem. */
1516 PostMessage (cp
->hwnd
, WM_QUIT
, 0xff, 0);
1518 if (!TerminateProcess (proc_hand
, 0xff))
1520 DebPrint (("sys_kill.TerminateProcess returned %d "
1521 "for pid %lu\n", GetLastError (), pid
));
1528 PostMessage (cp
->hwnd
, WM_CLOSE
, 0, 0);
1530 /* Kill the process. On W32 this doesn't kill child processes
1531 so it doesn't work very well for shells which is why it's not
1532 used in every case. */
1533 else if (!TerminateProcess (proc_hand
, 0xff))
1535 DebPrint (("sys_kill.TerminateProcess returned %d "
1536 "for pid %lu\n", GetLastError (), pid
));
1543 CloseHandle (proc_hand
);
1548 /* extern int report_file_error (char *, Lisp_Object); */
1550 /* The following two routines are used to manipulate stdin, stdout, and
1551 stderr of our child processes.
1553 Assuming that in, out, and err are *not* inheritable, we make them
1554 stdin, stdout, and stderr of the child as follows:
1556 - Save the parent's current standard handles.
1557 - Set the std handles to inheritable duplicates of the ones being passed in.
1558 (Note that _get_osfhandle() is an io.h procedure that retrieves the
1559 NT file handle for a crt file descriptor.)
1560 - Spawn the child, which inherits in, out, and err as stdin,
1561 stdout, and stderr. (see Spawnve)
1562 - Close the std handles passed to the child.
1563 - Reset the parent's standard handles to the saved handles.
1564 (see reset_standard_handles)
1565 We assume that the caller closes in, out, and err after calling us. */
1568 prepare_standard_handles (int in
, int out
, int err
, HANDLE handles
[3])
1571 HANDLE newstdin
, newstdout
, newstderr
;
1573 parent
= GetCurrentProcess ();
1575 handles
[0] = GetStdHandle (STD_INPUT_HANDLE
);
1576 handles
[1] = GetStdHandle (STD_OUTPUT_HANDLE
);
1577 handles
[2] = GetStdHandle (STD_ERROR_HANDLE
);
1579 /* make inheritable copies of the new handles */
1580 if (!DuplicateHandle (parent
,
1581 (HANDLE
) _get_osfhandle (in
),
1586 DUPLICATE_SAME_ACCESS
))
1587 report_file_error ("Duplicating input handle for child", Qnil
);
1589 if (!DuplicateHandle (parent
,
1590 (HANDLE
) _get_osfhandle (out
),
1595 DUPLICATE_SAME_ACCESS
))
1596 report_file_error ("Duplicating output handle for child", Qnil
);
1598 if (!DuplicateHandle (parent
,
1599 (HANDLE
) _get_osfhandle (err
),
1604 DUPLICATE_SAME_ACCESS
))
1605 report_file_error ("Duplicating error handle for child", Qnil
);
1607 /* and store them as our std handles */
1608 if (!SetStdHandle (STD_INPUT_HANDLE
, newstdin
))
1609 report_file_error ("Changing stdin handle", Qnil
);
1611 if (!SetStdHandle (STD_OUTPUT_HANDLE
, newstdout
))
1612 report_file_error ("Changing stdout handle", Qnil
);
1614 if (!SetStdHandle (STD_ERROR_HANDLE
, newstderr
))
1615 report_file_error ("Changing stderr handle", Qnil
);
1619 reset_standard_handles (int in
, int out
, int err
, HANDLE handles
[3])
1621 /* close the duplicated handles passed to the child */
1622 CloseHandle (GetStdHandle (STD_INPUT_HANDLE
));
1623 CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE
));
1624 CloseHandle (GetStdHandle (STD_ERROR_HANDLE
));
1626 /* now restore parent's saved std handles */
1627 SetStdHandle (STD_INPUT_HANDLE
, handles
[0]);
1628 SetStdHandle (STD_OUTPUT_HANDLE
, handles
[1]);
1629 SetStdHandle (STD_ERROR_HANDLE
, handles
[2]);
1633 set_process_dir (char * dir
)
1640 /* To avoid problems with winsock implementations that work over dial-up
1641 connections causing or requiring a connection to exist while Emacs is
1642 running, Emacs no longer automatically loads winsock on startup if it
1643 is present. Instead, it will be loaded when open-network-stream is
1646 To allow full control over when winsock is loaded, we provide these
1647 two functions to dynamically load and unload winsock. This allows
1648 dial-up users to only be connected when they actually need to use
1652 extern HANDLE winsock_lib
;
1653 extern BOOL
term_winsock (void);
1654 extern BOOL
init_winsock (int load_now
);
1656 extern Lisp_Object Vsystem_name
;
1658 DEFUN ("w32-has-winsock", Fw32_has_winsock
, Sw32_has_winsock
, 0, 1, 0,
1659 doc
: /* Test for presence of the Windows socket library `winsock'.
1660 Returns non-nil if winsock support is present, nil otherwise.
1662 If the optional argument LOAD-NOW is non-nil, the winsock library is
1663 also loaded immediately if not already loaded. If winsock is loaded,
1664 the winsock local hostname is returned (since this may be different from
1665 the value of `system-name' and should supplant it), otherwise t is
1666 returned to indicate winsock support is present. */)
1668 Lisp_Object load_now
;
1672 have_winsock
= init_winsock (!NILP (load_now
));
1675 if (winsock_lib
!= NULL
)
1677 /* Return new value for system-name. The best way to do this
1678 is to call init_system_name, saving and restoring the
1679 original value to avoid side-effects. */
1680 Lisp_Object orig_hostname
= Vsystem_name
;
1681 Lisp_Object hostname
;
1683 init_system_name ();
1684 hostname
= Vsystem_name
;
1685 Vsystem_name
= orig_hostname
;
1693 DEFUN ("w32-unload-winsock", Fw32_unload_winsock
, Sw32_unload_winsock
,
1695 doc
: /* Unload the Windows socket library `winsock' if loaded.
1696 This is provided to allow dial-up socket connections to be disconnected
1697 when no longer needed. Returns nil without unloading winsock if any
1698 socket connections still exist. */)
1701 return term_winsock () ? Qt
: Qnil
;
1704 #endif /* HAVE_SOCKETS */
1707 /* Some miscellaneous functions that are Windows specific, but not GUI
1708 specific (ie. are applicable in terminal or batch mode as well). */
1710 /* lifted from fileio.c */
1711 #define CORRECT_DIR_SEPS(s) \
1712 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
1713 else unixtodos_filename (s); \
1716 DEFUN ("w32-short-file-name", Fw32_short_file_name
, Sw32_short_file_name
, 1, 1, 0,
1717 doc
: /* Return the short file name version (8.3) of the full path of FILENAME.
1718 If FILENAME does not exist, return nil.
1719 All path elements in FILENAME are converted to their short names. */)
1721 Lisp_Object filename
;
1723 char shortname
[MAX_PATH
];
1725 CHECK_STRING (filename
);
1727 /* first expand it. */
1728 filename
= Fexpand_file_name (filename
, Qnil
);
1730 /* luckily, this returns the short version of each element in the path. */
1731 if (GetShortPathName (SDATA (filename
), shortname
, MAX_PATH
) == 0)
1734 CORRECT_DIR_SEPS (shortname
);
1736 return build_string (shortname
);
1740 DEFUN ("w32-long-file-name", Fw32_long_file_name
, Sw32_long_file_name
,
1742 doc
: /* Return the long file name version of the full path of FILENAME.
1743 If FILENAME does not exist, return nil.
1744 All path elements in FILENAME are converted to their long names. */)
1746 Lisp_Object filename
;
1748 char longname
[ MAX_PATH
];
1750 CHECK_STRING (filename
);
1752 /* first expand it. */
1753 filename
= Fexpand_file_name (filename
, Qnil
);
1755 if (!w32_get_long_filename (SDATA (filename
), longname
, MAX_PATH
))
1758 CORRECT_DIR_SEPS (longname
);
1760 return build_string (longname
);
1763 DEFUN ("w32-set-process-priority", Fw32_set_process_priority
,
1764 Sw32_set_process_priority
, 2, 2, 0,
1765 doc
: /* Set the priority of PROCESS to PRIORITY.
1766 If PROCESS is nil, the priority of Emacs is changed, otherwise the
1767 priority of the process whose pid is PROCESS is changed.
1768 PRIORITY should be one of the symbols high, normal, or low;
1769 any other symbol will be interpreted as normal.
1771 If successful, the return value is t, otherwise nil. */)
1773 Lisp_Object process
, priority
;
1775 HANDLE proc_handle
= GetCurrentProcess ();
1776 DWORD priority_class
= NORMAL_PRIORITY_CLASS
;
1777 Lisp_Object result
= Qnil
;
1779 CHECK_SYMBOL (priority
);
1781 if (!NILP (process
))
1786 CHECK_NUMBER (process
);
1788 /* Allow pid to be an internally generated one, or one obtained
1789 externally. This is necessary because real pids on Win95 are
1792 pid
= XINT (process
);
1793 cp
= find_child_pid (pid
);
1795 pid
= cp
->procinfo
.dwProcessId
;
1797 proc_handle
= OpenProcess (PROCESS_SET_INFORMATION
, FALSE
, pid
);
1800 if (EQ (priority
, Qhigh
))
1801 priority_class
= HIGH_PRIORITY_CLASS
;
1802 else if (EQ (priority
, Qlow
))
1803 priority_class
= IDLE_PRIORITY_CLASS
;
1805 if (proc_handle
!= NULL
)
1807 if (SetPriorityClass (proc_handle
, priority_class
))
1809 if (!NILP (process
))
1810 CloseHandle (proc_handle
);
1817 DEFUN ("w32-get-locale-info", Fw32_get_locale_info
,
1818 Sw32_get_locale_info
, 1, 2, 0,
1819 doc
: /* Return information about the Windows locale LCID.
1820 By default, return a three letter locale code which encodes the default
1821 language as the first two characters, and the country or regionial variant
1822 as the third letter. For example, ENU refers to `English (United States)',
1823 while ENC means `English (Canadian)'.
1825 If the optional argument LONGFORM is t, the long form of the locale
1826 name is returned, e.g. `English (United States)' instead; if LONGFORM
1827 is a number, it is interpreted as an LCTYPE constant and the corresponding
1828 locale information is returned.
1830 If LCID (a 16-bit number) is not a valid locale, the result is nil. */)
1832 Lisp_Object lcid
, longform
;
1836 char abbrev_name
[32] = { 0 };
1837 char full_name
[256] = { 0 };
1839 CHECK_NUMBER (lcid
);
1841 if (!IsValidLocale (XINT (lcid
), LCID_SUPPORTED
))
1844 if (NILP (longform
))
1846 got_abbrev
= GetLocaleInfo (XINT (lcid
),
1847 LOCALE_SABBREVLANGNAME
| LOCALE_USE_CP_ACP
,
1848 abbrev_name
, sizeof (abbrev_name
));
1850 return build_string (abbrev_name
);
1852 else if (EQ (longform
, Qt
))
1854 got_full
= GetLocaleInfo (XINT (lcid
),
1855 LOCALE_SLANGUAGE
| LOCALE_USE_CP_ACP
,
1856 full_name
, sizeof (full_name
));
1858 return build_string (full_name
);
1860 else if (NUMBERP (longform
))
1862 got_full
= GetLocaleInfo (XINT (lcid
),
1864 full_name
, sizeof (full_name
));
1866 return make_unibyte_string (full_name
, got_full
);
1873 DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id
,
1874 Sw32_get_current_locale_id
, 0, 0, 0,
1875 doc
: /* Return Windows locale id for current locale setting.
1876 This is a numerical value; use `w32-get-locale-info' to convert to a
1877 human-readable form. */)
1880 return make_number (GetThreadLocale ());
1883 DWORD
int_from_hex (char * s
)
1886 static char hex
[] = "0123456789abcdefABCDEF";
1889 while (*s
&& (p
= strchr(hex
, *s
)) != NULL
)
1891 unsigned digit
= p
- hex
;
1894 val
= val
* 16 + digit
;
1900 /* We need to build a global list, since the EnumSystemLocale callback
1901 function isn't given a context pointer. */
1902 Lisp_Object Vw32_valid_locale_ids
;
1904 BOOL CALLBACK
enum_locale_fn (LPTSTR localeNum
)
1906 DWORD id
= int_from_hex (localeNum
);
1907 Vw32_valid_locale_ids
= Fcons (make_number (id
), Vw32_valid_locale_ids
);
1911 DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids
,
1912 Sw32_get_valid_locale_ids
, 0, 0, 0,
1913 doc
: /* Return list of all valid Windows locale ids.
1914 Each id is a numerical value; use `w32-get-locale-info' to convert to a
1915 human-readable form. */)
1918 Vw32_valid_locale_ids
= Qnil
;
1920 EnumSystemLocales (enum_locale_fn
, LCID_SUPPORTED
);
1922 Vw32_valid_locale_ids
= Fnreverse (Vw32_valid_locale_ids
);
1923 return Vw32_valid_locale_ids
;
1927 DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id
, Sw32_get_default_locale_id
, 0, 1, 0,
1928 doc
: /* Return Windows locale id for default locale setting.
1929 By default, the system default locale setting is returned; if the optional
1930 parameter USERP is non-nil, the user default locale setting is returned.
1931 This is a numerical value; use `w32-get-locale-info' to convert to a
1932 human-readable form. */)
1937 return make_number (GetSystemDefaultLCID ());
1938 return make_number (GetUserDefaultLCID ());
1942 DEFUN ("w32-set-current-locale", Fw32_set_current_locale
, Sw32_set_current_locale
, 1, 1, 0,
1943 doc
: /* Make Windows locale LCID be the current locale setting for Emacs.
1944 If successful, the new locale id is returned, otherwise nil. */)
1948 CHECK_NUMBER (lcid
);
1950 if (!IsValidLocale (XINT (lcid
), LCID_SUPPORTED
))
1953 if (!SetThreadLocale (XINT (lcid
)))
1956 /* Need to set input thread locale if present. */
1957 if (dwWindowsThreadId
)
1958 /* Reply is not needed. */
1959 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_SETLOCALE
, XINT (lcid
), 0);
1961 return make_number (GetThreadLocale ());
1965 /* We need to build a global list, since the EnumCodePages callback
1966 function isn't given a context pointer. */
1967 Lisp_Object Vw32_valid_codepages
;
1969 BOOL CALLBACK
enum_codepage_fn (LPTSTR codepageNum
)
1971 DWORD id
= atoi (codepageNum
);
1972 Vw32_valid_codepages
= Fcons (make_number (id
), Vw32_valid_codepages
);
1976 DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages
,
1977 Sw32_get_valid_codepages
, 0, 0, 0,
1978 doc
: /* Return list of all valid Windows codepages. */)
1981 Vw32_valid_codepages
= Qnil
;
1983 EnumSystemCodePages (enum_codepage_fn
, CP_SUPPORTED
);
1985 Vw32_valid_codepages
= Fnreverse (Vw32_valid_codepages
);
1986 return Vw32_valid_codepages
;
1990 DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage
,
1991 Sw32_get_console_codepage
, 0, 0, 0,
1992 doc
: /* Return current Windows codepage for console input. */)
1995 return make_number (GetConsoleCP ());
1999 DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage
,
2000 Sw32_set_console_codepage
, 1, 1, 0,
2001 doc
: /* Make Windows codepage CP be the current codepage setting for Emacs.
2002 The codepage setting affects keyboard input and display in tty mode.
2003 If successful, the new CP is returned, otherwise nil. */)
2009 if (!IsValidCodePage (XINT (cp
)))
2012 if (!SetConsoleCP (XINT (cp
)))
2015 return make_number (GetConsoleCP ());
2019 DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage
,
2020 Sw32_get_console_output_codepage
, 0, 0, 0,
2021 doc
: /* Return current Windows codepage for console output. */)
2024 return make_number (GetConsoleOutputCP ());
2028 DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage
,
2029 Sw32_set_console_output_codepage
, 1, 1, 0,
2030 doc
: /* Make Windows codepage CP be the current codepage setting for Emacs.
2031 The codepage setting affects keyboard input and display in tty mode.
2032 If successful, the new CP is returned, otherwise nil. */)
2038 if (!IsValidCodePage (XINT (cp
)))
2041 if (!SetConsoleOutputCP (XINT (cp
)))
2044 return make_number (GetConsoleOutputCP ());
2048 DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset
,
2049 Sw32_get_codepage_charset
, 1, 1, 0,
2050 doc
: /* Return charset of codepage CP.
2051 Returns nil if the codepage is not valid. */)
2059 if (!IsValidCodePage (XINT (cp
)))
2062 if (TranslateCharsetInfo ((DWORD
*) XINT (cp
), &info
, TCI_SRCCODEPAGE
))
2063 return make_number (info
.ciCharset
);
2069 DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts
,
2070 Sw32_get_valid_keyboard_layouts
, 0, 0, 0,
2071 doc
: /* Return list of Windows keyboard languages and layouts.
2072 The return value is a list of pairs of language id and layout id. */)
2075 int num_layouts
= GetKeyboardLayoutList (0, NULL
);
2076 HKL
* layouts
= (HKL
*) alloca (num_layouts
* sizeof (HKL
));
2077 Lisp_Object obj
= Qnil
;
2079 if (GetKeyboardLayoutList (num_layouts
, layouts
) == num_layouts
)
2081 while (--num_layouts
>= 0)
2083 DWORD kl
= (DWORD
) layouts
[num_layouts
];
2085 obj
= Fcons (Fcons (make_number (kl
& 0xffff),
2086 make_number ((kl
>> 16) & 0xffff)),
2095 DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout
,
2096 Sw32_get_keyboard_layout
, 0, 0, 0,
2097 doc
: /* Return current Windows keyboard language and layout.
2098 The return value is the cons of the language id and the layout id. */)
2101 DWORD kl
= (DWORD
) GetKeyboardLayout (dwWindowsThreadId
);
2103 return Fcons (make_number (kl
& 0xffff),
2104 make_number ((kl
>> 16) & 0xffff));
2108 DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout
,
2109 Sw32_set_keyboard_layout
, 1, 1, 0,
2110 doc
: /* Make LAYOUT be the current keyboard layout for Emacs.
2111 The keyboard layout setting affects interpretation of keyboard input.
2112 If successful, the new layout id is returned, otherwise nil. */)
2118 CHECK_CONS (layout
);
2119 CHECK_NUMBER_CAR (layout
);
2120 CHECK_NUMBER_CDR (layout
);
2122 kl
= (XINT (XCAR (layout
)) & 0xffff)
2123 | (XINT (XCDR (layout
)) << 16);
2125 /* Synchronize layout with input thread. */
2126 if (dwWindowsThreadId
)
2128 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_SETKEYBOARDLAYOUT
,
2132 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
2134 if (msg
.wParam
== 0)
2138 else if (!ActivateKeyboardLayout ((HKL
) kl
, 0))
2141 return Fw32_get_keyboard_layout ();
2147 Qhigh
= intern ("high");
2148 Qlow
= intern ("low");
2153 defsubr (&Sw32_has_winsock
);
2154 defsubr (&Sw32_unload_winsock
);
2156 defsubr (&Sw32_short_file_name
);
2157 defsubr (&Sw32_long_file_name
);
2158 defsubr (&Sw32_set_process_priority
);
2159 defsubr (&Sw32_get_locale_info
);
2160 defsubr (&Sw32_get_current_locale_id
);
2161 defsubr (&Sw32_get_default_locale_id
);
2162 defsubr (&Sw32_get_valid_locale_ids
);
2163 defsubr (&Sw32_set_current_locale
);
2165 defsubr (&Sw32_get_console_codepage
);
2166 defsubr (&Sw32_set_console_codepage
);
2167 defsubr (&Sw32_get_console_output_codepage
);
2168 defsubr (&Sw32_set_console_output_codepage
);
2169 defsubr (&Sw32_get_valid_codepages
);
2170 defsubr (&Sw32_get_codepage_charset
);
2172 defsubr (&Sw32_get_valid_keyboard_layouts
);
2173 defsubr (&Sw32_get_keyboard_layout
);
2174 defsubr (&Sw32_set_keyboard_layout
);
2176 DEFVAR_LISP ("w32-quote-process-args", &Vw32_quote_process_args
,
2177 doc
: /* Non-nil enables quoting of process arguments to ensure correct parsing.
2178 Because Windows does not directly pass argv arrays to child processes,
2179 programs have to reconstruct the argv array by parsing the command
2180 line string. For an argument to contain a space, it must be enclosed
2181 in double quotes or it will be parsed as multiple arguments.
2183 If the value is a character, that character will be used to escape any
2184 quote characters that appear, otherwise a suitable escape character
2185 will be chosen based on the type of the program. */);
2186 Vw32_quote_process_args
= Qt
;
2188 DEFVAR_LISP ("w32-start-process-show-window",
2189 &Vw32_start_process_show_window
,
2190 doc
: /* When nil, new child processes hide their windows.
2191 When non-nil, they show their window in the method of their choice.
2192 This variable doesn't affect GUI applications, which will never be hidden. */);
2193 Vw32_start_process_show_window
= Qnil
;
2195 DEFVAR_LISP ("w32-start-process-share-console",
2196 &Vw32_start_process_share_console
,
2197 doc
: /* When nil, new child processes are given a new console.
2198 When non-nil, they share the Emacs console; this has the limitation of
2199 allowing only one DOS subprocess to run at a time (whether started directly
2200 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
2201 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
2202 otherwise respond to interrupts from Emacs. */);
2203 Vw32_start_process_share_console
= Qnil
;
2205 DEFVAR_LISP ("w32-start-process-inherit-error-mode",
2206 &Vw32_start_process_inherit_error_mode
,
2207 doc
: /* When nil, new child processes revert to the default error mode.
2208 When non-nil, they inherit their error mode setting from Emacs, which stops
2209 them blocking when trying to access unmounted drives etc. */);
2210 Vw32_start_process_inherit_error_mode
= Qt
;
2212 DEFVAR_INT ("w32-pipe-read-delay", &w32_pipe_read_delay
,
2213 doc
: /* Forced delay before reading subprocess output.
2214 This is done to improve the buffering of subprocess output, by
2215 avoiding the inefficiency of frequently reading small amounts of data.
2217 If positive, the value is the number of milliseconds to sleep before
2218 reading the subprocess output. If negative, the magnitude is the number
2219 of time slices to wait (effectively boosting the priority of the child
2220 process temporarily). A value of zero disables waiting entirely. */);
2221 w32_pipe_read_delay
= 50;
2223 DEFVAR_LISP ("w32-downcase-file-names", &Vw32_downcase_file_names
,
2224 doc
: /* Non-nil means convert all-upper case file names to lower case.
2225 This applies when performing completions and file name expansion.
2226 Note that the value of this setting also affects remote file names,
2227 so you probably don't want to set to non-nil if you use case-sensitive
2228 filesystems via ange-ftp. */);
2229 Vw32_downcase_file_names
= Qnil
;
2232 DEFVAR_LISP ("w32-generate-fake-inodes", &Vw32_generate_fake_inodes
,
2233 doc
: /* Non-nil means attempt to fake realistic inode values.
2234 This works by hashing the truename of files, and should detect
2235 aliasing between long and short (8.3 DOS) names, but can have
2236 false positives because of hash collisions. Note that determing
2237 the truename of a file can be slow. */);
2238 Vw32_generate_fake_inodes
= Qnil
;
2241 DEFVAR_LISP ("w32-get-true-file-attributes", &Vw32_get_true_file_attributes
,
2242 doc
: /* Non-nil means determine accurate link count in `file-attributes'.
2243 Note that this option is only useful for files on NTFS volumes, where hard links
2244 are supported. Moreover, it slows down `file-attributes' noticeably. */);
2245 Vw32_get_true_file_attributes
= Qt
;
2247 staticpro (&Vw32_valid_locale_ids
);
2248 staticpro (&Vw32_valid_codepages
);
2250 /* end of ntproc.c */
2252 /* arch-tag: 23d3a34c-06d2-48a1-833b-ac7609aa5250
2253 (do not change this comment) */