16884
|
1 /* Process support for GNU Emacs on the Microsoft W32 API.
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
2 Copyright (C) 1992, 1995, 1999 Free Software Foundation, Inc.
|
9907
|
3
|
14186
|
4 This file is part of GNU Emacs.
|
9907
|
5
|
14186
|
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)
|
|
9 any later version.
|
9907
|
10
|
14186
|
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.
|
9907
|
15
|
14186
|
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.
|
9907
|
20
|
|
21 Drew Bliss Oct 14, 1993
|
|
22 Adapted from alarm.c by Tim Fleehart
|
|
23 */
|
|
24
|
|
25 #include <stdio.h>
|
|
26 #include <stdlib.h>
|
|
27 #include <errno.h>
|
|
28 #include <io.h>
|
15145
|
29 #include <fcntl.h>
|
9907
|
30 #include <signal.h>
|
|
31
|
15145
|
32 /* must include CRT headers *before* config.h */
|
|
33 #include "config.h"
|
|
34 #undef signal
|
|
35 #undef wait
|
|
36 #undef spawnve
|
|
37 #undef select
|
|
38 #undef kill
|
|
39
|
9907
|
40 #include <windows.h>
|
|
41
|
|
42 #include "lisp.h"
|
16593
|
43 #include "w32.h"
|
19712
|
44 #include "w32heap.h"
|
9907
|
45 #include "systime.h"
|
13931
|
46 #include "syswait.h"
|
|
47 #include "process.h"
|
21613
|
48 #include "w32term.h"
|
13931
|
49
|
15201
|
50 /* Control whether spawnve quotes arguments as necessary to ensure
|
|
51 correct parsing by child process. Because not all uses of spawnve
|
|
52 are careful about constructing argv arrays, we make this behaviour
|
|
53 conditional (off by default). */
|
16588
|
54 Lisp_Object Vw32_quote_process_args;
|
15201
|
55
|
16000
|
56 /* Control whether create_child causes the process' window to be
|
|
57 hidden. The default is nil. */
|
16588
|
58 Lisp_Object Vw32_start_process_show_window;
|
16000
|
59
|
19712
|
60 /* Control whether create_child causes the process to inherit Emacs'
|
|
61 console window, or be given a new one of its own. The default is
|
|
62 nil, to allow multiple DOS programs to run on Win95. Having separate
|
|
63 consoles also allows Emacs to cleanly terminate process groups. */
|
|
64 Lisp_Object Vw32_start_process_share_console;
|
|
65
|
23949
|
66 /* Control whether create_child cause the process to inherit Emacs'
|
|
67 error mode setting. The default is t, to minimize the possibility of
|
|
68 subprocesses blocking when accessing unmounted drives. */
|
|
69 Lisp_Object Vw32_start_process_inherit_error_mode;
|
|
70
|
15247
|
71 /* Time to sleep before reading from a subprocess output pipe - this
|
|
72 avoids the inefficiency of frequently reading small amounts of data.
|
|
73 This is primarily necessary for handling DOS processes on Windows 95,
|
16884
|
74 but is useful for W32 processes on both Windows 95 and NT as well. */
|
16588
|
75 Lisp_Object Vw32_pipe_read_delay;
|
15247
|
76
|
15325
|
77 /* Control conversion of upper case file names to lower case.
|
|
78 nil means no, t means yes. */
|
16588
|
79 Lisp_Object Vw32_downcase_file_names;
|
15325
|
80
|
19712
|
81 /* Control whether stat() attempts to generate fake but hopefully
|
|
82 "accurate" inode values, by hashing the absolute truenames of files.
|
|
83 This should detect aliasing between long and short names, but still
|
|
84 allows the possibility of hash collisions. */
|
|
85 Lisp_Object Vw32_generate_fake_inodes;
|
|
86
|
|
87 /* Control whether stat() attempts to determine file type and link count
|
|
88 exactly, at the expense of slower operation. Since true hard links
|
|
89 are supported on NTFS volumes, this is only relevant on NT. */
|
|
90 Lisp_Object Vw32_get_true_file_attributes;
|
|
91
|
|
92 Lisp_Object Qhigh, Qlow;
|
15247
|
93
|
15145
|
94 #ifdef EMACSDEBUG
|
|
95 void _DebPrint (const char *fmt, ...)
|
9907
|
96 {
|
15145
|
97 char buf[1024];
|
9907
|
98 va_list args;
|
|
99
|
|
100 va_start (args, fmt);
|
|
101 vsprintf (buf, fmt, args);
|
|
102 va_end (args);
|
|
103 OutputDebugString (buf);
|
|
104 }
|
|
105 #endif
|
|
106
|
15145
|
107 typedef void (_CALLBACK_ *signal_handler)(int);
|
9907
|
108
|
|
109 /* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */
|
|
110 static signal_handler sig_handlers[NSIG];
|
|
111
|
|
112 /* Fake signal implementation to record the SIGCHLD handler. */
|
|
113 signal_handler
|
15145
|
114 sys_signal (int sig, signal_handler handler)
|
9907
|
115 {
|
|
116 signal_handler old;
|
|
117
|
|
118 if (sig != SIGCHLD)
|
|
119 {
|
|
120 errno = EINVAL;
|
|
121 return SIG_ERR;
|
|
122 }
|
|
123 old = sig_handlers[sig];
|
|
124 sig_handlers[sig] = handler;
|
|
125 return old;
|
|
126 }
|
|
127
|
15145
|
128 /* Defined in <process.h> which conflicts with the local copy */
|
|
129 #define _P_NOWAIT 1
|
|
130
|
|
131 /* Child process management list. */
|
|
132 int child_proc_count = 0;
|
|
133 child_process child_procs[ MAX_CHILDREN ];
|
|
134 child_process *dead_child = NULL;
|
|
135
|
|
136 DWORD WINAPI reader_thread (void *arg);
|
|
137
|
9907
|
138 /* Find an unused process slot. */
|
15145
|
139 child_process *
|
9907
|
140 new_child (void)
|
|
141 {
|
|
142 child_process *cp;
|
15145
|
143 DWORD id;
|
9907
|
144
|
|
145 for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--)
|
|
146 if (!CHILD_ACTIVE (cp))
|
15145
|
147 goto Initialise;
|
|
148 if (child_proc_count == MAX_CHILDREN)
|
|
149 return NULL;
|
|
150 cp = &child_procs[child_proc_count++];
|
|
151
|
|
152 Initialise:
|
|
153 memset (cp, 0, sizeof(*cp));
|
|
154 cp->fd = -1;
|
|
155 cp->pid = -1;
|
|
156 cp->procinfo.hProcess = NULL;
|
|
157 cp->status = STATUS_READ_ERROR;
|
|
158
|
|
159 /* use manual reset event so that select() will function properly */
|
|
160 cp->char_avail = CreateEvent (NULL, TRUE, FALSE, NULL);
|
|
161 if (cp->char_avail)
|
|
162 {
|
|
163 cp->char_consumed = CreateEvent (NULL, FALSE, FALSE, NULL);
|
|
164 if (cp->char_consumed)
|
|
165 {
|
|
166 cp->thrd = CreateThread (NULL, 1024, reader_thread, cp, 0, &id);
|
|
167 if (cp->thrd)
|
|
168 return cp;
|
|
169 }
|
|
170 }
|
|
171 delete_child (cp);
|
|
172 return NULL;
|
|
173 }
|
|
174
|
|
175 void
|
|
176 delete_child (child_process *cp)
|
|
177 {
|
|
178 int i;
|
|
179
|
|
180 /* Should not be deleting a child that is still needed. */
|
|
181 for (i = 0; i < MAXDESC; i++)
|
|
182 if (fd_info[i].cp == cp)
|
|
183 abort ();
|
|
184
|
|
185 if (!CHILD_ACTIVE (cp))
|
|
186 return;
|
|
187
|
|
188 /* reap thread if necessary */
|
|
189 if (cp->thrd)
|
|
190 {
|
|
191 DWORD rc;
|
|
192
|
|
193 if (GetExitCodeThread (cp->thrd, &rc) && rc == STILL_ACTIVE)
|
|
194 {
|
|
195 /* let the thread exit cleanly if possible */
|
|
196 cp->status = STATUS_READ_ERROR;
|
|
197 SetEvent (cp->char_consumed);
|
|
198 if (WaitForSingleObject (cp->thrd, 1000) != WAIT_OBJECT_0)
|
|
199 {
|
|
200 DebPrint (("delete_child.WaitForSingleObject (thread) failed "
|
|
201 "with %lu for fd %ld\n", GetLastError (), cp->fd));
|
|
202 TerminateThread (cp->thrd, 0);
|
|
203 }
|
|
204 }
|
|
205 CloseHandle (cp->thrd);
|
|
206 cp->thrd = NULL;
|
|
207 }
|
|
208 if (cp->char_avail)
|
|
209 {
|
|
210 CloseHandle (cp->char_avail);
|
|
211 cp->char_avail = NULL;
|
|
212 }
|
|
213 if (cp->char_consumed)
|
|
214 {
|
|
215 CloseHandle (cp->char_consumed);
|
|
216 cp->char_consumed = NULL;
|
|
217 }
|
|
218
|
|
219 /* update child_proc_count (highest numbered slot in use plus one) */
|
|
220 if (cp == child_procs + child_proc_count - 1)
|
|
221 {
|
|
222 for (i = child_proc_count-1; i >= 0; i--)
|
|
223 if (CHILD_ACTIVE (&child_procs[i]))
|
|
224 {
|
|
225 child_proc_count = i + 1;
|
|
226 break;
|
|
227 }
|
|
228 }
|
|
229 if (i < 0)
|
|
230 child_proc_count = 0;
|
9907
|
231 }
|
|
232
|
|
233 /* Find a child by pid. */
|
|
234 static child_process *
|
|
235 find_child_pid (DWORD pid)
|
|
236 {
|
|
237 child_process *cp;
|
15145
|
238
|
9907
|
239 for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--)
|
|
240 if (CHILD_ACTIVE (cp) && pid == cp->pid)
|
|
241 return cp;
|
|
242 return NULL;
|
|
243 }
|
|
244
|
|
245
|
15145
|
246 /* Thread proc for child process and socket reader threads. Each thread
|
|
247 is normally blocked until woken by select() to check for input by
|
|
248 reading one char. When the read completes, char_avail is signalled
|
|
249 to wake up the select emulator and the thread blocks itself again. */
|
9907
|
250 DWORD WINAPI
|
|
251 reader_thread (void *arg)
|
|
252 {
|
|
253 child_process *cp;
|
|
254
|
|
255 /* Our identity */
|
|
256 cp = (child_process *)arg;
|
|
257
|
|
258 /* We have to wait for the go-ahead before we can start */
|
19712
|
259 if (cp == NULL
|
|
260 || WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0)
|
15145
|
261 return 1;
|
|
262
|
9907
|
263 for (;;)
|
|
264 {
|
15145
|
265 int rc;
|
|
266
|
|
267 rc = _sys_read_ahead (cp->fd);
|
|
268
|
|
269 /* The name char_avail is a misnomer - it really just means the
|
|
270 read-ahead has completed, whether successfully or not. */
|
9907
|
271 if (!SetEvent (cp->char_avail))
|
|
272 {
|
|
273 DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld\n",
|
|
274 GetLastError (), cp->fd));
|
15145
|
275 return 1;
|
|
276 }
|
|
277
|
|
278 if (rc == STATUS_READ_ERROR)
|
|
279 return 1;
|
9907
|
280
|
|
281 /* If the read died, the child has died so let the thread die */
|
15145
|
282 if (rc == STATUS_READ_FAILED)
|
9907
|
283 break;
|
|
284
|
|
285 /* Wait until our input is acknowledged before reading again */
|
|
286 if (WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0)
|
|
287 {
|
|
288 DebPrint (("reader_thread.WaitForSingleObject failed with "
|
|
289 "%lu for fd %ld\n", GetLastError (), cp->fd));
|
|
290 break;
|
|
291 }
|
|
292 }
|
|
293 return 0;
|
|
294 }
|
|
295
|
19712
|
296 /* To avoid Emacs changing directory, we just record here the directory
|
|
297 the new process should start in. This is set just before calling
|
|
298 sys_spawnve, and is not generally valid at any other time. */
|
|
299 static char * process_dir;
|
|
300
|
9907
|
301 static BOOL
|
|
302 create_child (char *exe, char *cmdline, char *env,
|
15145
|
303 int * pPid, child_process *cp)
|
9907
|
304 {
|
|
305 STARTUPINFO start;
|
|
306 SECURITY_ATTRIBUTES sec_attrs;
|
|
307 SECURITY_DESCRIPTOR sec_desc;
|
23949
|
308 DWORD flags;
|
19712
|
309 char dir[ MAXPATHLEN ];
|
9907
|
310
|
15145
|
311 if (cp == NULL) abort ();
|
9907
|
312
|
|
313 memset (&start, 0, sizeof (start));
|
|
314 start.cb = sizeof (start);
|
|
315
|
13425
|
316 #ifdef HAVE_NTGUI
|
16588
|
317 if (NILP (Vw32_start_process_show_window))
|
16000
|
318 start.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW;
|
|
319 else
|
|
320 start.dwFlags = STARTF_USESTDHANDLES;
|
13425
|
321 start.wShowWindow = SW_HIDE;
|
|
322
|
|
323 start.hStdInput = GetStdHandle (STD_INPUT_HANDLE);
|
|
324 start.hStdOutput = GetStdHandle (STD_OUTPUT_HANDLE);
|
|
325 start.hStdError = GetStdHandle (STD_ERROR_HANDLE);
|
|
326 #endif /* HAVE_NTGUI */
|
|
327
|
9907
|
328 /* Explicitly specify no security */
|
|
329 if (!InitializeSecurityDescriptor (&sec_desc, SECURITY_DESCRIPTOR_REVISION))
|
15145
|
330 goto EH_Fail;
|
9907
|
331 if (!SetSecurityDescriptorDacl (&sec_desc, TRUE, NULL, FALSE))
|
15145
|
332 goto EH_Fail;
|
9907
|
333 sec_attrs.nLength = sizeof (sec_attrs);
|
|
334 sec_attrs.lpSecurityDescriptor = &sec_desc;
|
|
335 sec_attrs.bInheritHandle = FALSE;
|
|
336
|
19712
|
337 strcpy (dir, process_dir);
|
|
338 unixtodos_filename (dir);
|
23949
|
339
|
|
340 flags = (!NILP (Vw32_start_process_share_console)
|
|
341 ? CREATE_NEW_PROCESS_GROUP
|
|
342 : CREATE_NEW_CONSOLE);
|
|
343 if (NILP (Vw32_start_process_inherit_error_mode))
|
|
344 flags |= CREATE_DEFAULT_ERROR_MODE;
|
9907
|
345 if (!CreateProcess (exe, cmdline, &sec_attrs, NULL, TRUE,
|
23949
|
346 flags, env, dir, &start, &cp->procinfo))
|
15145
|
347 goto EH_Fail;
|
|
348
|
|
349 cp->pid = (int) cp->procinfo.dwProcessId;
|
|
350
|
|
351 /* Hack for Windows 95, which assigns large (ie negative) pids */
|
|
352 if (cp->pid < 0)
|
|
353 cp->pid = -cp->pid;
|
|
354
|
|
355 /* pid must fit in a Lisp_Int */
|
|
356 cp->pid = (cp->pid & VALMASK);
|
|
357
|
19712
|
358 *pPid = cp->pid;
|
15145
|
359
|
9907
|
360 return TRUE;
|
19712
|
361
|
9907
|
362 EH_Fail:
|
15145
|
363 DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError()););
|
9907
|
364 return FALSE;
|
|
365 }
|
|
366
|
|
367 /* create_child doesn't know what emacs' file handle will be for waiting
|
|
368 on output from the child, so we need to make this additional call
|
|
369 to register the handle with the process
|
|
370 This way the select emulator knows how to match file handles with
|
|
371 entries in child_procs. */
|
|
372 void
|
|
373 register_child (int pid, int fd)
|
|
374 {
|
|
375 child_process *cp;
|
|
376
|
|
377 cp = find_child_pid (pid);
|
|
378 if (cp == NULL)
|
|
379 {
|
|
380 DebPrint (("register_child unable to find pid %lu\n", pid));
|
|
381 return;
|
|
382 }
|
|
383
|
|
384 #ifdef FULL_DEBUG
|
|
385 DebPrint (("register_child registered fd %d with pid %lu\n", fd, pid));
|
|
386 #endif
|
|
387
|
|
388 cp->fd = fd;
|
15145
|
389
|
|
390 /* thread is initially blocked until select is called; set status so
|
|
391 that select will release thread */
|
|
392 cp->status = STATUS_READ_ACKNOWLEDGED;
|
9907
|
393
|
15145
|
394 /* attach child_process to fd_info */
|
|
395 if (fd_info[fd].cp != NULL)
|
9907
|
396 {
|
15145
|
397 DebPrint (("register_child: fd_info[%d] apparently in use!\n", fd));
|
|
398 abort ();
|
9907
|
399 }
|
15145
|
400
|
|
401 fd_info[fd].cp = cp;
|
9907
|
402 }
|
|
403
|
|
404 /* When a process dies its pipe will break so the reader thread will
|
|
405 signal failure to the select emulator.
|
|
406 The select emulator then calls this routine to clean up.
|
|
407 Since the thread signaled failure we can assume it is exiting. */
|
|
408 static void
|
15145
|
409 reap_subprocess (child_process *cp)
|
9907
|
410 {
|
15145
|
411 if (cp->procinfo.hProcess)
|
9907
|
412 {
|
15145
|
413 /* Reap the process */
|
19712
|
414 #ifdef FULL_DEBUG
|
|
415 /* Process should have already died before we are called. */
|
|
416 if (WaitForSingleObject (cp->procinfo.hProcess, 0) != WAIT_OBJECT_0)
|
|
417 DebPrint (("reap_subprocess: child fpr fd %d has not died yet!", cp->fd));
|
|
418 #endif
|
15145
|
419 CloseHandle (cp->procinfo.hProcess);
|
|
420 cp->procinfo.hProcess = NULL;
|
|
421 CloseHandle (cp->procinfo.hThread);
|
|
422 cp->procinfo.hThread = NULL;
|
9907
|
423 }
|
15145
|
424
|
|
425 /* For asynchronous children, the child_proc resources will be freed
|
|
426 when the last pipe read descriptor is closed; for synchronous
|
|
427 children, we must explicitly free the resources now because
|
|
428 register_child has not been called. */
|
|
429 if (cp->fd == -1)
|
|
430 delete_child (cp);
|
9907
|
431 }
|
|
432
|
|
433 /* Wait for any of our existing child processes to die
|
|
434 When it does, close its handle
|
|
435 Return the pid and fill in the status if non-NULL. */
|
11388
|
436
|
9907
|
437 int
|
15145
|
438 sys_wait (int *status)
|
9907
|
439 {
|
|
440 DWORD active, retval;
|
|
441 int nh;
|
15145
|
442 int pid;
|
9907
|
443 child_process *cp, *cps[MAX_CHILDREN];
|
|
444 HANDLE wait_hnd[MAX_CHILDREN];
|
|
445
|
|
446 nh = 0;
|
|
447 if (dead_child != NULL)
|
|
448 {
|
|
449 /* We want to wait for a specific child */
|
15145
|
450 wait_hnd[nh] = dead_child->procinfo.hProcess;
|
9907
|
451 cps[nh] = dead_child;
|
15145
|
452 if (!wait_hnd[nh]) abort ();
|
9907
|
453 nh++;
|
19712
|
454 active = 0;
|
|
455 goto get_result;
|
9907
|
456 }
|
|
457 else
|
|
458 {
|
|
459 for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--)
|
15145
|
460 /* some child_procs might be sockets; ignore them */
|
|
461 if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess)
|
9907
|
462 {
|
15145
|
463 wait_hnd[nh] = cp->procinfo.hProcess;
|
9907
|
464 cps[nh] = cp;
|
|
465 nh++;
|
|
466 }
|
|
467 }
|
|
468
|
|
469 if (nh == 0)
|
|
470 {
|
|
471 /* Nothing to wait on, so fail */
|
|
472 errno = ECHILD;
|
|
473 return -1;
|
|
474 }
|
19712
|
475
|
|
476 do
|
|
477 {
|
|
478 /* Check for quit about once a second. */
|
|
479 QUIT;
|
|
480 active = WaitForMultipleObjects (nh, wait_hnd, FALSE, 1000);
|
|
481 } while (active == WAIT_TIMEOUT);
|
|
482
|
9907
|
483 if (active == WAIT_FAILED)
|
|
484 {
|
|
485 errno = EBADF;
|
|
486 return -1;
|
|
487 }
|
19712
|
488 else if (active >= WAIT_OBJECT_0
|
|
489 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
|
9907
|
490 {
|
|
491 active -= WAIT_OBJECT_0;
|
|
492 }
|
19712
|
493 else if (active >= WAIT_ABANDONED_0
|
|
494 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
|
9907
|
495 {
|
|
496 active -= WAIT_ABANDONED_0;
|
|
497 }
|
19712
|
498 else
|
|
499 abort ();
|
|
500
|
|
501 get_result:
|
9907
|
502 if (!GetExitCodeProcess (wait_hnd[active], &retval))
|
|
503 {
|
|
504 DebPrint (("Wait.GetExitCodeProcess failed with %lu\n",
|
|
505 GetLastError ()));
|
|
506 retval = 1;
|
|
507 }
|
|
508 if (retval == STILL_ACTIVE)
|
|
509 {
|
|
510 /* Should never happen */
|
|
511 DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
|
|
512 errno = EINVAL;
|
|
513 return -1;
|
|
514 }
|
12325
|
515
|
|
516 /* Massage the exit code from the process to match the format expected
|
14036
|
517 by the WIFSTOPPED et al macros in syswait.h. Only WIFSIGNALED and
|
12325
|
518 WIFEXITED are supported; WIFSTOPPED doesn't make sense under NT. */
|
|
519
|
|
520 if (retval == STATUS_CONTROL_C_EXIT)
|
|
521 retval = SIGINT;
|
|
522 else
|
|
523 retval <<= 8;
|
15145
|
524
|
9907
|
525 cp = cps[active];
|
15145
|
526 pid = cp->pid;
|
|
527 #ifdef FULL_DEBUG
|
|
528 DebPrint (("Wait signaled with process pid %d\n", cp->pid));
|
|
529 #endif
|
11388
|
530
|
9907
|
531 if (status)
|
|
532 {
|
11388
|
533 *status = retval;
|
|
534 }
|
|
535 else if (synch_process_alive)
|
|
536 {
|
|
537 synch_process_alive = 0;
|
|
538
|
13931
|
539 /* Report the status of the synchronous process. */
|
|
540 if (WIFEXITED (retval))
|
|
541 synch_process_retcode = WRETCODE (retval);
|
|
542 else if (WIFSIGNALED (retval))
|
|
543 {
|
|
544 int code = WTERMSIG (retval);
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
545 char *signame;
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
546
|
26526
|
547 synchronize_system_messages_locale ();
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
548 signame = strsignal (code);
|
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
549
|
13931
|
550 if (signame == 0)
|
|
551 signame = "unknown";
|
|
552
|
|
553 synch_process_death = signame;
|
|
554 }
|
15145
|
555
|
|
556 reap_subprocess (cp);
|
9907
|
557 }
|
19712
|
558
|
|
559 reap_subprocess (cp);
|
9907
|
560
|
15145
|
561 return pid;
|
9907
|
562 }
|
|
563
|
19712
|
564 void
|
|
565 w32_executable_type (char * filename, int * is_dos_app, int * is_cygnus_app)
|
15247
|
566 {
|
19712
|
567 file_data executable;
|
|
568 char * p;
|
|
569
|
|
570 /* Default values in case we can't tell for sure. */
|
|
571 *is_dos_app = FALSE;
|
|
572 *is_cygnus_app = FALSE;
|
|
573
|
|
574 if (!open_input_file (&executable, filename))
|
|
575 return;
|
15247
|
576
|
19712
|
577 p = strrchr (filename, '.');
|
|
578
|
|
579 /* We can only identify DOS .com programs from the extension. */
|
|
580 if (p && stricmp (p, ".com") == 0)
|
|
581 *is_dos_app = TRUE;
|
|
582 else if (p && (stricmp (p, ".bat") == 0
|
|
583 || stricmp (p, ".cmd") == 0))
|
15247
|
584 {
|
19712
|
585 /* A DOS shell script - it appears that CreateProcess is happy to
|
|
586 accept this (somewhat surprisingly); presumably it looks at
|
|
587 COMSPEC to determine what executable to actually invoke.
|
|
588 Therefore, we have to do the same here as well. */
|
|
589 /* Actually, I think it uses the program association for that
|
|
590 extension, which is defined in the registry. */
|
|
591 p = egetenv ("COMSPEC");
|
|
592 if (p)
|
|
593 w32_executable_type (p, is_dos_app, is_cygnus_app);
|
|
594 }
|
|
595 else
|
|
596 {
|
|
597 /* Look for DOS .exe signature - if found, we must also check that
|
|
598 it isn't really a 16- or 32-bit Windows exe, since both formats
|
|
599 start with a DOS program stub. Note that 16-bit Windows
|
|
600 executables use the OS/2 1.x format. */
|
15247
|
601
|
19712
|
602 IMAGE_DOS_HEADER * dos_header;
|
|
603 IMAGE_NT_HEADERS * nt_header;
|
|
604
|
|
605 dos_header = (PIMAGE_DOS_HEADER) executable.file_base;
|
|
606 if (dos_header->e_magic != IMAGE_DOS_SIGNATURE)
|
|
607 goto unwind;
|
|
608
|
|
609 nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew);
|
|
610
|
21613
|
611 if ((char *) nt_header > (char *) dos_header + executable.size)
|
15247
|
612 {
|
19712
|
613 /* Some dos headers (pkunzip) have bogus e_lfanew fields. */
|
|
614 *is_dos_app = TRUE;
|
|
615 }
|
|
616 else if (nt_header->Signature != IMAGE_NT_SIGNATURE
|
|
617 && LOWORD (nt_header->Signature) != IMAGE_OS2_SIGNATURE)
|
|
618 {
|
|
619 *is_dos_app = TRUE;
|
|
620 }
|
|
621 else if (nt_header->Signature == IMAGE_NT_SIGNATURE)
|
|
622 {
|
|
623 /* Look for cygwin.dll in DLL import list. */
|
|
624 IMAGE_DATA_DIRECTORY import_dir =
|
|
625 nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT];
|
|
626 IMAGE_IMPORT_DESCRIPTOR * imports;
|
|
627 IMAGE_SECTION_HEADER * section;
|
|
628
|
|
629 section = rva_to_section (import_dir.VirtualAddress, nt_header);
|
|
630 imports = RVA_TO_PTR (import_dir.VirtualAddress, section, executable);
|
|
631
|
|
632 for ( ; imports->Name; imports++)
|
|
633 {
|
|
634 char * dllname = RVA_TO_PTR (imports->Name, section, executable);
|
|
635
|
24105
|
636 /* The exact name of the cygwin dll has changed with
|
|
637 various releases, but hopefully this will be reasonably
|
|
638 future proof. */
|
|
639 if (strncmp (dllname, "cygwin", 6) == 0)
|
19712
|
640 {
|
|
641 *is_cygnus_app = TRUE;
|
|
642 break;
|
|
643 }
|
|
644 }
|
|
645 }
|
15247
|
646 }
|
19712
|
647
|
|
648 unwind:
|
|
649 close_file_data (&executable);
|
15247
|
650 }
|
|
651
|
16826
|
652 int
|
|
653 compare_env (const char **strp1, const char **strp2)
|
|
654 {
|
|
655 const char *str1 = *strp1, *str2 = *strp2;
|
|
656
|
|
657 while (*str1 && *str2 && *str1 != '=' && *str2 != '=')
|
|
658 {
|
|
659 if (tolower (*str1) > tolower (*str2))
|
|
660 return 1;
|
|
661 else if (tolower (*str1) < tolower (*str2))
|
|
662 return -1;
|
|
663 str1++, str2++;
|
|
664 }
|
|
665
|
|
666 if (*str1 == '=' && *str2 == '=')
|
|
667 return 0;
|
|
668 else if (*str1 == '=')
|
|
669 return -1;
|
|
670 else
|
|
671 return 1;
|
|
672 }
|
|
673
|
|
674 void
|
|
675 merge_and_sort_env (char **envp1, char **envp2, char **new_envp)
|
|
676 {
|
|
677 char **optr, **nptr;
|
|
678 int num;
|
|
679
|
|
680 nptr = new_envp;
|
|
681 optr = envp1;
|
|
682 while (*optr)
|
|
683 *nptr++ = *optr++;
|
|
684 num = optr - envp1;
|
|
685
|
|
686 optr = envp2;
|
|
687 while (*optr)
|
|
688 *nptr++ = *optr++;
|
|
689 num += optr - envp2;
|
|
690
|
|
691 qsort (new_envp, num, sizeof (char *), compare_env);
|
|
692
|
|
693 *nptr = NULL;
|
|
694 }
|
9907
|
695
|
|
696 /* When a new child process is created we need to register it in our list,
|
|
697 so intercept spawn requests. */
|
|
698 int
|
15145
|
699 sys_spawnve (int mode, char *cmdname, char **argv, char **envp)
|
9907
|
700 {
|
12239
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
701 Lisp_Object program, full;
|
9907
|
702 char *cmdline, *env, *parg, **targ;
|
16826
|
703 int arglen, numenv;
|
15145
|
704 int pid;
|
|
705 child_process *cp;
|
19712
|
706 int is_dos_app, is_cygnus_app;
|
|
707 int do_quoting = 0;
|
|
708 char escape_char;
|
16826
|
709 /* We pass our process ID to our children by setting up an environment
|
|
710 variable in their environment. */
|
|
711 char ppid_env_var_buffer[64];
|
|
712 char *extra_env[] = {ppid_env_var_buffer, NULL};
|
|
713
|
15145
|
714 /* We don't care about the other modes */
|
|
715 if (mode != _P_NOWAIT)
|
|
716 {
|
|
717 errno = EINVAL;
|
|
718 return -1;
|
|
719 }
|
12239
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
720
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
721 /* Handle executable names without an executable suffix. */
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
722 program = make_string (cmdname, strlen (cmdname));
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
723 if (NILP (Ffile_executable_p (program)))
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
724 {
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
725 struct gcpro gcpro1;
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
726
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
727 full = Qnil;
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
728 GCPRO1 (program);
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
729 openp (Vexec_path, program, EXEC_SUFFIXES, &full, 1);
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
730 UNGCPRO;
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
731 if (NILP (full))
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
732 {
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
733 errno = EINVAL;
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
734 return -1;
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
735 }
|
19712
|
736 program = full;
|
12239
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
737 }
|
ff7738cdbd99
(win32_spawnve): Accept program names without executable suffixes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
738
|
19712
|
739 /* make sure argv[0] and cmdname are both in DOS format */
|
|
740 cmdname = XSTRING (program)->data;
|
15145
|
741 unixtodos_filename (cmdname);
|
|
742 argv[0] = cmdname;
|
15247
|
743
|
21613
|
744 /* Determine whether program is a 16-bit DOS executable, or a w32
|
19712
|
745 executable that is implicitly linked to the Cygnus dll (implying it
|
|
746 was compiled with the Cygnus GNU toolchain and hence relies on
|
|
747 cygwin.dll to parse the command line - we use this to decide how to
|
|
748 escape quote chars in command line args that must be quoted). */
|
|
749 w32_executable_type (cmdname, &is_dos_app, &is_cygnus_app);
|
|
750
|
|
751 /* On Windows 95, if cmdname is a DOS app, we invoke a helper
|
|
752 application to start it by specifying the helper app as cmdname,
|
|
753 while leaving the real app name as argv[0]. */
|
|
754 if (is_dos_app)
|
15247
|
755 {
|
19712
|
756 cmdname = alloca (MAXPATHLEN);
|
|
757 if (egetenv ("CMDPROXY"))
|
|
758 strcpy (cmdname, egetenv ("CMDPROXY"));
|
|
759 else
|
|
760 {
|
|
761 strcpy (cmdname, XSTRING (Vinvocation_directory)->data);
|
|
762 strcat (cmdname, "cmdproxy.exe");
|
|
763 }
|
|
764 unixtodos_filename (cmdname);
|
15247
|
765 }
|
9907
|
766
|
|
767 /* we have to do some conjuring here to put argv and envp into the
|
|
768 form CreateProcess wants... argv needs to be a space separated/null
|
|
769 terminated list of parameters, and envp is a null
|
|
770 separated/double-null terminated list of parameters.
|
15145
|
771
|
19712
|
772 Additionally, zero-length args and args containing whitespace or
|
|
773 quote chars need to be wrapped in double quotes - for this to work,
|
|
774 embedded quotes need to be escaped as well. The aim is to ensure
|
|
775 the child process reconstructs the argv array we start with
|
|
776 exactly, so we treat quotes at the beginning and end of arguments
|
|
777 as embedded quotes.
|
|
778
|
21613
|
779 The w32 GNU-based library from Cygnus doubles quotes to escape
|
19712
|
780 them, while MSVC uses backslash for escaping. (Actually the MSVC
|
|
781 startup code does attempt to recognise doubled quotes and accept
|
|
782 them, but gets it wrong and ends up requiring three quotes to get a
|
|
783 single embedded quote!) So by default we decide whether to use
|
|
784 quote or backslash as the escape character based on whether the
|
|
785 binary is apparently a Cygnus compiled app.
|
|
786
|
|
787 Note that using backslash to escape embedded quotes requires
|
|
788 additional special handling if an embedded quote is already
|
|
789 preceeded by backslash, or if an arg requiring quoting ends with
|
|
790 backslash. In such cases, the run of escape characters needs to be
|
|
791 doubled. For consistency, we apply this special handling as long
|
|
792 as the escape character is not quote.
|
|
793
|
|
794 Since we have no idea how large argv and envp are likely to be we
|
|
795 figure out list lengths on the fly and allocate them. */
|
|
796
|
|
797 if (!NILP (Vw32_quote_process_args))
|
|
798 {
|
|
799 do_quoting = 1;
|
|
800 /* Override escape char by binding w32-quote-process-args to
|
|
801 desired character, or use t for auto-selection. */
|
|
802 if (INTEGERP (Vw32_quote_process_args))
|
|
803 escape_char = XINT (Vw32_quote_process_args);
|
|
804 else
|
|
805 escape_char = is_cygnus_app ? '"' : '\\';
|
|
806 }
|
9907
|
807
|
|
808 /* do argv... */
|
|
809 arglen = 0;
|
|
810 targ = argv;
|
|
811 while (*targ)
|
|
812 {
|
15145
|
813 char * p = *targ;
|
19712
|
814 int need_quotes = 0;
|
|
815 int escape_char_run = 0;
|
15145
|
816
|
|
817 if (*p == 0)
|
19712
|
818 need_quotes = 1;
|
|
819 for ( ; *p; p++)
|
|
820 {
|
|
821 if (*p == '"')
|
|
822 {
|
|
823 /* allow for embedded quotes to be escaped */
|
|
824 arglen++;
|
|
825 need_quotes = 1;
|
|
826 /* handle the case where the embedded quote is already escaped */
|
|
827 if (escape_char_run > 0)
|
|
828 {
|
|
829 /* To preserve the arg exactly, we need to double the
|
|
830 preceding escape characters (plus adding one to
|
|
831 escape the quote character itself). */
|
|
832 arglen += escape_char_run;
|
|
833 }
|
|
834 }
|
|
835 else if (*p == ' ' || *p == '\t')
|
|
836 {
|
|
837 need_quotes = 1;
|
|
838 }
|
|
839
|
|
840 if (*p == escape_char && escape_char != '"')
|
|
841 escape_char_run++;
|
|
842 else
|
|
843 escape_char_run = 0;
|
|
844 }
|
|
845 if (need_quotes)
|
|
846 {
|
|
847 arglen += 2;
|
|
848 /* handle the case where the arg ends with an escape char - we
|
|
849 must not let the enclosing quote be escaped. */
|
|
850 if (escape_char_run > 0)
|
|
851 arglen += escape_char_run;
|
|
852 }
|
9907
|
853 arglen += strlen (*targ++) + 1;
|
|
854 }
|
15145
|
855 cmdline = alloca (arglen);
|
9907
|
856 targ = argv;
|
|
857 parg = cmdline;
|
|
858 while (*targ)
|
|
859 {
|
15145
|
860 char * p = *targ;
|
19712
|
861 int need_quotes = 0;
|
15145
|
862
|
|
863 if (*p == 0)
|
19712
|
864 need_quotes = 1;
|
15201
|
865
|
19712
|
866 if (do_quoting)
|
15201
|
867 {
|
|
868 for ( ; *p; p++)
|
|
869 if (*p == ' ' || *p == '\t' || *p == '"')
|
19712
|
870 need_quotes = 1;
|
15201
|
871 }
|
19712
|
872 if (need_quotes)
|
15145
|
873 {
|
19712
|
874 int escape_char_run = 0;
|
15145
|
875 char * first;
|
|
876 char * last;
|
|
877
|
|
878 p = *targ;
|
|
879 first = p;
|
|
880 last = p + strlen (p) - 1;
|
|
881 *parg++ = '"';
|
19712
|
882 #if 0
|
|
883 /* This version does not escape quotes if they occur at the
|
|
884 beginning or end of the arg - this could lead to incorrect
|
|
885 behaviour when the arg itself represents a command line
|
|
886 containing quoted args. I believe this was originally done
|
|
887 as a hack to make some things work, before
|
|
888 `w32-quote-process-args' was added. */
|
15145
|
889 while (*p)
|
|
890 {
|
|
891 if (*p == '"' && p > first && p < last)
|
19712
|
892 *parg++ = escape_char; /* escape embedded quotes */
|
15145
|
893 *parg++ = *p++;
|
|
894 }
|
19712
|
895 #else
|
|
896 for ( ; *p; p++)
|
|
897 {
|
|
898 if (*p == '"')
|
|
899 {
|
|
900 /* double preceding escape chars if any */
|
|
901 while (escape_char_run > 0)
|
|
902 {
|
|
903 *parg++ = escape_char;
|
|
904 escape_char_run--;
|
|
905 }
|
|
906 /* escape all quote chars, even at beginning or end */
|
|
907 *parg++ = escape_char;
|
|
908 }
|
|
909 *parg++ = *p;
|
|
910
|
|
911 if (*p == escape_char && escape_char != '"')
|
|
912 escape_char_run++;
|
|
913 else
|
|
914 escape_char_run = 0;
|
|
915 }
|
|
916 /* double escape chars before enclosing quote */
|
|
917 while (escape_char_run > 0)
|
|
918 {
|
|
919 *parg++ = escape_char;
|
|
920 escape_char_run--;
|
|
921 }
|
|
922 #endif
|
15145
|
923 *parg++ = '"';
|
|
924 }
|
|
925 else
|
|
926 {
|
|
927 strcpy (parg, *targ);
|
|
928 parg += strlen (*targ);
|
|
929 }
|
9907
|
930 *parg++ = ' ';
|
15145
|
931 targ++;
|
9907
|
932 }
|
|
933 *--parg = '\0';
|
|
934
|
|
935 /* and envp... */
|
|
936 arglen = 1;
|
|
937 targ = envp;
|
16826
|
938 numenv = 1; /* for end null */
|
9907
|
939 while (*targ)
|
|
940 {
|
|
941 arglen += strlen (*targ++) + 1;
|
16826
|
942 numenv++;
|
9907
|
943 }
|
16826
|
944 /* extra env vars... */
|
22298
e509b80a17a2
(sys_spawnve): Place Emacs pid in EM_PARENT_PROCESS_ID.
Geoff Voelker <voelker@cs.washington.edu>
diff
changeset
|
945 sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d",
|
9907
|
946 GetCurrentProcessId ());
|
|
947 arglen += strlen (ppid_env_var_buffer) + 1;
|
16826
|
948 numenv++;
|
9907
|
949
|
16826
|
950 /* merge env passed in and extra env into one, and sort it. */
|
|
951 targ = (char **) alloca (numenv * sizeof (char *));
|
|
952 merge_and_sort_env (envp, extra_env, targ);
|
|
953
|
|
954 /* concatenate env entries. */
|
15145
|
955 env = alloca (arglen);
|
9907
|
956 parg = env;
|
|
957 while (*targ)
|
|
958 {
|
|
959 strcpy (parg, *targ);
|
|
960 parg += strlen (*targ++);
|
|
961 *parg++ = '\0';
|
|
962 }
|
|
963 *parg++ = '\0';
|
|
964 *parg = '\0';
|
15145
|
965
|
|
966 cp = new_child ();
|
|
967 if (cp == NULL)
|
9907
|
968 {
|
15145
|
969 errno = EAGAIN;
|
|
970 return -1;
|
9907
|
971 }
|
|
972
|
15145
|
973 /* Now create the process. */
|
|
974 if (!create_child (cmdname, cmdline, env, &pid, cp))
|
|
975 {
|
|
976 delete_child (cp);
|
|
977 errno = ENOEXEC;
|
|
978 return -1;
|
|
979 }
|
9907
|
980
|
15145
|
981 return pid;
|
9907
|
982 }
|
|
983
|
|
984 /* Emulate the select call
|
|
985 Wait for available input on any of the given rfds, or timeout if
|
|
986 a timeout is given and no input is detected
|
19712
|
987 wfds and efds are not supported and must be NULL.
|
|
988
|
|
989 For simplicity, we detect the death of child processes here and
|
|
990 synchronously call the SIGCHLD handler. Since it is possible for
|
|
991 children to be created without a corresponding pipe handle from which
|
|
992 to read output, we wait separately on the process handles as well as
|
|
993 the char_avail events for each process pipe. We only call
|
22079
|
994 wait/reap_process when the process actually terminates.
|
|
995
|
|
996 To reduce the number of places in which Emacs can be hung such that
|
|
997 C-g is not able to interrupt it, we always wait on interrupt_handle
|
|
998 (which is signalled by the input thread when C-g is detected). If we
|
|
999 detect that we were woken up by C-g, we return -1 with errno set to
|
|
1000 EINTR as on Unix. */
|
9907
|
1001
|
|
1002 /* From ntterm.c */
|
|
1003 extern HANDLE keyboard_handle;
|
22079
|
1004
|
|
1005 /* From w32xfns.c */
|
|
1006 extern HANDLE interrupt_handle;
|
|
1007
|
9907
|
1008 /* From process.c */
|
|
1009 extern int proc_buffered_char[];
|
|
1010
|
|
1011 int
|
11388
|
1012 sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
|
|
1013 EMACS_TIME *timeout)
|
9907
|
1014 {
|
|
1015 SELECT_TYPE orfds;
|
19712
|
1016 DWORD timeout_ms, start_time;
|
|
1017 int i, nh, nc, nr;
|
9907
|
1018 DWORD active;
|
19712
|
1019 child_process *cp, *cps[MAX_CHILDREN];
|
|
1020 HANDLE wait_hnd[MAXDESC + MAX_CHILDREN];
|
15145
|
1021 int fdindex[MAXDESC]; /* mapping from wait handles back to descriptors */
|
9907
|
1022
|
19712
|
1023 timeout_ms = timeout ? (timeout->tv_sec * 1000 + timeout->tv_usec / 1000) : INFINITE;
|
|
1024
|
9907
|
1025 /* If the descriptor sets are NULL but timeout isn't, then just Sleep. */
|
|
1026 if (rfds == NULL && wfds == NULL && efds == NULL && timeout != NULL)
|
|
1027 {
|
19712
|
1028 Sleep (timeout_ms);
|
9907
|
1029 return 0;
|
|
1030 }
|
|
1031
|
|
1032 /* Otherwise, we only handle rfds, so fail otherwise. */
|
|
1033 if (rfds == NULL || wfds != NULL || efds != NULL)
|
|
1034 {
|
|
1035 errno = EINVAL;
|
|
1036 return -1;
|
|
1037 }
|
|
1038
|
|
1039 orfds = *rfds;
|
|
1040 FD_ZERO (rfds);
|
|
1041 nr = 0;
|
22079
|
1042
|
|
1043 /* Always wait on interrupt_handle, to detect C-g (quit). */
|
|
1044 wait_hnd[0] = interrupt_handle;
|
|
1045 fdindex[0] = -1;
|
9907
|
1046
|
19712
|
1047 /* Build a list of pipe handles to wait on. */
|
22079
|
1048 nh = 1;
|
9907
|
1049 for (i = 0; i < nfds; i++)
|
|
1050 if (FD_ISSET (i, &orfds))
|
|
1051 {
|
|
1052 if (i == 0)
|
|
1053 {
|
15145
|
1054 if (keyboard_handle)
|
|
1055 {
|
|
1056 /* Handle stdin specially */
|
|
1057 wait_hnd[nh] = keyboard_handle;
|
|
1058 fdindex[nh] = i;
|
|
1059 nh++;
|
|
1060 }
|
9907
|
1061
|
|
1062 /* Check for any emacs-generated input in the queue since
|
|
1063 it won't be detected in the wait */
|
|
1064 if (detect_input_pending ())
|
|
1065 {
|
|
1066 FD_SET (i, rfds);
|
15145
|
1067 return 1;
|
9907
|
1068 }
|
|
1069 }
|
|
1070 else
|
|
1071 {
|
15145
|
1072 /* Child process and socket input */
|
|
1073 cp = fd_info[i].cp;
|
9907
|
1074 if (cp)
|
|
1075 {
|
15145
|
1076 int current_status = cp->status;
|
|
1077
|
|
1078 if (current_status == STATUS_READ_ACKNOWLEDGED)
|
|
1079 {
|
|
1080 /* Tell reader thread which file handle to use. */
|
|
1081 cp->fd = i;
|
|
1082 /* Wake up the reader thread for this process */
|
|
1083 cp->status = STATUS_READ_READY;
|
|
1084 if (!SetEvent (cp->char_consumed))
|
|
1085 DebPrint (("nt_select.SetEvent failed with "
|
|
1086 "%lu for fd %ld\n", GetLastError (), i));
|
|
1087 }
|
|
1088
|
|
1089 #ifdef CHECK_INTERLOCK
|
|
1090 /* slightly crude cross-checking of interlock between threads */
|
|
1091
|
|
1092 current_status = cp->status;
|
|
1093 if (WaitForSingleObject (cp->char_avail, 0) == WAIT_OBJECT_0)
|
|
1094 {
|
|
1095 /* char_avail has been signalled, so status (which may
|
|
1096 have changed) should indicate read has completed
|
|
1097 but has not been acknowledged. */
|
|
1098 current_status = cp->status;
|
19712
|
1099 if (current_status != STATUS_READ_SUCCEEDED
|
|
1100 && current_status != STATUS_READ_FAILED)
|
15145
|
1101 DebPrint (("char_avail set, but read not completed: status %d\n",
|
|
1102 current_status));
|
|
1103 }
|
|
1104 else
|
|
1105 {
|
|
1106 /* char_avail has not been signalled, so status should
|
|
1107 indicate that read is in progress; small possibility
|
|
1108 that read has completed but event wasn't yet signalled
|
|
1109 when we tested it (because a context switch occurred
|
|
1110 or if running on separate CPUs). */
|
19712
|
1111 if (current_status != STATUS_READ_READY
|
|
1112 && current_status != STATUS_READ_IN_PROGRESS
|
|
1113 && current_status != STATUS_READ_SUCCEEDED
|
|
1114 && current_status != STATUS_READ_FAILED)
|
15145
|
1115 DebPrint (("char_avail reset, but read status is bad: %d\n",
|
|
1116 current_status));
|
|
1117 }
|
|
1118 #endif
|
|
1119 wait_hnd[nh] = cp->char_avail;
|
|
1120 fdindex[nh] = i;
|
|
1121 if (!wait_hnd[nh]) abort ();
|
|
1122 nh++;
|
9907
|
1123 #ifdef FULL_DEBUG
|
|
1124 DebPrint (("select waiting on child %d fd %d\n",
|
|
1125 cp-child_procs, i));
|
|
1126 #endif
|
|
1127 }
|
|
1128 else
|
|
1129 {
|
15145
|
1130 /* Unable to find something to wait on for this fd, skip */
|
21613
|
1131
|
|
1132 /* Note that this is not a fatal error, and can in fact
|
|
1133 happen in unusual circumstances. Specifically, if
|
|
1134 sys_spawnve fails, eg. because the program doesn't
|
|
1135 exist, and debug-on-error is t so Fsignal invokes a
|
|
1136 nested input loop, then the process output pipe is
|
|
1137 still included in input_wait_mask with no child_proc
|
|
1138 associated with it. (It is removed when the debugger
|
|
1139 exits the nested input loop and the error is thrown.) */
|
|
1140
|
15145
|
1141 DebPrint (("sys_select: fd %ld is invalid! ignoring\n", i));
|
9907
|
1142 }
|
|
1143 }
|
|
1144 }
|
19712
|
1145
|
|
1146 count_children:
|
|
1147 /* Add handles of child processes. */
|
|
1148 nc = 0;
|
|
1149 for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--)
|
21613
|
1150 /* Some child_procs might be sockets; ignore them. Also some
|
|
1151 children may have died already, but we haven't finished reading
|
|
1152 the process output; ignore them too. */
|
|
1153 if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess
|
|
1154 && (cp->fd < 0
|
|
1155 || (fd_info[cp->fd].flags & FILE_SEND_SIGCHLD) == 0
|
|
1156 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0)
|
|
1157 )
|
19712
|
1158 {
|
|
1159 wait_hnd[nh + nc] = cp->procinfo.hProcess;
|
|
1160 cps[nc] = cp;
|
|
1161 nc++;
|
|
1162 }
|
9907
|
1163
|
|
1164 /* Nothing to look for, so we didn't find anything */
|
19712
|
1165 if (nh + nc == 0)
|
9907
|
1166 {
|
11388
|
1167 if (timeout)
|
19712
|
1168 Sleep (timeout_ms);
|
9907
|
1169 return 0;
|
|
1170 }
|
|
1171
|
19712
|
1172 start_time = GetTickCount ();
|
24915
|
1173
|
|
1174 /* Wait for input or child death to be signalled. If user input is
|
|
1175 allowed, then also accept window messages. */
|
|
1176 if (FD_ISSET (0, &orfds))
|
|
1177 active = MsgWaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms,
|
|
1178 QS_ALLINPUT);
|
|
1179 else
|
|
1180 active = WaitForMultipleObjects (nh + nc, wait_hnd, FALSE, timeout_ms);
|
15145
|
1181
|
9907
|
1182 if (active == WAIT_FAILED)
|
|
1183 {
|
|
1184 DebPrint (("select.WaitForMultipleObjects (%d, %lu) failed with %lu\n",
|
19712
|
1185 nh + nc, timeout_ms, GetLastError ()));
|
15145
|
1186 /* don't return EBADF - this causes wait_reading_process_input to
|
|
1187 abort; WAIT_FAILED is returned when single-stepping under
|
|
1188 Windows 95 after switching thread focus in debugger, and
|
|
1189 possibly at other times. */
|
|
1190 errno = EINTR;
|
9907
|
1191 return -1;
|
|
1192 }
|
|
1193 else if (active == WAIT_TIMEOUT)
|
|
1194 {
|
|
1195 return 0;
|
|
1196 }
|
19712
|
1197 else if (active >= WAIT_OBJECT_0
|
|
1198 && active < WAIT_OBJECT_0+MAXIMUM_WAIT_OBJECTS)
|
9907
|
1199 {
|
|
1200 active -= WAIT_OBJECT_0;
|
|
1201 }
|
19712
|
1202 else if (active >= WAIT_ABANDONED_0
|
|
1203 && active < WAIT_ABANDONED_0+MAXIMUM_WAIT_OBJECTS)
|
9907
|
1204 {
|
|
1205 active -= WAIT_ABANDONED_0;
|
|
1206 }
|
19712
|
1207 else
|
|
1208 abort ();
|
15145
|
1209
|
|
1210 /* Loop over all handles after active (now officially documented as
|
|
1211 being the first signalled handle in the array). We do this to
|
|
1212 ensure fairness, so that all channels with data available will be
|
|
1213 processed - otherwise higher numbered channels could be starved. */
|
|
1214 do
|
9907
|
1215 {
|
24915
|
1216 if (active == nh + nc)
|
|
1217 {
|
|
1218 /* There are messages in the lisp thread's queue; we must
|
|
1219 drain the queue now to ensure they are processed promptly,
|
|
1220 because if we don't do so, we will not be woken again until
|
|
1221 further messages arrive.
|
|
1222
|
|
1223 NB. If ever we allow window message procedures to callback
|
|
1224 into lisp, we will need to ensure messages are dispatched
|
|
1225 at a safe time for lisp code to be run (*), and we may also
|
|
1226 want to provide some hooks in the dispatch loop to cater
|
|
1227 for modeless dialogs created by lisp (ie. to register
|
|
1228 window handles to pass to IsDialogMessage).
|
|
1229
|
|
1230 (*) Note that MsgWaitForMultipleObjects above is an
|
|
1231 internal dispatch point for messages that are sent to
|
|
1232 windows created by this thread. */
|
|
1233 drain_message_queue ();
|
|
1234 }
|
|
1235 else if (active >= nh)
|
19712
|
1236 {
|
|
1237 cp = cps[active - nh];
|
21613
|
1238
|
|
1239 /* We cannot always signal SIGCHLD immediately; if we have not
|
|
1240 finished reading the process output, we must delay sending
|
|
1241 SIGCHLD until we do. */
|
|
1242
|
|
1243 if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_AT_EOF) == 0)
|
|
1244 fd_info[cp->fd].flags |= FILE_SEND_SIGCHLD;
|
19712
|
1245 /* SIG_DFL for SIGCHLD is ignore */
|
21613
|
1246 else if (sig_handlers[SIGCHLD] != SIG_DFL &&
|
|
1247 sig_handlers[SIGCHLD] != SIG_IGN)
|
19712
|
1248 {
|
|
1249 #ifdef FULL_DEBUG
|
|
1250 DebPrint (("select calling SIGCHLD handler for pid %d\n",
|
|
1251 cp->pid));
|
|
1252 #endif
|
|
1253 dead_child = cp;
|
|
1254 sig_handlers[SIGCHLD] (SIGCHLD);
|
|
1255 dead_child = NULL;
|
|
1256 }
|
|
1257 }
|
22079
|
1258 else if (fdindex[active] == -1)
|
|
1259 {
|
|
1260 /* Quit (C-g) was detected. */
|
|
1261 errno = EINTR;
|
|
1262 return -1;
|
|
1263 }
|
19712
|
1264 else if (fdindex[active] == 0)
|
15145
|
1265 {
|
|
1266 /* Keyboard input available */
|
|
1267 FD_SET (0, rfds);
|
9907
|
1268 nr++;
|
15145
|
1269 }
|
9907
|
1270 else
|
15145
|
1271 {
|
19712
|
1272 /* must be a socket or pipe - read ahead should have
|
|
1273 completed, either succeeding or failing. */
|
15145
|
1274 FD_SET (fdindex[active], rfds);
|
|
1275 nr++;
|
|
1276 }
|
|
1277
|
19712
|
1278 /* Even though wait_reading_process_output only reads from at most
|
|
1279 one channel, we must process all channels here so that we reap
|
|
1280 all children that have died. */
|
|
1281 while (++active < nh + nc)
|
15145
|
1282 if (WaitForSingleObject (wait_hnd[active], 0) == WAIT_OBJECT_0)
|
|
1283 break;
|
19712
|
1284 } while (active < nh + nc);
|
|
1285
|
|
1286 /* If no input has arrived and timeout hasn't expired, wait again. */
|
|
1287 if (nr == 0)
|
|
1288 {
|
|
1289 DWORD elapsed = GetTickCount () - start_time;
|
|
1290
|
|
1291 if (timeout_ms > elapsed) /* INFINITE is MAX_UINT */
|
|
1292 {
|
|
1293 if (timeout_ms != INFINITE)
|
|
1294 timeout_ms -= elapsed;
|
|
1295 goto count_children;
|
|
1296 }
|
|
1297 }
|
15145
|
1298
|
9907
|
1299 return nr;
|
|
1300 }
|
|
1301
|
15145
|
1302 /* Substitute for certain kill () operations */
|
19712
|
1303
|
|
1304 static BOOL CALLBACK
|
|
1305 find_child_console (HWND hwnd, child_process * cp)
|
|
1306 {
|
|
1307 DWORD thread_id;
|
|
1308 DWORD process_id;
|
|
1309
|
|
1310 thread_id = GetWindowThreadProcessId (hwnd, &process_id);
|
|
1311 if (process_id == cp->procinfo.dwProcessId)
|
|
1312 {
|
|
1313 char window_class[32];
|
|
1314
|
|
1315 GetClassName (hwnd, window_class, sizeof (window_class));
|
|
1316 if (strcmp (window_class,
|
|
1317 (os_subtype == OS_WIN95)
|
|
1318 ? "tty"
|
|
1319 : "ConsoleWindowClass") == 0)
|
|
1320 {
|
|
1321 cp->hwnd = hwnd;
|
|
1322 return FALSE;
|
|
1323 }
|
|
1324 }
|
|
1325 /* keep looking */
|
|
1326 return TRUE;
|
|
1327 }
|
|
1328
|
9907
|
1329 int
|
15145
|
1330 sys_kill (int pid, int sig)
|
9907
|
1331 {
|
|
1332 child_process *cp;
|
15145
|
1333 HANDLE proc_hand;
|
|
1334 int need_to_free = 0;
|
|
1335 int rc = 0;
|
9907
|
1336
|
|
1337 /* Only handle signals that will result in the process dying */
|
|
1338 if (sig != SIGINT && sig != SIGKILL && sig != SIGQUIT && sig != SIGHUP)
|
|
1339 {
|
|
1340 errno = EINVAL;
|
|
1341 return -1;
|
|
1342 }
|
15145
|
1343
|
9907
|
1344 cp = find_child_pid (pid);
|
|
1345 if (cp == NULL)
|
|
1346 {
|
15145
|
1347 proc_hand = OpenProcess (PROCESS_TERMINATE, 0, pid);
|
|
1348 if (proc_hand == NULL)
|
|
1349 {
|
|
1350 errno = EPERM;
|
|
1351 return -1;
|
|
1352 }
|
|
1353 need_to_free = 1;
|
|
1354 }
|
|
1355 else
|
|
1356 {
|
|
1357 proc_hand = cp->procinfo.hProcess;
|
|
1358 pid = cp->procinfo.dwProcessId;
|
19712
|
1359
|
|
1360 /* Try to locate console window for process. */
|
|
1361 EnumWindows (find_child_console, (LPARAM) cp);
|
9907
|
1362 }
|
|
1363
|
|
1364 if (sig == SIGINT)
|
|
1365 {
|
19712
|
1366 if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
|
|
1367 {
|
|
1368 BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0);
|
|
1369 BYTE vk_break_code = VK_CANCEL;
|
|
1370 BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
|
|
1371 HWND foreground_window;
|
|
1372
|
|
1373 if (break_scan_code == 0)
|
|
1374 {
|
|
1375 /* Fake Ctrl-C if we can't manage Ctrl-Break. */
|
|
1376 vk_break_code = 'C';
|
|
1377 break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
|
|
1378 }
|
|
1379
|
|
1380 foreground_window = GetForegroundWindow ();
|
24671
|
1381 if (foreground_window)
|
19712
|
1382 {
|
24671
|
1383 /* NT 5.0, and apparently also Windows 98, will not allow
|
|
1384 a Window to be set to foreground directly without the
|
|
1385 user's involvement. The workaround is to attach
|
|
1386 ourselves to the thread that owns the foreground
|
|
1387 window, since that is the only thread that can set the
|
|
1388 foreground window. */
|
|
1389 DWORD foreground_thread, child_thread;
|
|
1390 foreground_thread =
|
|
1391 GetWindowThreadProcessId (foreground_window, NULL);
|
|
1392 if (foreground_thread == GetCurrentThreadId ()
|
|
1393 || !AttachThreadInput (GetCurrentThreadId (),
|
|
1394 foreground_thread, TRUE))
|
|
1395 foreground_thread = 0;
|
|
1396
|
|
1397 child_thread = GetWindowThreadProcessId (cp->hwnd, NULL);
|
|
1398 if (child_thread == GetCurrentThreadId ()
|
|
1399 || !AttachThreadInput (GetCurrentThreadId (),
|
|
1400 child_thread, TRUE))
|
|
1401 child_thread = 0;
|
19712
|
1402
|
24671
|
1403 /* Set the foreground window to the child. */
|
|
1404 if (SetForegroundWindow (cp->hwnd))
|
|
1405 {
|
|
1406 /* Generate keystrokes as if user had typed Ctrl-Break or
|
|
1407 Ctrl-C. */
|
|
1408 keybd_event (VK_CONTROL, control_scan_code, 0, 0);
|
|
1409 keybd_event (vk_break_code, break_scan_code,
|
|
1410 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0);
|
|
1411 keybd_event (vk_break_code, break_scan_code,
|
|
1412 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY)
|
|
1413 | KEYEVENTF_KEYUP, 0);
|
|
1414 keybd_event (VK_CONTROL, control_scan_code,
|
|
1415 KEYEVENTF_KEYUP, 0);
|
21613
|
1416
|
24671
|
1417 /* Sleep for a bit to give time for Emacs frame to respond
|
|
1418 to focus change events (if Emacs was active app). */
|
|
1419 Sleep (100);
|
|
1420
|
|
1421 SetForegroundWindow (foreground_window);
|
|
1422 }
|
|
1423 /* Detach from the foreground and child threads now that
|
|
1424 the foreground switching is over. */
|
|
1425 if (foreground_thread)
|
|
1426 AttachThreadInput (GetCurrentThreadId (),
|
|
1427 foreground_thread, FALSE);
|
|
1428 if (child_thread)
|
|
1429 AttachThreadInput (GetCurrentThreadId (),
|
|
1430 child_thread, FALSE);
|
|
1431 }
|
|
1432 }
|
15145
|
1433 /* Ctrl-Break is NT equivalent of SIGINT. */
|
19712
|
1434 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid))
|
9907
|
1435 {
|
15145
|
1436 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
|
9907
|
1437 "for pid %lu\n", GetLastError (), pid));
|
|
1438 errno = EINVAL;
|
15145
|
1439 rc = -1;
|
21742
|
1440 }
|
9907
|
1441 }
|
|
1442 else
|
|
1443 {
|
19712
|
1444 if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
|
|
1445 {
|
|
1446 #if 1
|
|
1447 if (os_subtype == OS_WIN95)
|
|
1448 {
|
|
1449 /*
|
|
1450 Another possibility is to try terminating the VDM out-right by
|
|
1451 calling the Shell VxD (id 0x17) V86 interface, function #4
|
|
1452 "SHELL_Destroy_VM", ie.
|
|
1453
|
|
1454 mov edx,4
|
|
1455 mov ebx,vm_handle
|
|
1456 call shellapi
|
|
1457
|
|
1458 First need to determine the current VM handle, and then arrange for
|
|
1459 the shellapi call to be made from the system vm (by using
|
|
1460 Switch_VM_and_callback).
|
|
1461
|
|
1462 Could try to invoke DestroyVM through CallVxD.
|
|
1463
|
|
1464 */
|
21613
|
1465 #if 0
|
|
1466 /* On Win95, posting WM_QUIT causes the 16-bit subsystem
|
|
1467 to hang when cmdproxy is used in conjunction with
|
|
1468 command.com for an interactive shell. Posting
|
|
1469 WM_CLOSE pops up a dialog that, when Yes is selected,
|
|
1470 does the same thing. TerminateProcess is also less
|
|
1471 than ideal in that subprocesses tend to stick around
|
|
1472 until the machine is shutdown, but at least it
|
|
1473 doesn't freeze the 16-bit subsystem. */
|
19712
|
1474 PostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
|
21613
|
1475 #endif
|
|
1476 if (!TerminateProcess (proc_hand, 0xff))
|
|
1477 {
|
|
1478 DebPrint (("sys_kill.TerminateProcess returned %d "
|
|
1479 "for pid %lu\n", GetLastError (), pid));
|
|
1480 errno = EINVAL;
|
|
1481 rc = -1;
|
|
1482 }
|
19712
|
1483 }
|
|
1484 else
|
|
1485 #endif
|
|
1486 PostMessage (cp->hwnd, WM_CLOSE, 0, 0);
|
|
1487 }
|
16588
|
1488 /* Kill the process. On W32 this doesn't kill child processes
|
15351
|
1489 so it doesn't work very well for shells which is why it's not
|
19712
|
1490 used in every case. */
|
|
1491 else if (!TerminateProcess (proc_hand, 0xff))
|
9907
|
1492 {
|
15145
|
1493 DebPrint (("sys_kill.TerminateProcess returned %d "
|
9907
|
1494 "for pid %lu\n", GetLastError (), pid));
|
|
1495 errno = EINVAL;
|
15145
|
1496 rc = -1;
|
9907
|
1497 }
|
|
1498 }
|
15145
|
1499
|
|
1500 if (need_to_free)
|
|
1501 CloseHandle (proc_hand);
|
|
1502
|
|
1503 return rc;
|
9907
|
1504 }
|
|
1505
|
21452
|
1506 /* extern int report_file_error (char *, Lisp_Object); */
|
15145
|
1507
|
|
1508 /* The following two routines are used to manipulate stdin, stdout, and
|
|
1509 stderr of our child processes.
|
|
1510
|
|
1511 Assuming that in, out, and err are *not* inheritable, we make them
|
|
1512 stdin, stdout, and stderr of the child as follows:
|
|
1513
|
|
1514 - Save the parent's current standard handles.
|
|
1515 - Set the std handles to inheritable duplicates of the ones being passed in.
|
|
1516 (Note that _get_osfhandle() is an io.h procedure that retrieves the
|
|
1517 NT file handle for a crt file descriptor.)
|
|
1518 - Spawn the child, which inherits in, out, and err as stdin,
|
|
1519 stdout, and stderr. (see Spawnve)
|
|
1520 - Close the std handles passed to the child.
|
|
1521 - Reset the parent's standard handles to the saved handles.
|
|
1522 (see reset_standard_handles)
|
|
1523 We assume that the caller closes in, out, and err after calling us. */
|
|
1524
|
|
1525 void
|
|
1526 prepare_standard_handles (int in, int out, int err, HANDLE handles[3])
|
9907
|
1527 {
|
15145
|
1528 HANDLE parent;
|
|
1529 HANDLE newstdin, newstdout, newstderr;
|
|
1530
|
|
1531 parent = GetCurrentProcess ();
|
|
1532
|
|
1533 handles[0] = GetStdHandle (STD_INPUT_HANDLE);
|
|
1534 handles[1] = GetStdHandle (STD_OUTPUT_HANDLE);
|
|
1535 handles[2] = GetStdHandle (STD_ERROR_HANDLE);
|
|
1536
|
|
1537 /* make inheritable copies of the new handles */
|
|
1538 if (!DuplicateHandle (parent,
|
|
1539 (HANDLE) _get_osfhandle (in),
|
|
1540 parent,
|
|
1541 &newstdin,
|
|
1542 0,
|
|
1543 TRUE,
|
|
1544 DUPLICATE_SAME_ACCESS))
|
|
1545 report_file_error ("Duplicating input handle for child", Qnil);
|
9907
|
1546
|
15145
|
1547 if (!DuplicateHandle (parent,
|
|
1548 (HANDLE) _get_osfhandle (out),
|
|
1549 parent,
|
|
1550 &newstdout,
|
|
1551 0,
|
|
1552 TRUE,
|
|
1553 DUPLICATE_SAME_ACCESS))
|
|
1554 report_file_error ("Duplicating output handle for child", Qnil);
|
|
1555
|
|
1556 if (!DuplicateHandle (parent,
|
|
1557 (HANDLE) _get_osfhandle (err),
|
|
1558 parent,
|
|
1559 &newstderr,
|
|
1560 0,
|
|
1561 TRUE,
|
|
1562 DUPLICATE_SAME_ACCESS))
|
|
1563 report_file_error ("Duplicating error handle for child", Qnil);
|
|
1564
|
|
1565 /* and store them as our std handles */
|
|
1566 if (!SetStdHandle (STD_INPUT_HANDLE, newstdin))
|
|
1567 report_file_error ("Changing stdin handle", Qnil);
|
9907
|
1568
|
15145
|
1569 if (!SetStdHandle (STD_OUTPUT_HANDLE, newstdout))
|
|
1570 report_file_error ("Changing stdout handle", Qnil);
|
|
1571
|
|
1572 if (!SetStdHandle (STD_ERROR_HANDLE, newstderr))
|
|
1573 report_file_error ("Changing stderr handle", Qnil);
|
9907
|
1574 }
|
15145
|
1575
|
|
1576 void
|
|
1577 reset_standard_handles (int in, int out, int err, HANDLE handles[3])
|
|
1578 {
|
|
1579 /* close the duplicated handles passed to the child */
|
|
1580 CloseHandle (GetStdHandle (STD_INPUT_HANDLE));
|
|
1581 CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE));
|
|
1582 CloseHandle (GetStdHandle (STD_ERROR_HANDLE));
|
|
1583
|
|
1584 /* now restore parent's saved std handles */
|
|
1585 SetStdHandle (STD_INPUT_HANDLE, handles[0]);
|
|
1586 SetStdHandle (STD_OUTPUT_HANDLE, handles[1]);
|
|
1587 SetStdHandle (STD_ERROR_HANDLE, handles[2]);
|
|
1588 }
|
|
1589
|
19712
|
1590 void
|
|
1591 set_process_dir (char * dir)
|
|
1592 {
|
|
1593 process_dir = dir;
|
|
1594 }
|
|
1595
|
15356
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1596 #ifdef HAVE_SOCKETS
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1597
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1598 /* To avoid problems with winsock implementations that work over dial-up
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1599 connections causing or requiring a connection to exist while Emacs is
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1600 running, Emacs no longer automatically loads winsock on startup if it
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1601 is present. Instead, it will be loaded when open-network-stream is
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1602 first called.
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1603
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1604 To allow full control over when winsock is loaded, we provide these
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1605 two functions to dynamically load and unload winsock. This allows
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1606 dial-up users to only be connected when they actually need to use
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1607 socket services. */
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1608
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1609 /* From nt.c */
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1610 extern HANDLE winsock_lib;
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1611 extern BOOL term_winsock (void);
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1612 extern BOOL init_winsock (int load_now);
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1613
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1614 extern Lisp_Object Vsystem_name;
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1615
|
16588
|
1616 DEFUN ("w32-has-winsock", Fw32_has_winsock, Sw32_has_winsock, 0, 1, 0,
|
15356
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1617 "Test for presence of the Windows socket library `winsock'.\n\
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1618 Returns non-nil if winsock support is present, nil otherwise.\n\
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1619 \n\
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1620 If the optional argument LOAD-NOW is non-nil, the winsock library is\n\
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1621 also loaded immediately if not already loaded. If winsock is loaded,\n\
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1622 the winsock local hostname is returned (since this may be different from\n\
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1623 the value of `system-name' and should supplant it), otherwise t is\n\
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1624 returned to indicate winsock support is present.")
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1625 (load_now)
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1626 Lisp_Object load_now;
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1627 {
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1628 int have_winsock;
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1629
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1630 have_winsock = init_winsock (!NILP (load_now));
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1631 if (have_winsock)
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1632 {
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1633 if (winsock_lib != NULL)
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1634 {
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1635 /* Return new value for system-name. The best way to do this
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1636 is to call init_system_name, saving and restoring the
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1637 original value to avoid side-effects. */
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1638 Lisp_Object orig_hostname = Vsystem_name;
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1639 Lisp_Object hostname;
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1640
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1641 init_system_name ();
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1642 hostname = Vsystem_name;
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1643 Vsystem_name = orig_hostname;
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1644 return hostname;
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1645 }
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1646 return Qt;
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1647 }
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1648 return Qnil;
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1649 }
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1650
|
16588
|
1651 DEFUN ("w32-unload-winsock", Fw32_unload_winsock, Sw32_unload_winsock,
|
15356
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1652 0, 0, 0,
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1653 "Unload the Windows socket library `winsock' if loaded.\n\
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1654 This is provided to allow dial-up socket connections to be disconnected\n\
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1655 when no longer needed. Returns nil without unloading winsock if any\n\
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1656 socket connections still exist.")
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1657 ()
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1658 {
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1659 return term_winsock () ? Qt : Qnil;
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1660 }
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1661
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1662 #endif /* HAVE_SOCKETS */
|
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1663
|
15201
|
1664
|
19712
|
1665 /* Some miscellaneous functions that are Windows specific, but not GUI
|
|
1666 specific (ie. are applicable in terminal or batch mode as well). */
|
|
1667
|
|
1668 /* lifted from fileio.c */
|
|
1669 #define CORRECT_DIR_SEPS(s) \
|
|
1670 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
|
|
1671 else unixtodos_filename (s); \
|
|
1672 } while (0)
|
|
1673
|
|
1674 DEFUN ("w32-short-file-name", Fw32_short_file_name, Sw32_short_file_name, 1, 1, 0,
|
|
1675 "Return the short file name version (8.3) of the full path of FILENAME.\n\
|
|
1676 If FILENAME does not exist, return nil.\n\
|
|
1677 All path elements in FILENAME are converted to their short names.")
|
|
1678 (filename)
|
|
1679 Lisp_Object filename;
|
|
1680 {
|
|
1681 char shortname[MAX_PATH];
|
|
1682
|
|
1683 CHECK_STRING (filename, 0);
|
|
1684
|
|
1685 /* first expand it. */
|
|
1686 filename = Fexpand_file_name (filename, Qnil);
|
|
1687
|
|
1688 /* luckily, this returns the short version of each element in the path. */
|
|
1689 if (GetShortPathName (XSTRING (filename)->data, shortname, MAX_PATH) == 0)
|
|
1690 return Qnil;
|
|
1691
|
|
1692 CORRECT_DIR_SEPS (shortname);
|
|
1693
|
|
1694 return build_string (shortname);
|
|
1695 }
|
|
1696
|
|
1697
|
|
1698 DEFUN ("w32-long-file-name", Fw32_long_file_name, Sw32_long_file_name,
|
|
1699 1, 1, 0,
|
|
1700 "Return the long file name version of the full path of FILENAME.\n\
|
|
1701 If FILENAME does not exist, return nil.\n\
|
|
1702 All path elements in FILENAME are converted to their long names.")
|
|
1703 (filename)
|
|
1704 Lisp_Object filename;
|
|
1705 {
|
|
1706 char longname[ MAX_PATH ];
|
|
1707
|
|
1708 CHECK_STRING (filename, 0);
|
|
1709
|
|
1710 /* first expand it. */
|
|
1711 filename = Fexpand_file_name (filename, Qnil);
|
|
1712
|
|
1713 if (!w32_get_long_filename (XSTRING (filename)->data, longname, MAX_PATH))
|
|
1714 return Qnil;
|
|
1715
|
|
1716 CORRECT_DIR_SEPS (longname);
|
|
1717
|
|
1718 return build_string (longname);
|
|
1719 }
|
|
1720
|
|
1721 DEFUN ("w32-set-process-priority", Fw32_set_process_priority, Sw32_set_process_priority,
|
|
1722 2, 2, 0,
|
|
1723 "Set the priority of PROCESS to PRIORITY.\n\
|
|
1724 If PROCESS is nil, the priority of Emacs is changed, otherwise the\n\
|
|
1725 priority of the process whose pid is PROCESS is changed.\n\
|
|
1726 PRIORITY should be one of the symbols high, normal, or low;\n\
|
|
1727 any other symbol will be interpreted as normal.\n\
|
|
1728 \n\
|
|
1729 If successful, the return value is t, otherwise nil.")
|
|
1730 (process, priority)
|
|
1731 Lisp_Object process, priority;
|
|
1732 {
|
|
1733 HANDLE proc_handle = GetCurrentProcess ();
|
|
1734 DWORD priority_class = NORMAL_PRIORITY_CLASS;
|
|
1735 Lisp_Object result = Qnil;
|
|
1736
|
|
1737 CHECK_SYMBOL (priority, 0);
|
|
1738
|
|
1739 if (!NILP (process))
|
|
1740 {
|
|
1741 DWORD pid;
|
|
1742 child_process *cp;
|
|
1743
|
|
1744 CHECK_NUMBER (process, 0);
|
|
1745
|
|
1746 /* Allow pid to be an internally generated one, or one obtained
|
|
1747 externally. This is necessary because real pids on Win95 are
|
|
1748 negative. */
|
|
1749
|
|
1750 pid = XINT (process);
|
|
1751 cp = find_child_pid (pid);
|
|
1752 if (cp != NULL)
|
|
1753 pid = cp->procinfo.dwProcessId;
|
|
1754
|
|
1755 proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
|
|
1756 }
|
|
1757
|
|
1758 if (EQ (priority, Qhigh))
|
|
1759 priority_class = HIGH_PRIORITY_CLASS;
|
|
1760 else if (EQ (priority, Qlow))
|
|
1761 priority_class = IDLE_PRIORITY_CLASS;
|
|
1762
|
|
1763 if (proc_handle != NULL)
|
|
1764 {
|
|
1765 if (SetPriorityClass (proc_handle, priority_class))
|
|
1766 result = Qt;
|
|
1767 if (!NILP (process))
|
|
1768 CloseHandle (proc_handle);
|
|
1769 }
|
|
1770
|
|
1771 return result;
|
|
1772 }
|
|
1773
|
|
1774
|
|
1775 DEFUN ("w32-get-locale-info", Fw32_get_locale_info, Sw32_get_locale_info, 1, 2, 0,
|
|
1776 "Return information about the Windows locale LCID.\n\
|
|
1777 By default, return a three letter locale code which encodes the default\n\
|
|
1778 language as the first two characters, and the country or regionial variant\n\
|
|
1779 as the third letter. For example, ENU refers to `English (United States)',\n\
|
|
1780 while ENC means `English (Canadian)'.\n\
|
|
1781 \n\
|
23678
|
1782 If the optional argument LONGFORM is t, the long form of the locale\n\
|
|
1783 name is returned, e.g. `English (United States)' instead; if LONGFORM\n\
|
|
1784 is a number, it is interpreted as an LCTYPE constant and the corresponding\n\
|
|
1785 locale information is returned.\n\
|
19712
|
1786 \n\
|
|
1787 If LCID (a 16-bit number) is not a valid locale, the result is nil.")
|
|
1788 (lcid, longform)
|
|
1789 Lisp_Object lcid, longform;
|
|
1790 {
|
|
1791 int got_abbrev;
|
|
1792 int got_full;
|
|
1793 char abbrev_name[32] = { 0 };
|
|
1794 char full_name[256] = { 0 };
|
|
1795
|
|
1796 CHECK_NUMBER (lcid, 0);
|
|
1797
|
|
1798 if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
|
|
1799 return Qnil;
|
|
1800
|
|
1801 if (NILP (longform))
|
|
1802 {
|
|
1803 got_abbrev = GetLocaleInfo (XINT (lcid),
|
|
1804 LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
|
|
1805 abbrev_name, sizeof (abbrev_name));
|
|
1806 if (got_abbrev)
|
|
1807 return build_string (abbrev_name);
|
|
1808 }
|
23678
|
1809 else if (EQ (longform, Qt))
|
19712
|
1810 {
|
|
1811 got_full = GetLocaleInfo (XINT (lcid),
|
|
1812 LOCALE_SLANGUAGE | LOCALE_USE_CP_ACP,
|
|
1813 full_name, sizeof (full_name));
|
|
1814 if (got_full)
|
|
1815 return build_string (full_name);
|
|
1816 }
|
23678
|
1817 else if (NUMBERP (longform))
|
|
1818 {
|
|
1819 got_full = GetLocaleInfo (XINT (lcid),
|
|
1820 XINT (longform),
|
|
1821 full_name, sizeof (full_name));
|
|
1822 if (got_full)
|
|
1823 return make_unibyte_string (full_name, got_full);
|
|
1824 }
|
19712
|
1825
|
|
1826 return Qnil;
|
|
1827 }
|
|
1828
|
|
1829
|
|
1830 DEFUN ("w32-get-current-locale-id", Fw32_get_current_locale_id, Sw32_get_current_locale_id, 0, 0, 0,
|
|
1831 "Return Windows locale id for current locale setting.\n\
|
|
1832 This is a numerical value; use `w32-get-locale-info' to convert to a\n\
|
|
1833 human-readable form.")
|
|
1834 ()
|
|
1835 {
|
|
1836 return make_number (GetThreadLocale ());
|
|
1837 }
|
|
1838
|
21613
|
1839 DWORD int_from_hex (char * s)
|
|
1840 {
|
|
1841 DWORD val = 0;
|
|
1842 static char hex[] = "0123456789abcdefABCDEF";
|
|
1843 char * p;
|
|
1844
|
|
1845 while (*s && (p = strchr(hex, *s)) != NULL)
|
|
1846 {
|
|
1847 unsigned digit = p - hex;
|
|
1848 if (digit > 15)
|
|
1849 digit -= 6;
|
|
1850 val = val * 16 + digit;
|
|
1851 s++;
|
|
1852 }
|
|
1853 return val;
|
|
1854 }
|
|
1855
|
|
1856 /* We need to build a global list, since the EnumSystemLocale callback
|
|
1857 function isn't given a context pointer. */
|
|
1858 Lisp_Object Vw32_valid_locale_ids;
|
|
1859
|
|
1860 BOOL CALLBACK enum_locale_fn (LPTSTR localeNum)
|
|
1861 {
|
|
1862 DWORD id = int_from_hex (localeNum);
|
|
1863 Vw32_valid_locale_ids = Fcons (make_number (id), Vw32_valid_locale_ids);
|
|
1864 return TRUE;
|
|
1865 }
|
|
1866
|
|
1867 DEFUN ("w32-get-valid-locale-ids", Fw32_get_valid_locale_ids, Sw32_get_valid_locale_ids, 0, 0, 0,
|
|
1868 "Return list of all valid Windows locale ids.\n\
|
|
1869 Each id is a numerical value; use `w32-get-locale-info' to convert to a\n\
|
|
1870 human-readable form.")
|
|
1871 ()
|
|
1872 {
|
|
1873 Vw32_valid_locale_ids = Qnil;
|
|
1874
|
|
1875 EnumSystemLocales (enum_locale_fn, LCID_SUPPORTED);
|
|
1876
|
|
1877 Vw32_valid_locale_ids = Fnreverse (Vw32_valid_locale_ids);
|
|
1878 return Vw32_valid_locale_ids;
|
|
1879 }
|
|
1880
|
19712
|
1881
|
|
1882 DEFUN ("w32-get-default-locale-id", Fw32_get_default_locale_id, Sw32_get_default_locale_id, 0, 1, 0,
|
|
1883 "Return Windows locale id for default locale setting.\n\
|
|
1884 By default, the system default locale setting is returned; if the optional\n\
|
|
1885 parameter USERP is non-nil, the user default locale setting is returned.\n\
|
|
1886 This is a numerical value; use `w32-get-locale-info' to convert to a\n\
|
|
1887 human-readable form.")
|
|
1888 (userp)
|
|
1889 Lisp_Object userp;
|
|
1890 {
|
|
1891 if (NILP (userp))
|
|
1892 return make_number (GetSystemDefaultLCID ());
|
|
1893 return make_number (GetUserDefaultLCID ());
|
|
1894 }
|
|
1895
|
|
1896
|
|
1897 DEFUN ("w32-set-current-locale", Fw32_set_current_locale, Sw32_set_current_locale, 1, 1, 0,
|
|
1898 "Make Windows locale LCID be the current locale setting for Emacs.\n\
|
|
1899 If successful, the new locale id is returned, otherwise nil.")
|
|
1900 (lcid)
|
|
1901 Lisp_Object lcid;
|
|
1902 {
|
|
1903 CHECK_NUMBER (lcid, 0);
|
|
1904
|
|
1905 if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
|
|
1906 return Qnil;
|
|
1907
|
|
1908 if (!SetThreadLocale (XINT (lcid)))
|
|
1909 return Qnil;
|
|
1910
|
21613
|
1911 /* Need to set input thread locale if present. */
|
|
1912 if (dwWindowsThreadId)
|
|
1913 /* Reply is not needed. */
|
|
1914 PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0);
|
|
1915
|
19712
|
1916 return make_number (GetThreadLocale ());
|
|
1917 }
|
|
1918
|
23678
|
1919
|
|
1920 /* We need to build a global list, since the EnumCodePages callback
|
|
1921 function isn't given a context pointer. */
|
|
1922 Lisp_Object Vw32_valid_codepages;
|
|
1923
|
|
1924 BOOL CALLBACK enum_codepage_fn (LPTSTR codepageNum)
|
|
1925 {
|
|
1926 DWORD id = atoi (codepageNum);
|
|
1927 Vw32_valid_codepages = Fcons (make_number (id), Vw32_valid_codepages);
|
|
1928 return TRUE;
|
|
1929 }
|
|
1930
|
|
1931 DEFUN ("w32-get-valid-codepages", Fw32_get_valid_codepages, Sw32_get_valid_codepages, 0, 0, 0,
|
|
1932 "Return list of all valid Windows codepages.")
|
|
1933 ()
|
|
1934 {
|
|
1935 Vw32_valid_codepages = Qnil;
|
|
1936
|
|
1937 EnumSystemCodePages (enum_codepage_fn, CP_SUPPORTED);
|
|
1938
|
|
1939 Vw32_valid_codepages = Fnreverse (Vw32_valid_codepages);
|
|
1940 return Vw32_valid_codepages;
|
|
1941 }
|
|
1942
|
|
1943
|
|
1944 DEFUN ("w32-get-console-codepage", Fw32_get_console_codepage, Sw32_get_console_codepage, 0, 0, 0,
|
|
1945 "Return current Windows codepage for console input.")
|
|
1946 ()
|
|
1947 {
|
|
1948 return make_number (GetConsoleCP ());
|
|
1949 }
|
|
1950
|
|
1951
|
|
1952 DEFUN ("w32-set-console-codepage", Fw32_set_console_codepage, Sw32_set_console_codepage, 1, 1, 0,
|
|
1953 "Make Windows codepage CP be the current codepage setting for Emacs.\n\
|
|
1954 The codepage setting affects keyboard input and display in tty mode.\n\
|
|
1955 If successful, the new CP is returned, otherwise nil.")
|
|
1956 (cp)
|
|
1957 Lisp_Object cp;
|
|
1958 {
|
|
1959 CHECK_NUMBER (cp, 0);
|
|
1960
|
|
1961 if (!IsValidCodePage (XINT (cp)))
|
|
1962 return Qnil;
|
|
1963
|
|
1964 if (!SetConsoleCP (XINT (cp)))
|
|
1965 return Qnil;
|
|
1966
|
|
1967 return make_number (GetConsoleCP ());
|
|
1968 }
|
|
1969
|
|
1970
|
|
1971 DEFUN ("w32-get-console-output-codepage", Fw32_get_console_output_codepage, Sw32_get_console_output_codepage, 0, 0, 0,
|
|
1972 "Return current Windows codepage for console output.")
|
|
1973 ()
|
|
1974 {
|
|
1975 return make_number (GetConsoleOutputCP ());
|
|
1976 }
|
|
1977
|
|
1978
|
|
1979 DEFUN ("w32-set-console-output-codepage", Fw32_set_console_output_codepage, Sw32_set_console_output_codepage, 1, 1, 0,
|
|
1980 "Make Windows codepage CP be the current codepage setting for Emacs.\n\
|
|
1981 The codepage setting affects keyboard input and display in tty mode.\n\
|
|
1982 If successful, the new CP is returned, otherwise nil.")
|
|
1983 (cp)
|
|
1984 Lisp_Object cp;
|
|
1985 {
|
|
1986 CHECK_NUMBER (cp, 0);
|
|
1987
|
|
1988 if (!IsValidCodePage (XINT (cp)))
|
|
1989 return Qnil;
|
|
1990
|
|
1991 if (!SetConsoleOutputCP (XINT (cp)))
|
|
1992 return Qnil;
|
|
1993
|
|
1994 return make_number (GetConsoleOutputCP ());
|
|
1995 }
|
|
1996
|
|
1997
|
|
1998 DEFUN ("w32-get-codepage-charset", Fw32_get_codepage_charset, Sw32_get_codepage_charset, 1, 1, 0,
|
|
1999 "Return charset of codepage CP.\n\
|
|
2000 Returns nil if the codepage is not valid.")
|
|
2001 (cp)
|
|
2002 Lisp_Object cp;
|
|
2003 {
|
|
2004 CHARSETINFO info;
|
|
2005
|
|
2006 CHECK_NUMBER (cp, 0);
|
|
2007
|
|
2008 if (!IsValidCodePage (XINT (cp)))
|
|
2009 return Qnil;
|
|
2010
|
|
2011 if (TranslateCharsetInfo ((DWORD *) XINT (cp), &info, TCI_SRCCODEPAGE))
|
|
2012 return make_number (info.ciCharset);
|
|
2013
|
|
2014 return Qnil;
|
|
2015 }
|
|
2016
|
|
2017
|
|
2018 DEFUN ("w32-get-valid-keyboard-layouts", Fw32_get_valid_keyboard_layouts, Sw32_get_valid_keyboard_layouts, 0, 0, 0,
|
|
2019 "Return list of Windows keyboard languages and layouts.\n\
|
|
2020 The return value is a list of pairs of language id and layout id.")
|
|
2021 ()
|
|
2022 {
|
|
2023 int num_layouts = GetKeyboardLayoutList (0, NULL);
|
|
2024 HKL * layouts = (HKL *) alloca (num_layouts * sizeof (HKL));
|
|
2025 Lisp_Object obj = Qnil;
|
|
2026
|
|
2027 if (GetKeyboardLayoutList (num_layouts, layouts) == num_layouts)
|
|
2028 {
|
|
2029 while (--num_layouts >= 0)
|
|
2030 {
|
|
2031 DWORD kl = (DWORD) layouts[num_layouts];
|
|
2032
|
|
2033 obj = Fcons (Fcons (make_number (kl & 0xffff),
|
|
2034 make_number ((kl >> 16) & 0xffff)),
|
|
2035 obj);
|
|
2036 }
|
|
2037 }
|
|
2038
|
|
2039 return obj;
|
|
2040 }
|
|
2041
|
|
2042
|
|
2043 DEFUN ("w32-get-keyboard-layout", Fw32_get_keyboard_layout, Sw32_get_keyboard_layout, 0, 0, 0,
|
|
2044 "Return current Windows keyboard language and layout.\n\
|
|
2045 The return value is the cons of the language id and the layout id.")
|
|
2046 ()
|
|
2047 {
|
|
2048 DWORD kl = (DWORD) GetKeyboardLayout (dwWindowsThreadId);
|
|
2049
|
|
2050 return Fcons (make_number (kl & 0xffff),
|
|
2051 make_number ((kl >> 16) & 0xffff));
|
|
2052 }
|
|
2053
|
|
2054
|
|
2055 DEFUN ("w32-set-keyboard-layout", Fw32_set_keyboard_layout, Sw32_set_keyboard_layout, 1, 1, 0,
|
|
2056 "Make LAYOUT be the current keyboard layout for Emacs.\n\
|
|
2057 The keyboard layout setting affects interpretation of keyboard input.\n\
|
|
2058 If successful, the new layout id is returned, otherwise nil.")
|
|
2059 (layout)
|
|
2060 Lisp_Object layout;
|
|
2061 {
|
|
2062 DWORD kl;
|
|
2063
|
|
2064 CHECK_CONS (layout, 0);
|
25646
|
2065 CHECK_NUMBER (XCAR (layout), 0);
|
|
2066 CHECK_NUMBER (XCDR (layout), 0);
|
23678
|
2067
|
25646
|
2068 kl = (XINT (XCAR (layout)) & 0xffff)
|
|
2069 | (XINT (XCDR (layout)) << 16);
|
23678
|
2070
|
|
2071 /* Synchronize layout with input thread. */
|
|
2072 if (dwWindowsThreadId)
|
|
2073 {
|
|
2074 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_SETKEYBOARDLAYOUT,
|
|
2075 (WPARAM) kl, 0))
|
|
2076 {
|
|
2077 MSG msg;
|
|
2078 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
|
|
2079
|
|
2080 if (msg.wParam == 0)
|
|
2081 return Qnil;
|
|
2082 }
|
|
2083 }
|
|
2084 else if (!ActivateKeyboardLayout ((HKL) kl, 0))
|
|
2085 return Qnil;
|
|
2086
|
|
2087 return Fw32_get_keyboard_layout ();
|
|
2088 }
|
|
2089
|
19712
|
2090
|
15201
|
2091 syms_of_ntproc ()
|
|
2092 {
|
19712
|
2093 Qhigh = intern ("high");
|
|
2094 Qlow = intern ("low");
|
|
2095
|
15356
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2096 #ifdef HAVE_SOCKETS
|
16588
|
2097 defsubr (&Sw32_has_winsock);
|
|
2098 defsubr (&Sw32_unload_winsock);
|
15356
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2099 #endif
|
19712
|
2100 defsubr (&Sw32_short_file_name);
|
|
2101 defsubr (&Sw32_long_file_name);
|
|
2102 defsubr (&Sw32_set_process_priority);
|
|
2103 defsubr (&Sw32_get_locale_info);
|
|
2104 defsubr (&Sw32_get_current_locale_id);
|
|
2105 defsubr (&Sw32_get_default_locale_id);
|
21613
|
2106 defsubr (&Sw32_get_valid_locale_ids);
|
19712
|
2107 defsubr (&Sw32_set_current_locale);
|
15356
1a917c5d944c
(Fwin32_has_winsock, Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2108
|
23678
|
2109 defsubr (&Sw32_get_console_codepage);
|
|
2110 defsubr (&Sw32_set_console_codepage);
|
|
2111 defsubr (&Sw32_get_console_output_codepage);
|
|
2112 defsubr (&Sw32_set_console_output_codepage);
|
|
2113 defsubr (&Sw32_get_valid_codepages);
|
|
2114 defsubr (&Sw32_get_codepage_charset);
|
|
2115
|
|
2116 defsubr (&Sw32_get_valid_keyboard_layouts);
|
|
2117 defsubr (&Sw32_get_keyboard_layout);
|
|
2118 defsubr (&Sw32_set_keyboard_layout);
|
|
2119
|
16588
|
2120 DEFVAR_LISP ("w32-quote-process-args", &Vw32_quote_process_args,
|
15201
|
2121 "Non-nil enables quoting of process arguments to ensure correct parsing.\n\
|
|
2122 Because Windows does not directly pass argv arrays to child processes,\n\
|
|
2123 programs have to reconstruct the argv array by parsing the command\n\
|
|
2124 line string. For an argument to contain a space, it must be enclosed\n\
|
|
2125 in double quotes or it will be parsed as multiple arguments.\n\
|
|
2126 \n\
|
19712
|
2127 If the value is a character, that character will be used to escape any\n\
|
|
2128 quote characters that appear, otherwise a suitable escape character\n\
|
|
2129 will be chosen based on the type of the program.");
|
|
2130 Vw32_quote_process_args = Qt;
|
15247
|
2131
|
16588
|
2132 DEFVAR_LISP ("w32-start-process-show-window",
|
|
2133 &Vw32_start_process_show_window,
|
23949
|
2134 "When nil, new child processes hide their windows.\n\
|
16000
|
2135 When non-nil, they show their window in the method of their choice.");
|
16588
|
2136 Vw32_start_process_show_window = Qnil;
|
16000
|
2137
|
19712
|
2138 DEFVAR_LISP ("w32-start-process-share-console",
|
|
2139 &Vw32_start_process_share_console,
|
23949
|
2140 "When nil, new child processes are given a new console.\n\
|
19712
|
2141 When non-nil, they share the Emacs console; this has the limitation of\n\
|
|
2142 allowing only only DOS subprocess to run at a time (whether started directly\n\
|
|
2143 or indirectly by Emacs), and preventing Emacs from cleanly terminating the\n\
|
|
2144 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't\n\
|
|
2145 otherwise respond to interrupts from Emacs.");
|
|
2146 Vw32_start_process_share_console = Qnil;
|
|
2147
|
23949
|
2148 DEFVAR_LISP ("w32-start-process-inherit-error-mode",
|
|
2149 &Vw32_start_process_inherit_error_mode,
|
|
2150 "When nil, new child processes revert to the default error mode.\n\
|
|
2151 When non-nil, they inherit their error mode setting from Emacs, which stops\n\
|
|
2152 them blocking when trying to access unmounted drives etc.");
|
|
2153 Vw32_start_process_inherit_error_mode = Qt;
|
|
2154
|
16588
|
2155 DEFVAR_INT ("w32-pipe-read-delay", &Vw32_pipe_read_delay,
|
15247
|
2156 "Forced delay before reading subprocess output.\n\
|
|
2157 This is done to improve the buffering of subprocess output, by\n\
|
|
2158 avoiding the inefficiency of frequently reading small amounts of data.\n\
|
|
2159 \n\
|
|
2160 If positive, the value is the number of milliseconds to sleep before\n\
|
|
2161 reading the subprocess output. If negative, the magnitude is the number\n\
|
|
2162 of time slices to wait (effectively boosting the priority of the child\n\
|
|
2163 process temporarily). A value of zero disables waiting entirely.");
|
16588
|
2164 Vw32_pipe_read_delay = 50;
|
15325
|
2165
|
16588
|
2166 DEFVAR_LISP ("w32-downcase-file-names", &Vw32_downcase_file_names,
|
15325
|
2167 "Non-nil means convert all-upper case file names to lower case.\n\
|
|
2168 This applies when performing completions and file name expansion.");
|
16588
|
2169 Vw32_downcase_file_names = Qnil;
|
19712
|
2170
|
|
2171 #if 0
|
|
2172 DEFVAR_LISP ("w32-generate-fake-inodes", &Vw32_generate_fake_inodes,
|
|
2173 "Non-nil means attempt to fake realistic inode values.\n\
|
|
2174 This works by hashing the truename of files, and should detect \n\
|
|
2175 aliasing between long and short (8.3 DOS) names, but can have\n\
|
|
2176 false positives because of hash collisions. Note that determing\n\
|
|
2177 the truename of a file can be slow.");
|
|
2178 Vw32_generate_fake_inodes = Qnil;
|
|
2179 #endif
|
|
2180
|
|
2181 DEFVAR_LISP ("w32-get-true-file-attributes", &Vw32_get_true_file_attributes,
|
|
2182 "Non-nil means determine accurate link count in file-attributes.\n\
|
|
2183 This option slows down file-attributes noticeably, so is disabled by\n\
|
|
2184 default. Note that it is only useful for files on NTFS volumes,\n\
|
|
2185 where hard links are supported.");
|
|
2186 Vw32_get_true_file_attributes = Qnil;
|
15201
|
2187 }
|
15145
|
2188 /* end of ntproc.c */
|