1 /* Process support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1992, 1995, 1999, 2000, 2001 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., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, 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 /* Control whether spawnve quotes arguments as necessary to ensure
61 correct parsing by child process. Because not all uses of spawnve
62 are careful about constructing argv arrays, we make this behaviour
63 conditional (off by default). */
64 Lisp_Object Vw32_quote_process_args
;
66 /* Control whether create_child causes the process' window to be
67 hidden. The default is nil. */
68 Lisp_Object Vw32_start_process_show_window
;
70 /* Control whether create_child causes the process to inherit Emacs'
71 console window, or be given a new one of its own. The default is
72 nil, to allow multiple DOS programs to run on Win95. Having separate
73 consoles also allows Emacs to cleanly terminate process groups. */
74 Lisp_Object Vw32_start_process_share_console
;
76 /* Control whether create_child cause the process to inherit Emacs'
77 error mode setting. The default is t, to minimize the possibility of
78 subprocesses blocking when accessing unmounted drives. */
79 Lisp_Object Vw32_start_process_inherit_error_mode
;
81 /* Time to sleep before reading from a subprocess output pipe - this
82 avoids the inefficiency of frequently reading small amounts of data.
83 This is primarily necessary for handling DOS processes on Windows 95,
84 but is useful for W32 processes on both Windows 95 and NT as well. */
85 Lisp_Object Vw32_pipe_read_delay
;
87 /* Control conversion of upper case file names to lower case.
88 nil means no, t means yes. */
89 Lisp_Object Vw32_downcase_file_names
;
91 /* Control whether stat() attempts to generate fake but hopefully
92 "accurate" inode values, by hashing the absolute truenames of files.
93 This should detect aliasing between long and short names, but still
94 allows the possibility of hash collisions. */
95 Lisp_Object Vw32_generate_fake_inodes
;
97 /* Control whether stat() attempts to determine file type and link count
98 exactly, at the expense of slower operation. Since true hard links
99 are supported on NTFS volumes, this is only relevant on NT. */
100 Lisp_Object Vw32_get_true_file_attributes
;
102 Lisp_Object Qhigh
, Qlow
;
105 void _DebPrint (const char *fmt
, ...)
110 va_start (args
, fmt
);
111 vsprintf (buf
, fmt
, args
);
113 OutputDebugString (buf
);
117 typedef void (_CALLBACK_
*signal_handler
)(int);
119 /* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */
120 static signal_handler sig_handlers
[NSIG
];
122 /* Fake signal implementation to record the SIGCHLD handler. */
124 sys_signal (int sig
, signal_handler handler
)
133 old
= sig_handlers
[sig
];
134 sig_handlers
[sig
] = handler
;
138 /* Defined in <process.h> which conflicts with the local copy */
141 /* Child process management list. */
142 int child_proc_count
= 0;
143 child_process child_procs
[ MAX_CHILDREN
];
144 child_process
*dead_child
= NULL
;
146 DWORD WINAPI
reader_thread (void *arg
);
148 /* Find an unused process slot. */
155 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
156 if (!CHILD_ACTIVE (cp
))
158 if (child_proc_count
== MAX_CHILDREN
)
160 cp
= &child_procs
[child_proc_count
++];
163 memset (cp
, 0, sizeof(*cp
));
166 cp
->procinfo
.hProcess
= NULL
;
167 cp
->status
= STATUS_READ_ERROR
;
169 /* use manual reset event so that select() will function properly */
170 cp
->char_avail
= CreateEvent (NULL
, TRUE
, FALSE
, NULL
);
173 cp
->char_consumed
= CreateEvent (NULL
, FALSE
, FALSE
, NULL
);
174 if (cp
->char_consumed
)
176 cp
->thrd
= CreateThread (NULL
, 1024, reader_thread
, cp
, 0, &id
);
186 delete_child (child_process
*cp
)
190 /* Should not be deleting a child that is still needed. */
191 for (i
= 0; i
< MAXDESC
; i
++)
192 if (fd_info
[i
].cp
== cp
)
195 if (!CHILD_ACTIVE (cp
))
198 /* reap thread if necessary */
203 if (GetExitCodeThread (cp
->thrd
, &rc
) && rc
== STILL_ACTIVE
)
205 /* let the thread exit cleanly if possible */
206 cp
->status
= STATUS_READ_ERROR
;
207 SetEvent (cp
->char_consumed
);
208 if (WaitForSingleObject (cp
->thrd
, 1000) != WAIT_OBJECT_0
)
210 DebPrint (("delete_child.WaitForSingleObject (thread) failed "
211 "with %lu for fd %ld\n", GetLastError (), cp
->fd
));
212 TerminateThread (cp
->thrd
, 0);
215 CloseHandle (cp
->thrd
);
220 CloseHandle (cp
->char_avail
);
221 cp
->char_avail
= NULL
;
223 if (cp
->char_consumed
)
225 CloseHandle (cp
->char_consumed
);
226 cp
->char_consumed
= NULL
;
229 /* update child_proc_count (highest numbered slot in use plus one) */
230 if (cp
== child_procs
+ child_proc_count
- 1)
232 for (i
= child_proc_count
-1; i
>= 0; i
--)
233 if (CHILD_ACTIVE (&child_procs
[i
]))
235 child_proc_count
= i
+ 1;
240 child_proc_count
= 0;
243 /* Find a child by pid. */
244 static child_process
*
245 find_child_pid (DWORD pid
)
249 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
250 if (CHILD_ACTIVE (cp
) && pid
== cp
->pid
)
256 /* Thread proc for child process and socket reader threads. Each thread
257 is normally blocked until woken by select() to check for input by
258 reading one char. When the read completes, char_avail is signalled
259 to wake up the select emulator and the thread blocks itself again. */
261 reader_thread (void *arg
)
266 cp
= (child_process
*)arg
;
268 /* We have to wait for the go-ahead before we can start */
270 || WaitForSingleObject (cp
->char_consumed
, INFINITE
) != WAIT_OBJECT_0
)
277 rc
= _sys_read_ahead (cp
->fd
);
279 /* The name char_avail is a misnomer - it really just means the
280 read-ahead has completed, whether successfully or not. */
281 if (!SetEvent (cp
->char_avail
))
283 DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld\n",
284 GetLastError (), cp
->fd
));
288 if (rc
== STATUS_READ_ERROR
)
291 /* If the read died, the child has died so let the thread die */
292 if (rc
== STATUS_READ_FAILED
)
295 /* Wait until our input is acknowledged before reading again */
296 if (WaitForSingleObject (cp
->char_consumed
, INFINITE
) != WAIT_OBJECT_0
)
298 DebPrint (("reader_thread.WaitForSingleObject failed with "
299 "%lu for fd %ld\n", GetLastError (), cp
->fd
));
306 /* To avoid Emacs changing directory, we just record here the directory
307 the new process should start in. This is set just before calling
308 sys_spawnve, and is not generally valid at any other time. */
309 static char * process_dir
;
312 create_child (char *exe
, char *cmdline
, char *env
, int is_gui_app
,
313 int * pPid
, child_process
*cp
)
316 SECURITY_ATTRIBUTES sec_attrs
;
318 SECURITY_DESCRIPTOR sec_desc
;
321 char dir
[ MAXPATHLEN
];
323 if (cp
== NULL
) abort ();
325 memset (&start
, 0, sizeof (start
));
326 start
.cb
= sizeof (start
);
329 if (NILP (Vw32_start_process_show_window
) && !is_gui_app
)
330 start
.dwFlags
= STARTF_USESTDHANDLES
| STARTF_USESHOWWINDOW
;
332 start
.dwFlags
= STARTF_USESTDHANDLES
;
333 start
.wShowWindow
= SW_HIDE
;
335 start
.hStdInput
= GetStdHandle (STD_INPUT_HANDLE
);
336 start
.hStdOutput
= GetStdHandle (STD_OUTPUT_HANDLE
);
337 start
.hStdError
= GetStdHandle (STD_ERROR_HANDLE
);
338 #endif /* HAVE_NTGUI */
341 /* Explicitly specify no security */
342 if (!InitializeSecurityDescriptor (&sec_desc
, SECURITY_DESCRIPTOR_REVISION
))
344 if (!SetSecurityDescriptorDacl (&sec_desc
, TRUE
, NULL
, FALSE
))
347 sec_attrs
.nLength
= sizeof (sec_attrs
);
348 sec_attrs
.lpSecurityDescriptor
= NULL
/* &sec_desc */;
349 sec_attrs
.bInheritHandle
= FALSE
;
351 strcpy (dir
, process_dir
);
352 unixtodos_filename (dir
);
354 flags
= (!NILP (Vw32_start_process_share_console
)
355 ? CREATE_NEW_PROCESS_GROUP
356 : CREATE_NEW_CONSOLE
);
357 if (NILP (Vw32_start_process_inherit_error_mode
))
358 flags
|= CREATE_DEFAULT_ERROR_MODE
;
359 if (!CreateProcess (exe
, cmdline
, &sec_attrs
, NULL
, TRUE
,
360 flags
, env
, dir
, &start
, &cp
->procinfo
))
363 cp
->pid
= (int) cp
->procinfo
.dwProcessId
;
365 /* Hack for Windows 95, which assigns large (ie negative) pids */
369 /* pid must fit in a Lisp_Int */
370 cp
->pid
= (cp
->pid
& VALMASK
);
377 DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError()););
381 /* create_child doesn't know what emacs' file handle will be for waiting
382 on output from the child, so we need to make this additional call
383 to register the handle with the process
384 This way the select emulator knows how to match file handles with
385 entries in child_procs. */
387 register_child (int pid
, int fd
)
391 cp
= find_child_pid (pid
);
394 DebPrint (("register_child unable to find pid %lu\n", pid
));
399 DebPrint (("register_child registered fd %d with pid %lu\n", fd
, pid
));
404 /* thread is initially blocked until select is called; set status so
405 that select will release thread */
406 cp
->status
= STATUS_READ_ACKNOWLEDGED
;
408 /* attach child_process to fd_info */
409 if (fd_info
[fd
].cp
!= NULL
)
411 DebPrint (("register_child: fd_info[%d] apparently in use!\n", fd
));
418 /* When a process dies its pipe will break so the reader thread will
419 signal failure to the select emulator.
420 The select emulator then calls this routine to clean up.
421 Since the thread signaled failure we can assume it is exiting. */
423 reap_subprocess (child_process
*cp
)
425 if (cp
->procinfo
.hProcess
)
427 /* Reap the process */
429 /* Process should have already died before we are called. */
430 if (WaitForSingleObject (cp
->procinfo
.hProcess
, 0) != WAIT_OBJECT_0
)
431 DebPrint (("reap_subprocess: child fpr fd %d has not died yet!", cp
->fd
));
433 CloseHandle (cp
->procinfo
.hProcess
);
434 cp
->procinfo
.hProcess
= NULL
;
435 CloseHandle (cp
->procinfo
.hThread
);
436 cp
->procinfo
.hThread
= NULL
;
439 /* For asynchronous children, the child_proc resources will be freed
440 when the last pipe read descriptor is closed; for synchronous
441 children, we must explicitly free the resources now because
442 register_child has not been called. */
447 /* Wait for any of our existing child processes to die
448 When it does, close its handle
449 Return the pid and fill in the status if non-NULL. */
452 sys_wait (int *status
)
454 DWORD active
, retval
;
457 child_process
*cp
, *cps
[MAX_CHILDREN
];
458 HANDLE wait_hnd
[MAX_CHILDREN
];
461 if (dead_child
!= NULL
)
463 /* We want to wait for a specific child */
464 wait_hnd
[nh
] = dead_child
->procinfo
.hProcess
;
465 cps
[nh
] = dead_child
;
466 if (!wait_hnd
[nh
]) abort ();
473 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
474 /* some child_procs might be sockets; ignore them */
475 if (CHILD_ACTIVE (cp
) && cp
->procinfo
.hProcess
)
477 wait_hnd
[nh
] = cp
->procinfo
.hProcess
;
485 /* Nothing to wait on, so fail */
492 /* Check for quit about once a second. */
494 active
= WaitForMultipleObjects (nh
, wait_hnd
, FALSE
, 1000);
495 } while (active
== WAIT_TIMEOUT
);
497 if (active
== WAIT_FAILED
)
502 else if (active
>= WAIT_OBJECT_0
503 && active
< WAIT_OBJECT_0
+MAXIMUM_WAIT_OBJECTS
)
505 active
-= WAIT_OBJECT_0
;
507 else if (active
>= WAIT_ABANDONED_0
508 && active
< WAIT_ABANDONED_0
+MAXIMUM_WAIT_OBJECTS
)
510 active
-= WAIT_ABANDONED_0
;
516 if (!GetExitCodeProcess (wait_hnd
[active
], &retval
))
518 DebPrint (("Wait.GetExitCodeProcess failed with %lu\n",
522 if (retval
== STILL_ACTIVE
)
524 /* Should never happen */
525 DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
530 /* Massage the exit code from the process to match the format expected
531 by the WIFSTOPPED et al macros in syswait.h. Only WIFSIGNALED and
532 WIFEXITED are supported; WIFSTOPPED doesn't make sense under NT. */
534 if (retval
== STATUS_CONTROL_C_EXIT
)
542 DebPrint (("Wait signaled with process pid %d\n", cp
->pid
));
549 else if (synch_process_alive
)
551 synch_process_alive
= 0;
553 /* Report the status of the synchronous process. */
554 if (WIFEXITED (retval
))
555 synch_process_retcode
= WRETCODE (retval
);
556 else if (WIFSIGNALED (retval
))
558 int code
= WTERMSIG (retval
);
561 synchronize_system_messages_locale ();
562 signame
= strsignal (code
);
567 synch_process_death
= signame
;
570 reap_subprocess (cp
);
573 reap_subprocess (cp
);
579 w32_executable_type (char * filename
, int * is_dos_app
, int * is_cygnus_app
, int * is_gui_app
)
581 file_data executable
;
584 /* Default values in case we can't tell for sure. */
586 *is_cygnus_app
= FALSE
;
589 if (!open_input_file (&executable
, filename
))
592 p
= strrchr (filename
, '.');
594 /* We can only identify DOS .com programs from the extension. */
595 if (p
&& stricmp (p
, ".com") == 0)
597 else if (p
&& (stricmp (p
, ".bat") == 0
598 || stricmp (p
, ".cmd") == 0))
600 /* A DOS shell script - it appears that CreateProcess is happy to
601 accept this (somewhat surprisingly); presumably it looks at
602 COMSPEC to determine what executable to actually invoke.
603 Therefore, we have to do the same here as well. */
604 /* Actually, I think it uses the program association for that
605 extension, which is defined in the registry. */
606 p
= egetenv ("COMSPEC");
608 w32_executable_type (p
, is_dos_app
, is_cygnus_app
, is_gui_app
);
612 /* Look for DOS .exe signature - if found, we must also check that
613 it isn't really a 16- or 32-bit Windows exe, since both formats
614 start with a DOS program stub. Note that 16-bit Windows
615 executables use the OS/2 1.x format. */
617 IMAGE_DOS_HEADER
* dos_header
;
618 IMAGE_NT_HEADERS
* nt_header
;
620 dos_header
= (PIMAGE_DOS_HEADER
) executable
.file_base
;
621 if (dos_header
->e_magic
!= IMAGE_DOS_SIGNATURE
)
624 nt_header
= (PIMAGE_NT_HEADERS
) ((char *) dos_header
+ dos_header
->e_lfanew
);
626 if ((char *) nt_header
> (char *) dos_header
+ executable
.size
)
628 /* Some dos headers (pkunzip) have bogus e_lfanew fields. */
631 else if (nt_header
->Signature
!= IMAGE_NT_SIGNATURE
632 && LOWORD (nt_header
->Signature
) != IMAGE_OS2_SIGNATURE
)
636 else if (nt_header
->Signature
== IMAGE_NT_SIGNATURE
)
638 /* Look for cygwin.dll in DLL import list. */
639 IMAGE_DATA_DIRECTORY import_dir
=
640 nt_header
->OptionalHeader
.DataDirectory
[IMAGE_DIRECTORY_ENTRY_IMPORT
];
641 IMAGE_IMPORT_DESCRIPTOR
* imports
;
642 IMAGE_SECTION_HEADER
* section
;
644 section
= rva_to_section (import_dir
.VirtualAddress
, nt_header
);
645 imports
= RVA_TO_PTR (import_dir
.VirtualAddress
, section
, executable
);
647 for ( ; imports
->Name
; imports
++)
649 char * dllname
= RVA_TO_PTR (imports
->Name
, section
, executable
);
651 /* The exact name of the cygwin dll has changed with
652 various releases, but hopefully this will be reasonably
654 if (strncmp (dllname
, "cygwin", 6) == 0)
656 *is_cygnus_app
= TRUE
;
661 /* Check whether app is marked as a console or windowed (aka
662 GUI) app. Accept Posix and OS2 subsytem apps as console
664 *is_gui_app
= (nt_header
->OptionalHeader
.Subsystem
== IMAGE_SUBSYSTEM_WINDOWS_GUI
);
669 close_file_data (&executable
);
673 compare_env (const void *strp1
, const void *strp2
)
675 const char *str1
= *(const char **)strp1
, *str2
= *(const char **)strp2
;
677 while (*str1
&& *str2
&& *str1
!= '=' && *str2
!= '=')
679 /* Sort order in command.com/cmd.exe is based on uppercasing
680 names, so do the same here. */
681 if (toupper (*str1
) > toupper (*str2
))
683 else if (toupper (*str1
) < toupper (*str2
))
688 if (*str1
== '=' && *str2
== '=')
690 else if (*str1
== '=')
697 merge_and_sort_env (char **envp1
, char **envp2
, char **new_envp
)
713 qsort (new_envp
, num
, sizeof (char *), compare_env
);
718 /* When a new child process is created we need to register it in our list,
719 so intercept spawn requests. */
721 sys_spawnve (int mode
, char *cmdname
, char **argv
, char **envp
)
723 Lisp_Object program
, full
;
724 char *cmdline
, *env
, *parg
, **targ
;
728 int is_dos_app
, is_cygnus_app
, is_gui_app
;
731 /* We pass our process ID to our children by setting up an environment
732 variable in their environment. */
733 char ppid_env_var_buffer
[64];
734 char *extra_env
[] = {ppid_env_var_buffer
, NULL
};
735 char *sepchars
= " \t";
737 /* We don't care about the other modes */
738 if (mode
!= _P_NOWAIT
)
744 /* Handle executable names without an executable suffix. */
745 program
= make_string (cmdname
, strlen (cmdname
));
746 if (NILP (Ffile_executable_p (program
)))
752 openp (Vexec_path
, program
, Vexec_suffixes
, &full
, make_number (X_OK
));
762 /* make sure argv[0] and cmdname are both in DOS format */
763 cmdname
= SDATA (program
);
764 unixtodos_filename (cmdname
);
767 /* Determine whether program is a 16-bit DOS executable, or a w32
768 executable that is implicitly linked to the Cygnus dll (implying it
769 was compiled with the Cygnus GNU toolchain and hence relies on
770 cygwin.dll to parse the command line - we use this to decide how to
771 escape quote chars in command line args that must be quoted).
773 Also determine whether it is a GUI app, so that we don't hide its
774 initial window unless specifically requested. */
775 w32_executable_type (cmdname
, &is_dos_app
, &is_cygnus_app
, &is_gui_app
);
777 /* On Windows 95, if cmdname is a DOS app, we invoke a helper
778 application to start it by specifying the helper app as cmdname,
779 while leaving the real app name as argv[0]. */
782 cmdname
= alloca (MAXPATHLEN
);
783 if (egetenv ("CMDPROXY"))
784 strcpy (cmdname
, egetenv ("CMDPROXY"));
787 strcpy (cmdname
, SDATA (Vinvocation_directory
));
788 strcat (cmdname
, "cmdproxy.exe");
790 unixtodos_filename (cmdname
);
793 /* we have to do some conjuring here to put argv and envp into the
794 form CreateProcess wants... argv needs to be a space separated/null
795 terminated list of parameters, and envp is a null
796 separated/double-null terminated list of parameters.
798 Additionally, zero-length args and args containing whitespace or
799 quote chars need to be wrapped in double quotes - for this to work,
800 embedded quotes need to be escaped as well. The aim is to ensure
801 the child process reconstructs the argv array we start with
802 exactly, so we treat quotes at the beginning and end of arguments
805 The w32 GNU-based library from Cygnus doubles quotes to escape
806 them, while MSVC uses backslash for escaping. (Actually the MSVC
807 startup code does attempt to recognise doubled quotes and accept
808 them, but gets it wrong and ends up requiring three quotes to get a
809 single embedded quote!) So by default we decide whether to use
810 quote or backslash as the escape character based on whether the
811 binary is apparently a Cygnus compiled app.
813 Note that using backslash to escape embedded quotes requires
814 additional special handling if an embedded quote is already
815 preceeded by backslash, or if an arg requiring quoting ends with
816 backslash. In such cases, the run of escape characters needs to be
817 doubled. For consistency, we apply this special handling as long
818 as the escape character is not quote.
820 Since we have no idea how large argv and envp are likely to be we
821 figure out list lengths on the fly and allocate them. */
823 if (!NILP (Vw32_quote_process_args
))
826 /* Override escape char by binding w32-quote-process-args to
827 desired character, or use t for auto-selection. */
828 if (INTEGERP (Vw32_quote_process_args
))
829 escape_char
= XINT (Vw32_quote_process_args
);
831 escape_char
= is_cygnus_app
? '"' : '\\';
834 /* Cygwin apps needs quoting a bit more often */
835 if (escape_char
== '"')
836 sepchars
= "\r\n\t\f '";
845 int escape_char_run
= 0;
851 if (escape_char
== '"' && *p
== '\\')
852 /* If it's a Cygwin app, \ needs to be escaped. */
856 /* allow for embedded quotes to be escaped */
859 /* handle the case where the embedded quote is already escaped */
860 if (escape_char_run
> 0)
862 /* To preserve the arg exactly, we need to double the
863 preceding escape characters (plus adding one to
864 escape the quote character itself). */
865 arglen
+= escape_char_run
;
868 else if (strchr (sepchars
, *p
) != NULL
)
873 if (*p
== escape_char
&& escape_char
!= '"')
881 /* handle the case where the arg ends with an escape char - we
882 must not let the enclosing quote be escaped. */
883 if (escape_char_run
> 0)
884 arglen
+= escape_char_run
;
886 arglen
+= strlen (*targ
++) + 1;
888 cmdline
= alloca (arglen
);
902 if ((strchr (sepchars
, *p
) != NULL
) || *p
== '"')
907 int escape_char_run
= 0;
913 last
= p
+ strlen (p
) - 1;
916 /* This version does not escape quotes if they occur at the
917 beginning or end of the arg - this could lead to incorrect
918 behaviour when the arg itself represents a command line
919 containing quoted args. I believe this was originally done
920 as a hack to make some things work, before
921 `w32-quote-process-args' was added. */
924 if (*p
== '"' && p
> first
&& p
< last
)
925 *parg
++ = escape_char
; /* escape embedded quotes */
933 /* double preceding escape chars if any */
934 while (escape_char_run
> 0)
936 *parg
++ = escape_char
;
939 /* escape all quote chars, even at beginning or end */
940 *parg
++ = escape_char
;
942 else if (escape_char
== '"' && *p
== '\\')
946 if (*p
== escape_char
&& escape_char
!= '"')
951 /* double escape chars before enclosing quote */
952 while (escape_char_run
> 0)
954 *parg
++ = escape_char
;
962 strcpy (parg
, *targ
);
963 parg
+= strlen (*targ
);
973 numenv
= 1; /* for end null */
976 arglen
+= strlen (*targ
++) + 1;
979 /* extra env vars... */
980 sprintf (ppid_env_var_buffer
, "EM_PARENT_PROCESS_ID=%d",
981 GetCurrentProcessId ());
982 arglen
+= strlen (ppid_env_var_buffer
) + 1;
985 /* merge env passed in and extra env into one, and sort it. */
986 targ
= (char **) alloca (numenv
* sizeof (char *));
987 merge_and_sort_env (envp
, extra_env
, targ
);
989 /* concatenate env entries. */
990 env
= alloca (arglen
);
994 strcpy (parg
, *targ
);
995 parg
+= strlen (*targ
++);
1008 /* Now create the process. */
1009 if (!create_child (cmdname
, cmdline
, env
, is_gui_app
, &pid
, cp
))
1019 /* Emulate the select call
1020 Wait for available input on any of the given rfds, or timeout if
1021 a timeout is given and no input is detected
1022 wfds and efds are not supported and must be NULL.
1024 For simplicity, we detect the death of child processes here and
1025 synchronously call the SIGCHLD handler. Since it is possible for
1026 children to be created without a corresponding pipe handle from which
1027 to read output, we wait separately on the process handles as well as
1028 the char_avail events for each process pipe. We only call
1029 wait/reap_process when the process actually terminates.
1031 To reduce the number of places in which Emacs can be hung such that
1032 C-g is not able to interrupt it, we always wait on interrupt_handle
1033 (which is signalled by the input thread when C-g is detected). If we
1034 detect that we were woken up by C-g, we return -1 with errno set to
1035 EINTR as on Unix. */
1038 extern HANDLE keyboard_handle
;
1040 /* From w32xfns.c */
1041 extern HANDLE interrupt_handle
;
1043 /* From process.c */
1044 extern int proc_buffered_char
[];
1047 sys_select (int nfds
, SELECT_TYPE
*rfds
, SELECT_TYPE
*wfds
, SELECT_TYPE
*efds
,
1048 EMACS_TIME
*timeout
)
1051 DWORD timeout_ms
, start_time
;
1054 child_process
*cp
, *cps
[MAX_CHILDREN
];
1055 HANDLE wait_hnd
[MAXDESC
+ MAX_CHILDREN
];
1056 int fdindex
[MAXDESC
]; /* mapping from wait handles back to descriptors */
1058 timeout_ms
= timeout
? (timeout
->tv_sec
* 1000 + timeout
->tv_usec
/ 1000) : INFINITE
;
1060 /* If the descriptor sets are NULL but timeout isn't, then just Sleep. */
1061 if (rfds
== NULL
&& wfds
== NULL
&& efds
== NULL
&& timeout
!= NULL
)
1067 /* Otherwise, we only handle rfds, so fail otherwise. */
1068 if (rfds
== NULL
|| wfds
!= NULL
|| efds
!= NULL
)
1078 /* Always wait on interrupt_handle, to detect C-g (quit). */
1079 wait_hnd
[0] = interrupt_handle
;
1082 /* Build a list of pipe handles to wait on. */
1084 for (i
= 0; i
< nfds
; i
++)
1085 if (FD_ISSET (i
, &orfds
))
1089 if (keyboard_handle
)
1091 /* Handle stdin specially */
1092 wait_hnd
[nh
] = keyboard_handle
;
1097 /* Check for any emacs-generated input in the queue since
1098 it won't be detected in the wait */
1099 if (detect_input_pending ())
1107 /* Child process and socket input */
1111 int current_status
= cp
->status
;
1113 if (current_status
== STATUS_READ_ACKNOWLEDGED
)
1115 /* Tell reader thread which file handle to use. */
1117 /* Wake up the reader thread for this process */
1118 cp
->status
= STATUS_READ_READY
;
1119 if (!SetEvent (cp
->char_consumed
))
1120 DebPrint (("nt_select.SetEvent failed with "
1121 "%lu for fd %ld\n", GetLastError (), i
));
1124 #ifdef CHECK_INTERLOCK
1125 /* slightly crude cross-checking of interlock between threads */
1127 current_status
= cp
->status
;
1128 if (WaitForSingleObject (cp
->char_avail
, 0) == WAIT_OBJECT_0
)
1130 /* char_avail has been signalled, so status (which may
1131 have changed) should indicate read has completed
1132 but has not been acknowledged. */
1133 current_status
= cp
->status
;
1134 if (current_status
!= STATUS_READ_SUCCEEDED
1135 && current_status
!= STATUS_READ_FAILED
)
1136 DebPrint (("char_avail set, but read not completed: status %d\n",
1141 /* char_avail has not been signalled, so status should
1142 indicate that read is in progress; small possibility
1143 that read has completed but event wasn't yet signalled
1144 when we tested it (because a context switch occurred
1145 or if running on separate CPUs). */
1146 if (current_status
!= STATUS_READ_READY
1147 && current_status
!= STATUS_READ_IN_PROGRESS
1148 && current_status
!= STATUS_READ_SUCCEEDED
1149 && current_status
!= STATUS_READ_FAILED
)
1150 DebPrint (("char_avail reset, but read status is bad: %d\n",
1154 wait_hnd
[nh
] = cp
->char_avail
;
1156 if (!wait_hnd
[nh
]) abort ();
1159 DebPrint (("select waiting on child %d fd %d\n",
1160 cp
-child_procs
, i
));
1165 /* Unable to find something to wait on for this fd, skip */
1167 /* Note that this is not a fatal error, and can in fact
1168 happen in unusual circumstances. Specifically, if
1169 sys_spawnve fails, eg. because the program doesn't
1170 exist, and debug-on-error is t so Fsignal invokes a
1171 nested input loop, then the process output pipe is
1172 still included in input_wait_mask with no child_proc
1173 associated with it. (It is removed when the debugger
1174 exits the nested input loop and the error is thrown.) */
1176 DebPrint (("sys_select: fd %ld is invalid! ignoring\n", i
));
1182 /* Add handles of child processes. */
1184 for (cp
= child_procs
+(child_proc_count
-1); cp
>= child_procs
; cp
--)
1185 /* Some child_procs might be sockets; ignore them. Also some
1186 children may have died already, but we haven't finished reading
1187 the process output; ignore them too. */
1188 if (CHILD_ACTIVE (cp
) && cp
->procinfo
.hProcess
1190 || (fd_info
[cp
->fd
].flags
& FILE_SEND_SIGCHLD
) == 0
1191 || (fd_info
[cp
->fd
].flags
& FILE_AT_EOF
) != 0)
1194 wait_hnd
[nh
+ nc
] = cp
->procinfo
.hProcess
;
1199 /* Nothing to look for, so we didn't find anything */
1207 start_time
= GetTickCount ();
1209 /* Wait for input or child death to be signalled. If user input is
1210 allowed, then also accept window messages. */
1211 if (FD_ISSET (0, &orfds
))
1212 active
= MsgWaitForMultipleObjects (nh
+ nc
, wait_hnd
, FALSE
, timeout_ms
,
1215 active
= WaitForMultipleObjects (nh
+ nc
, wait_hnd
, FALSE
, timeout_ms
);
1217 if (active
== WAIT_FAILED
)
1219 DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n",
1220 nh
+ nc
, timeout_ms
, GetLastError ()));
1221 /* don't return EBADF - this causes wait_reading_process_input to
1222 abort; WAIT_FAILED is returned when single-stepping under
1223 Windows 95 after switching thread focus in debugger, and
1224 possibly at other times. */
1228 else if (active
== WAIT_TIMEOUT
)
1232 else if (active
>= WAIT_OBJECT_0
1233 && active
< WAIT_OBJECT_0
+MAXIMUM_WAIT_OBJECTS
)
1235 active
-= WAIT_OBJECT_0
;
1237 else if (active
>= WAIT_ABANDONED_0
1238 && active
< WAIT_ABANDONED_0
+MAXIMUM_WAIT_OBJECTS
)
1240 active
-= WAIT_ABANDONED_0
;
1245 /* Loop over all handles after active (now officially documented as
1246 being the first signalled handle in the array). We do this to
1247 ensure fairness, so that all channels with data available will be
1248 processed - otherwise higher numbered channels could be starved. */
1251 if (active
== nh
+ nc
)
1253 /* There are messages in the lisp thread's queue; we must
1254 drain the queue now to ensure they are processed promptly,
1255 because if we don't do so, we will not be woken again until
1256 further messages arrive.
1258 NB. If ever we allow window message procedures to callback
1259 into lisp, we will need to ensure messages are dispatched
1260 at a safe time for lisp code to be run (*), and we may also
1261 want to provide some hooks in the dispatch loop to cater
1262 for modeless dialogs created by lisp (ie. to register
1263 window handles to pass to IsDialogMessage).
1265 (*) Note that MsgWaitForMultipleObjects above is an
1266 internal dispatch point for messages that are sent to
1267 windows created by this thread. */
1268 drain_message_queue ();
1270 else if (active
>= nh
)
1272 cp
= cps
[active
- nh
];
1274 /* We cannot always signal SIGCHLD immediately; if we have not
1275 finished reading the process output, we must delay sending
1276 SIGCHLD until we do. */
1278 if (cp
->fd
>= 0 && (fd_info
[cp
->fd
].flags
& FILE_AT_EOF
) == 0)
1279 fd_info
[cp
->fd
].flags
|= FILE_SEND_SIGCHLD
;
1280 /* SIG_DFL for SIGCHLD is ignore */
1281 else if (sig_handlers
[SIGCHLD
] != SIG_DFL
&&
1282 sig_handlers
[SIGCHLD
] != SIG_IGN
)
1285 DebPrint (("select calling SIGCHLD handler for pid %d\n",
1289 sig_handlers
[SIGCHLD
] (SIGCHLD
);
1293 else if (fdindex
[active
] == -1)
1295 /* Quit (C-g) was detected. */
1299 else if (fdindex
[active
] == 0)
1301 /* Keyboard input available */
1307 /* must be a socket or pipe - read ahead should have
1308 completed, either succeeding or failing. */
1309 FD_SET (fdindex
[active
], rfds
);
1313 /* Even though wait_reading_process_output only reads from at most
1314 one channel, we must process all channels here so that we reap
1315 all children that have died. */
1316 while (++active
< nh
+ nc
)
1317 if (WaitForSingleObject (wait_hnd
[active
], 0) == WAIT_OBJECT_0
)
1319 } while (active
< nh
+ nc
);
1321 /* If no input has arrived and timeout hasn't expired, wait again. */
1324 DWORD elapsed
= GetTickCount () - start_time
;
1326 if (timeout_ms
> elapsed
) /* INFINITE is MAX_UINT */
1328 if (timeout_ms
!= INFINITE
)
1329 timeout_ms
-= elapsed
;
1330 goto count_children
;
1337 /* Substitute for certain kill () operations */
1339 static BOOL CALLBACK
1340 find_child_console (HWND hwnd
, LPARAM arg
)
1342 child_process
* cp
= (child_process
*) arg
;
1346 thread_id
= GetWindowThreadProcessId (hwnd
, &process_id
);
1347 if (process_id
== cp
->procinfo
.dwProcessId
)
1349 char window_class
[32];
1351 GetClassName (hwnd
, window_class
, sizeof (window_class
));
1352 if (strcmp (window_class
,
1353 (os_subtype
== OS_WIN95
)
1355 : "ConsoleWindowClass") == 0)
1366 sys_kill (int pid
, int sig
)
1370 int need_to_free
= 0;
1373 /* Only handle signals that will result in the process dying */
1374 if (sig
!= SIGINT
&& sig
!= SIGKILL
&& sig
!= SIGQUIT
&& sig
!= SIGHUP
)
1380 cp
= find_child_pid (pid
);
1383 proc_hand
= OpenProcess (PROCESS_TERMINATE
, 0, pid
);
1384 if (proc_hand
== NULL
)
1393 proc_hand
= cp
->procinfo
.hProcess
;
1394 pid
= cp
->procinfo
.dwProcessId
;
1396 /* Try to locate console window for process. */
1397 EnumWindows (find_child_console
, (LPARAM
) cp
);
1400 if (sig
== SIGINT
|| sig
== SIGQUIT
)
1402 if (NILP (Vw32_start_process_share_console
) && cp
&& cp
->hwnd
)
1404 BYTE control_scan_code
= (BYTE
) MapVirtualKey (VK_CONTROL
, 0);
1405 /* Fake Ctrl-C for SIGINT, and Ctrl-Break for SIGQUIT. */
1406 BYTE vk_break_code
= (sig
== SIGINT
) ? 'C' : VK_CANCEL
;
1407 BYTE break_scan_code
= (BYTE
) MapVirtualKey (vk_break_code
, 0);
1408 HWND foreground_window
;
1410 if (break_scan_code
== 0)
1412 /* Fake Ctrl-C for SIGQUIT if we can't manage Ctrl-Break. */
1413 vk_break_code
= 'C';
1414 break_scan_code
= (BYTE
) MapVirtualKey (vk_break_code
, 0);
1417 foreground_window
= GetForegroundWindow ();
1418 if (foreground_window
)
1420 /* NT 5.0, and apparently also Windows 98, will not allow
1421 a Window to be set to foreground directly without the
1422 user's involvement. The workaround is to attach
1423 ourselves to the thread that owns the foreground
1424 window, since that is the only thread that can set the
1425 foreground window. */
1426 DWORD foreground_thread
, child_thread
;
1428 GetWindowThreadProcessId (foreground_window
, NULL
);
1429 if (foreground_thread
== GetCurrentThreadId ()
1430 || !AttachThreadInput (GetCurrentThreadId (),
1431 foreground_thread
, TRUE
))
1432 foreground_thread
= 0;
1434 child_thread
= GetWindowThreadProcessId (cp
->hwnd
, NULL
);
1435 if (child_thread
== GetCurrentThreadId ()
1436 || !AttachThreadInput (GetCurrentThreadId (),
1437 child_thread
, TRUE
))
1440 /* Set the foreground window to the child. */
1441 if (SetForegroundWindow (cp
->hwnd
))
1443 /* Generate keystrokes as if user had typed Ctrl-Break or
1445 keybd_event (VK_CONTROL
, control_scan_code
, 0, 0);
1446 keybd_event (vk_break_code
, break_scan_code
,
1447 (vk_break_code
== 'C' ? 0 : KEYEVENTF_EXTENDEDKEY
), 0);
1448 keybd_event (vk_break_code
, break_scan_code
,
1449 (vk_break_code
== 'C' ? 0 : KEYEVENTF_EXTENDEDKEY
)
1450 | KEYEVENTF_KEYUP
, 0);
1451 keybd_event (VK_CONTROL
, control_scan_code
,
1452 KEYEVENTF_KEYUP
, 0);
1454 /* Sleep for a bit to give time for Emacs frame to respond
1455 to focus change events (if Emacs was active app). */
1458 SetForegroundWindow (foreground_window
);
1460 /* Detach from the foreground and child threads now that
1461 the foreground switching is over. */
1462 if (foreground_thread
)
1463 AttachThreadInput (GetCurrentThreadId (),
1464 foreground_thread
, FALSE
);
1466 AttachThreadInput (GetCurrentThreadId (),
1467 child_thread
, FALSE
);
1470 /* Ctrl-Break is NT equivalent of SIGINT. */
1471 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT
, pid
))
1473 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
1474 "for pid %lu\n", GetLastError (), pid
));
1481 if (NILP (Vw32_start_process_share_console
) && cp
&& cp
->hwnd
)
1484 if (os_subtype
== OS_WIN95
)
1487 Another possibility is to try terminating the VDM out-right by
1488 calling the Shell VxD (id 0x17) V86 interface, function #4
1489 "SHELL_Destroy_VM", ie.
1495 First need to determine the current VM handle, and then arrange for
1496 the shellapi call to be made from the system vm (by using
1497 Switch_VM_and_callback).
1499 Could try to invoke DestroyVM through CallVxD.
1503 /* On Win95, posting WM_QUIT causes the 16-bit subsystem
1504 to hang when cmdproxy is used in conjunction with
1505 command.com for an interactive shell. Posting
1506 WM_CLOSE pops up a dialog that, when Yes is selected,
1507 does the same thing. TerminateProcess is also less
1508 than ideal in that subprocesses tend to stick around
1509 until the machine is shutdown, but at least it
1510 doesn't freeze the 16-bit subsystem. */
1511 PostMessage (cp
->hwnd
, WM_QUIT
, 0xff, 0);
1513 if (!TerminateProcess (proc_hand
, 0xff))
1515 DebPrint (("sys_kill.TerminateProcess returned %d "
1516 "for pid %lu\n", GetLastError (), pid
));
1523 PostMessage (cp
->hwnd
, WM_CLOSE
, 0, 0);
1525 /* Kill the process. On W32 this doesn't kill child processes
1526 so it doesn't work very well for shells which is why it's not
1527 used in every case. */
1528 else if (!TerminateProcess (proc_hand
, 0xff))
1530 DebPrint (("sys_kill.TerminateProcess returned %d "
1531 "for pid %lu\n", GetLastError (), pid
));
1538 CloseHandle (proc_hand
);
1543 /* extern int report_file_error (char *, Lisp_Object); */
1545 /* The following two routines are used to manipulate stdin, stdout, and
1546 stderr of our child processes.
1548 Assuming that in, out, and err are *not* inheritable, we make them
1549 stdin, stdout, and stderr of the child as follows:
1551 - Save the parent's current standard handles.
1552 - Set the std handles to inheritable duplicates of the ones being passed in.
1553 (Note that _get_osfhandle() is an io.h procedure that retrieves the
1554 NT file handle for a crt file descriptor.)
1555 - Spawn the child, which inherits in, out, and err as stdin,
1556 stdout, and stderr. (see Spawnve)
1557 - Close the std handles passed to the child.
1558 - Reset the parent's standard handles to the saved handles.
1559 (see reset_standard_handles)
1560 We assume that the caller closes in, out, and err after calling us. */
1563 prepare_standard_handles (int in
, int out
, int err
, HANDLE handles
[3])
1566 HANDLE newstdin
, newstdout
, newstderr
;
1568 parent
= GetCurrentProcess ();
1570 handles
[0] = GetStdHandle (STD_INPUT_HANDLE
);
1571 handles
[1] = GetStdHandle (STD_OUTPUT_HANDLE
);
1572 handles
[2] = GetStdHandle (STD_ERROR_HANDLE
);
1574 /* make inheritable copies of the new handles */
1575 if (!DuplicateHandle (parent
,
1576 (HANDLE
) _get_osfhandle (in
),
1581 DUPLICATE_SAME_ACCESS
))
1582 report_file_error ("Duplicating input handle for child", Qnil
);
1584 if (!DuplicateHandle (parent
,
1585 (HANDLE
) _get_osfhandle (out
),
1590 DUPLICATE_SAME_ACCESS
))
1591 report_file_error ("Duplicating output handle for child", Qnil
);
1593 if (!DuplicateHandle (parent
,
1594 (HANDLE
) _get_osfhandle (err
),
1599 DUPLICATE_SAME_ACCESS
))
1600 report_file_error ("Duplicating error handle for child", Qnil
);
1602 /* and store them as our std handles */
1603 if (!SetStdHandle (STD_INPUT_HANDLE
, newstdin
))
1604 report_file_error ("Changing stdin handle", Qnil
);
1606 if (!SetStdHandle (STD_OUTPUT_HANDLE
, newstdout
))
1607 report_file_error ("Changing stdout handle", Qnil
);
1609 if (!SetStdHandle (STD_ERROR_HANDLE
, newstderr
))
1610 report_file_error ("Changing stderr handle", Qnil
);
1614 reset_standard_handles (int in
, int out
, int err
, HANDLE handles
[3])
1616 /* close the duplicated handles passed to the child */
1617 CloseHandle (GetStdHandle (STD_INPUT_HANDLE
));
1618 CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE
));
1619 CloseHandle (GetStdHandle (STD_ERROR_HANDLE
));
1621 /* now restore parent's saved std handles */
1622 SetStdHandle (STD_INPUT_HANDLE
, handles
[0]);
1623 SetStdHandle (STD_OUTPUT_HANDLE
, handles
[1]);
1624 SetStdHandle (STD_ERROR_HANDLE
, handles
[2]);
1628 set_process_dir (char * dir
)
1635 /* To avoid problems with winsock implementations that work over dial-up
1636 connections causing or requiring a connection to exist while Emacs is
1637 running, Emacs no longer automatically loads winsock on startup if it
1638 is present. Instead, it will be loaded when open-network-stream is
1641 To allow full control over when winsock is loaded, we provide these
1642 two functions to dynamically load and unload winsock. This allows
1643 dial-up users to only be connected when they actually need to use
1647 extern HANDLE winsock_lib
;
1648 extern BOOL
term_winsock (void);
1649 extern BOOL
init_winsock (int load_now
);
1651 extern Lisp_Object Vsystem_name
;
1653 DEFUN ("w32-has-winsock", Fw32_has_winsock
, Sw32_has_winsock
, 0, 1, 0,
1654 doc
: /* Test for presence of the Windows socket library `winsock'.
1655 Returns non-nil if winsock support is present, nil otherwise.
1657 If the optional argument LOAD-NOW is non-nil, the winsock library is
1658 also loaded immediately if not already loaded. If winsock is loaded,
1659 the winsock local hostname is returned (since this may be different from
1660 the value of `system-name' and should supplant it), otherwise t is
1661 returned to indicate winsock support is present. */)
1663 Lisp_Object load_now
;
1667 have_winsock
= init_winsock (!NILP (load_now
));
1670 if (winsock_lib
!= NULL
)
1672 /* Return new value for system-name. The best way to do this
1673 is to call init_system_name, saving and restoring the
1674 original value to avoid side-effects. */
1675 Lisp_Object orig_hostname
= Vsystem_name
;
1676 Lisp_Object hostname
;
1678 init_system_name ();
1679 hostname
= Vsystem_name
;
1680 Vsystem_name
= orig_hostname
;
1688 DEFUN ("w32-unload-winsock", Fw32_unload_winsock
, Sw32_unload_winsock
,
1690 doc
: /* Unload the Windows socket library `winsock' if loaded.
1691 This is provided to allow dial-up socket connections to be disconnected
1692 when no longer needed. Returns nil without unloading winsock if any
1693 socket connections still exist. */)
1696 return term_winsock () ? Qt
: Qnil
;
1699 #endif /* HAVE_SOCKETS */
1702 /* Some miscellaneous functions that are Windows specific, but not GUI
1703 specific (ie. are applicable in terminal or batch mode as well). */
1705 /* lifted from fileio.c */
1706 #define CORRECT_DIR_SEPS(s) \
1707 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
1708 else unixtodos_filename (s); \
1711 DEFUN ("w32-short-file-name", Fw32_short_file_name
, Sw32_short_file_name
, 1, 1, 0,
1712 doc
: /* Return the short file name version (8.3) of the full path of FILENAME.
1713 If FILENAME does not exist, return nil.
1714 All path elements in FILENAME are converted to their short names. */)
1716 Lisp_Object filename
;
1718 char shortname
[MAX_PATH
];
1720 CHECK_STRING (filename
);
1722 /* first expand it. */
1723 filename
= Fexpand_file_name (filename
, Qnil
);
1725 /* luckily, this returns the short version of each element in the path. */
1726 if (GetShortPathName (SDATA (filename
), shortname
, MAX_PATH
) == 0)
1729 CORRECT_DIR_SEPS (shortname
);
1731 return build_string (shortname
);
1735 DEFUN ("w32-long-file-name", Fw32_long_file_name
, Sw32_long_file_name
,
1737 doc
: /* Return the long file name version of the full path of FILENAME.
1738 If FILENAME does not exist, return nil.
1739 All path elements in FILENAME are converted to their long names. */)
1741 Lisp_Object filename
;
1743 char longname
[ MAX_PATH
];
1745 CHECK_STRING (filename
);
1747 /* first expand it. */
1748 filename
= Fexpand_file_name (filename
, Qnil
);
1750 if (!w32_get_long_filename (SDATA (filename
), longname
, MAX_PATH
))
1753 CORRECT_DIR_SEPS (longname
);
1755 return build_string (longname
);
1758 DEFUN ("w32-set-process-priority", Fw32_set_process_priority
,
1759 Sw32_set_process_priority
, 2, 2, 0,
1760 doc
: /* Set the priority of PROCESS to PRIORITY.
1761 If PROCESS is nil, the priority of Emacs is changed, otherwise the
1762 priority of the process whose pid is PROCESS is changed.
1763 PRIORITY should be one of the symbols high, normal, or low;
1764 any other symbol will be interpreted as normal.
1766 If successful, the return value is t, otherwise nil. */)
1768 Lisp_Object process
, priority
;
1770 HANDLE proc_handle
= GetCurrentProcess ();
1771 DWORD priority_class
= NORMAL_PRIORITY_CLASS
;
1772 Lisp_Object result
= Qnil
;
1774 CHECK_SYMBOL (priority
);
1776 if (!NILP (process
))
1781 CHECK_NUMBER (process
);
1783 /* Allow pid to be an internally generated one, or one obtained
1784 externally. This is necessary because real pids on Win95 are
1787 pid
= XINT (process
);
1788 cp
= find_child_pid (pid
);
1790 pid
= cp
->procinfo
.dwProcessId
;
1792 proc_handle
= OpenProcess (PROCESS_SET_INFORMATION
, FALSE
, pid
);
1795 if (EQ (priority
, Qhigh
))
1796 priority_class
= HIGH_PRIORITY_CLASS
;
1797 else if (EQ (priority
, Qlow
))
1798 priority_class
= IDLE_PRIORITY_CLASS
;
1800 if (proc_handle
!= NULL
)
1802 if (SetPriorityClass (proc_handle
, priority_class
))
1804 if (!NILP (process
))
1805 CloseHandle (proc_handle
);
1812 DEFUN ("w32-get-locale-info", Fw32_get_locale_info
,
1813 Sw32_get_locale_info
, 1, 2, 0,
1814 doc
: /* Return information about the Windows locale LCID.
1815 By default, return a three letter locale code which encodes the default
1816 language as the first two characters, and the country or regionial variant
1817 as the third letter. For example, ENU refers to `English (United States)',
1818 while ENC means `English (Canadian)'.
1820 If the optional argument LONGFORM is t, the long form of the locale
1821 name is returned, e.g. `English (United States)' instead; if LONGFORM
1822 is a number, it is interpreted as an LCTYPE constant and the corresponding
1823 locale information is returned.
1825 If LCID (a 16-bit number) is not a valid locale, the result is nil. */)
1827 Lisp_Object lcid
, longform
;
1831 char abbrev_name
[32] = { 0 };
1832 char full_name
[256] = { 0 };
1834 CHECK_NUMBER (lcid
);
1836 if (!IsValidLocale (XINT (lcid
), LCID_SUPPORTED
))
1839 if (NILP (longform
))
1841 got_abbrev
= GetLocaleInfo (XINT (lcid
),
1842 LOCALE_SABBREVLANGNAME
| LOCALE_USE_CP_ACP
,
1843 abbrev_name
, sizeof (abbrev_name
));
1845 return build_string (abbrev_name
);
1847 else if (EQ (longform
, Qt
))
1849 got_full
= GetLocaleInfo (XINT (lcid
),
1850 LOCALE_SLANGUAGE
| LOCALE_USE_CP_ACP
,
1851 full_name
, sizeof (full_name
));
1853 return build_string (full_name
);
1855 else if (NUMBERP (longform
))
1857 got_full
= GetLocaleInfo (XINT (lcid
),
1859 full_name
, sizeof (full_name
));
1861 return make_unibyte_string (full_name
, got_full
);
1868 DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id
,
1869 Sw32_get_current_locale_id
, 0, 0, 0,
1870 doc
: /* Return Windows locale id for current locale setting.
1871 This is a numerical value; use `w32-get-locale-info' to convert to a
1872 human-readable form. */)
1875 return make_number (GetThreadLocale ());
1878 DWORD
int_from_hex (char * s
)
1881 static char hex
[] = "0123456789abcdefABCDEF";
1884 while (*s
&& (p
= strchr(hex
, *s
)) != NULL
)
1886 unsigned digit
= p
- hex
;
1889 val
= val
* 16 + digit
;
1895 /* We need to build a global list, since the EnumSystemLocale callback
1896 function isn't given a context pointer. */
1897 Lisp_Object Vw32_valid_locale_ids
;
1899 BOOL CALLBACK
enum_locale_fn (LPTSTR localeNum
)
1901 DWORD id
= int_from_hex (localeNum
);
1902 Vw32_valid_locale_ids
= Fcons (make_number (id
), Vw32_valid_locale_ids
);
1906 DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids
,
1907 Sw32_get_valid_locale_ids
, 0, 0, 0,
1908 doc
: /* Return list of all valid Windows locale ids.
1909 Each id is a numerical value; use `w32-get-locale-info' to convert to a
1910 human-readable form. */)
1913 Vw32_valid_locale_ids
= Qnil
;
1915 EnumSystemLocales (enum_locale_fn
, LCID_SUPPORTED
);
1917 Vw32_valid_locale_ids
= Fnreverse (Vw32_valid_locale_ids
);
1918 return Vw32_valid_locale_ids
;
1922 DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id
, Sw32_get_default_locale_id
, 0, 1, 0,
1923 doc
: /* Return Windows locale id for default locale setting.
1924 By default, the system default locale setting is returned; if the optional
1925 parameter USERP is non-nil, the user default locale setting is returned.
1926 This is a numerical value; use `w32-get-locale-info' to convert to a
1927 human-readable form. */)
1932 return make_number (GetSystemDefaultLCID ());
1933 return make_number (GetUserDefaultLCID ());
1937 DEFUN ("w32-set-current-locale", Fw32_set_current_locale
, Sw32_set_current_locale
, 1, 1, 0,
1938 doc
: /* Make Windows locale LCID be the current locale setting for Emacs.
1939 If successful, the new locale id is returned, otherwise nil. */)
1943 CHECK_NUMBER (lcid
);
1945 if (!IsValidLocale (XINT (lcid
), LCID_SUPPORTED
))
1948 if (!SetThreadLocale (XINT (lcid
)))
1951 /* Need to set input thread locale if present. */
1952 if (dwWindowsThreadId
)
1953 /* Reply is not needed. */
1954 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_SETLOCALE
, XINT (lcid
), 0);
1956 return make_number (GetThreadLocale ());
1960 /* We need to build a global list, since the EnumCodePages callback
1961 function isn't given a context pointer. */
1962 Lisp_Object Vw32_valid_codepages
;
1964 BOOL CALLBACK
enum_codepage_fn (LPTSTR codepageNum
)
1966 DWORD id
= atoi (codepageNum
);
1967 Vw32_valid_codepages
= Fcons (make_number (id
), Vw32_valid_codepages
);
1971 DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages
,
1972 Sw32_get_valid_codepages
, 0, 0, 0,
1973 doc
: /* Return list of all valid Windows codepages. */)
1976 Vw32_valid_codepages
= Qnil
;
1978 EnumSystemCodePages (enum_codepage_fn
, CP_SUPPORTED
);
1980 Vw32_valid_codepages
= Fnreverse (Vw32_valid_codepages
);
1981 return Vw32_valid_codepages
;
1985 DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage
,
1986 Sw32_get_console_codepage
, 0, 0, 0,
1987 doc
: /* Return current Windows codepage for console input. */)
1990 return make_number (GetConsoleCP ());
1994 DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage
,
1995 Sw32_set_console_codepage
, 1, 1, 0,
1996 doc
: /* Make Windows codepage CP be the current codepage setting for Emacs.
1997 The codepage setting affects keyboard input and display in tty mode.
1998 If successful, the new CP is returned, otherwise nil. */)
2004 if (!IsValidCodePage (XINT (cp
)))
2007 if (!SetConsoleCP (XINT (cp
)))
2010 return make_number (GetConsoleCP ());
2014 DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage
,
2015 Sw32_get_console_output_codepage
, 0, 0, 0,
2016 doc
: /* Return current Windows codepage for console output. */)
2019 return make_number (GetConsoleOutputCP ());
2023 DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage
,
2024 Sw32_set_console_output_codepage
, 1, 1, 0,
2025 doc
: /* Make Windows codepage CP be the current codepage setting for Emacs.
2026 The codepage setting affects keyboard input and display in tty mode.
2027 If successful, the new CP is returned, otherwise nil. */)
2033 if (!IsValidCodePage (XINT (cp
)))
2036 if (!SetConsoleOutputCP (XINT (cp
)))
2039 return make_number (GetConsoleOutputCP ());
2043 DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset
,
2044 Sw32_get_codepage_charset
, 1, 1, 0,
2045 doc
: /* Return charset of codepage CP.
2046 Returns nil if the codepage is not valid. */)
2054 if (!IsValidCodePage (XINT (cp
)))
2057 if (TranslateCharsetInfo ((DWORD
*) XINT (cp
), &info
, TCI_SRCCODEPAGE
))
2058 return make_number (info
.ciCharset
);
2064 DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts
,
2065 Sw32_get_valid_keyboard_layouts
, 0, 0, 0,
2066 doc
: /* Return list of Windows keyboard languages and layouts.
2067 The return value is a list of pairs of language id and layout id. */)
2070 int num_layouts
= GetKeyboardLayoutList (0, NULL
);
2071 HKL
* layouts
= (HKL
*) alloca (num_layouts
* sizeof (HKL
));
2072 Lisp_Object obj
= Qnil
;
2074 if (GetKeyboardLayoutList (num_layouts
, layouts
) == num_layouts
)
2076 while (--num_layouts
>= 0)
2078 DWORD kl
= (DWORD
) layouts
[num_layouts
];
2080 obj
= Fcons (Fcons (make_number (kl
& 0xffff),
2081 make_number ((kl
>> 16) & 0xffff)),
2090 DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout
,
2091 Sw32_get_keyboard_layout
, 0, 0, 0,
2092 doc
: /* Return current Windows keyboard language and layout.
2093 The return value is the cons of the language id and the layout id. */)
2096 DWORD kl
= (DWORD
) GetKeyboardLayout (dwWindowsThreadId
);
2098 return Fcons (make_number (kl
& 0xffff),
2099 make_number ((kl
>> 16) & 0xffff));
2103 DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout
,
2104 Sw32_set_keyboard_layout
, 1, 1, 0,
2105 doc
: /* Make LAYOUT be the current keyboard layout for Emacs.
2106 The keyboard layout setting affects interpretation of keyboard input.
2107 If successful, the new layout id is returned, otherwise nil. */)
2113 CHECK_CONS (layout
);
2114 CHECK_NUMBER_CAR (layout
);
2115 CHECK_NUMBER_CDR (layout
);
2117 kl
= (XINT (XCAR (layout
)) & 0xffff)
2118 | (XINT (XCDR (layout
)) << 16);
2120 /* Synchronize layout with input thread. */
2121 if (dwWindowsThreadId
)
2123 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_SETKEYBOARDLAYOUT
,
2127 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
2129 if (msg
.wParam
== 0)
2133 else if (!ActivateKeyboardLayout ((HKL
) kl
, 0))
2136 return Fw32_get_keyboard_layout ();
2142 Qhigh
= intern ("high");
2143 Qlow
= intern ("low");
2146 defsubr (&Sw32_has_winsock
);
2147 defsubr (&Sw32_unload_winsock
);
2149 defsubr (&Sw32_short_file_name
);
2150 defsubr (&Sw32_long_file_name
);
2151 defsubr (&Sw32_set_process_priority
);
2152 defsubr (&Sw32_get_locale_info
);
2153 defsubr (&Sw32_get_current_locale_id
);
2154 defsubr (&Sw32_get_default_locale_id
);
2155 defsubr (&Sw32_get_valid_locale_ids
);
2156 defsubr (&Sw32_set_current_locale
);
2158 defsubr (&Sw32_get_console_codepage
);
2159 defsubr (&Sw32_set_console_codepage
);
2160 defsubr (&Sw32_get_console_output_codepage
);
2161 defsubr (&Sw32_set_console_output_codepage
);
2162 defsubr (&Sw32_get_valid_codepages
);
2163 defsubr (&Sw32_get_codepage_charset
);
2165 defsubr (&Sw32_get_valid_keyboard_layouts
);
2166 defsubr (&Sw32_get_keyboard_layout
);
2167 defsubr (&Sw32_set_keyboard_layout
);
2169 DEFVAR_LISP ("w32-quote-process-args", &Vw32_quote_process_args
,
2170 doc
: /* Non-nil enables quoting of process arguments to ensure correct parsing.
2171 Because Windows does not directly pass argv arrays to child processes,
2172 programs have to reconstruct the argv array by parsing the command
2173 line string. For an argument to contain a space, it must be enclosed
2174 in double quotes or it will be parsed as multiple arguments.
2176 If the value is a character, that character will be used to escape any
2177 quote characters that appear, otherwise a suitable escape character
2178 will be chosen based on the type of the program. */);
2179 Vw32_quote_process_args
= Qt
;
2181 DEFVAR_LISP ("w32-start-process-show-window",
2182 &Vw32_start_process_show_window
,
2183 doc
: /* When nil, new child processes hide their windows.
2184 When non-nil, they show their window in the method of their choice.
2185 This variable doesn't affect GUI applications, which will never be hidden. */);
2186 Vw32_start_process_show_window
= Qnil
;
2188 DEFVAR_LISP ("w32-start-process-share-console",
2189 &Vw32_start_process_share_console
,
2190 doc
: /* When nil, new child processes are given a new console.
2191 When non-nil, they share the Emacs console; this has the limitation of
2192 allowing only one DOS subprocess to run at a time (whether started directly
2193 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
2194 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
2195 otherwise respond to interrupts from Emacs. */);
2196 Vw32_start_process_share_console
= Qnil
;
2198 DEFVAR_LISP ("w32-start-process-inherit-error-mode",
2199 &Vw32_start_process_inherit_error_mode
,
2200 doc
: /* When nil, new child processes revert to the default error mode.
2201 When non-nil, they inherit their error mode setting from Emacs, which stops
2202 them blocking when trying to access unmounted drives etc. */);
2203 Vw32_start_process_inherit_error_mode
= Qt
;
2205 DEFVAR_INT ("w32-pipe-read-delay", &Vw32_pipe_read_delay
,
2206 doc
: /* Forced delay before reading subprocess output.
2207 This is done to improve the buffering of subprocess output, by
2208 avoiding the inefficiency of frequently reading small amounts of data.
2210 If positive, the value is the number of milliseconds to sleep before
2211 reading the subprocess output. If negative, the magnitude is the number
2212 of time slices to wait (effectively boosting the priority of the child
2213 process temporarily). A value of zero disables waiting entirely. */);
2214 Vw32_pipe_read_delay
= 50;
2216 DEFVAR_LISP ("w32-downcase-file-names", &Vw32_downcase_file_names
,
2217 doc
: /* Non-nil means convert all-upper case file names to lower case.
2218 This applies when performing completions and file name expansion.
2219 Note that the value of this setting also affects remote file names,
2220 so you probably don't want to set to non-nil if you use case-sensitive
2221 filesystems via ange-ftp. */);
2222 Vw32_downcase_file_names
= Qnil
;
2225 DEFVAR_LISP ("w32-generate-fake-inodes", &Vw32_generate_fake_inodes
,
2226 doc
: /* Non-nil means attempt to fake realistic inode values.
2227 This works by hashing the truename of files, and should detect
2228 aliasing between long and short (8.3 DOS) names, but can have
2229 false positives because of hash collisions. Note that determing
2230 the truename of a file can be slow. */);
2231 Vw32_generate_fake_inodes
= Qnil
;
2234 DEFVAR_LISP ("w32-get-true-file-attributes", &Vw32_get_true_file_attributes
,
2235 doc
: /* Non-nil means determine accurate link count in `file-attributes'.
2236 Note that this option is only useful for files on NTFS volumes, where hard links
2237 are supported. Moreover, it slows down `file-attributes' noticeably. */);
2238 Vw32_get_true_file_attributes
= Qt
;
2240 /* end of ntproc.c */
2242 /* arch-tag: 23d3a34c-06d2-48a1-833b-ac7609aa5250
2243 (do not change this comment) */