annotate src/process-nt.c @ 853:2b6fa2618f76

[xemacs-hg @ 2002-05-28 08:44:22 by ben] merge my stderr-proc ws make-docfile.c: Fix places where we forget to check for EOF. code-init.el: Don't use CRLF conversion by default on process output. CMD.EXE and friends work both ways but Cygwin programs don't like the CRs. code-process.el, multicast.el, process.el: Removed. Improvements to call-process-internal: -- allows a buffer to be specified for input and stderr output -- use it on all systems -- implement C-g as documented -- clean up and comment call-process-region uses new call-process facilities; no temp file. remove duplicate funs in process.el. comment exactly how coding systems work and fix various problems. open-multicast-group now does similar coding-system frobbing to open-network-stream. dumped-lisp.el, faces.el, msw-faces.el: Fix some hidden errors due to code not being defined at the right time. xemacs.mak: Add -DSTRICT. ================================================================ ALLOW SEPARATION OF STDOUT AND STDERR IN PROCESSES ================================================================ Standard output and standard error can be processed separately in a process. Each can have its own buffer, its own mark in that buffer, and its filter function. You can specify a separate buffer for stderr in `start-process' to get things started, or use the new primitives: set-process-stderr-buffer process-stderr-buffer process-stderr-mark set-process-stderr-filter process-stderr-filter Also, process-send-region takes a 4th optional arg, a buffer. Currently always uses a pipe() under Unix to read the error output. (#### Would a PTY be better?) sysdep.h, sysproc.h, unexfreebsd.c, unexsunos4.c, nt.c, emacs.c, callproc.c, symsinit.h, sysdep.c, Makefile.in.in, process-unix.c: Delete callproc.c. Move child_setup() to process-unix.c. wait_for_termination() now only needed on a few really old systems. console-msw.h, event-Xt.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.h, process-nt.c, process-unix.c, process.c, process.h, procimpl.h: Rewrite the process methods to handle a separate channel for error input. Create Lstreams for reading in the error channel. Many process methods need change. In general the changes are fairly clear as they involve duplicating what's used for reading the normal stdout and changing for stderr -- although tedious, as such changes are required throughout the entire process code. Rewrote the code that reads process output to do two loops, one for stdout and one for stderr. gpmevent.c, tooltalk.c: set_process_filter takes an argument for stderr. ================================================================ NEW ERROR-TRAPPING MECHANISM ================================================================ Totally rewrite error trapping code to be unified and support more features. Basic function is call_trapping_problems(), which lets you specify, by means of flags, what sorts of problems you want trapped. these can include -- quit -- errors -- throws past the function -- creation of "display objects" (e.g. buffers) -- deletion of already-existing "display objects" (e.g. buffers) -- modification of already-existing buffers -- entering the debugger -- gc -- errors->warnings (ala suspended errors) etc. All other error funs rewritten in terms of this one. Various older mechanisms removed or rewritten. window.c, insdel.c, console.c, buffer.c, device.c, frame.c: When creating a display object, added call to note_object_created(), for use with trapping_problems mechanism. When deleting, call check_allowed_operation() and note_object deleted(). The trapping-problems code records the objects created since the call-trapping-problems began. Those objects can be deleted, but none others (i.e. previously existing ones). bytecode.c, cmdloop.c: internal_catch takes another arg. eval.c: Add long comments describing the "five lists" used to maintain state (backtrace, gcpro, specbind, etc.) in the Lisp engine. backtrace.h, eval.c: Implement trapping-problems mechanism, eliminate old mechanisms or redo in terms of new one. frame.c, gutter.c: Flush out the concept of "critical display section", defined by the in_display() var. Use an internal_bind() to get it reset, rather than just doing it at end, because there may be a non-local exit. event-msw.c, event-stream.c, console-msw.h, device.c, dialog-msw.c, frame.c, frame.h, intl.c, toolbar.c, menubar-msw.c, redisplay.c, alloc.c, menubar-x.c: Make use of new trapping-errors stuff and rewrite code based on old mechanisms. glyphs-widget.c, redisplay.h: Protect calling Lisp in redisplay. insdel.c: Protect hooks against deleting existing buffers. frame-msw.c: Use EQ, not EQUAL in hash tables whose keys are just numbers. Otherwise we run into stickiness in redisplay because internal_equal() can QUIT. ================================================================ SIGNAL, C-G CHANGES ================================================================ Here we change the way that C-g interacts with event reading. The idea is that a C-g occurring while we're reading a user event should be read as C-g, but elsewhere should be a QUIT. The former code did all sorts of bizarreness -- requiring that no QUIT occurs anywhere in event-reading code (impossible to enforce given the stuff called or Lisp code invoked), and having some weird system involving enqueue/dequeue of a C-g and interaction with Vquit_flag -- and it didn't work. Now, we simply enclose all code where we want C-g read as an event with {begin/end}_dont_check_for_quit(). This completely turns off the mechanism that checks (and may remove or alter) C-g in the read-ahead queues, so we just get the C-g normal. Signal.c documents this very carefully. cmdloop.c: Correct use of dont_check_for_quit to new scheme, remove old out-of-date comments. event-stream.c: Fix C-g handling to actually work. device-x.c: Disable quit checking when err out. signal.c: Cleanup. Add large descriptive comment. process-unix.c, process-nt.c, sysdep.c: Use QUIT instead of REALLY_QUIT. It's not necessary to use REALLY_QUIT and just confuses the issue. lisp.h: Comment quit handlers. ================================================================ CONS CHANGES ================================================================ free_cons() now takes a Lisp_Object not the result of XCONS(). car and cdr have been renamed so that they don't get used directly; go through XCAR(), XCDR() instead. alloc.c, dired.c, editfns.c, emodules.c, fns.c, glyphs-msw.c, glyphs-x.c, glyphs.c, keymap.c, minibuf.c, search.c, eval.c, lread.c, lisp.h: Correct free_cons calling convention: now takes Lisp_Object, not Lisp_Cons chartab.c: Eliminate direct use of ->car, ->cdr, should be black box. callint.c: Rewrote using EXTERNAL_LIST_LOOP to avoid use of Lisp_Cons. ================================================================ USE INTERNAL-BIND-* ================================================================ eval.c: Cleanups of these funs. alloc.c, fileio.c, undo.c, specifier.c, text.c, profile.c, lread.c, redisplay.c, menubar-x.c, macros.c: Rewrote to use internal_bind_int() and internal_bind_lisp_object() in place of whatever varied and cumbersome mechanisms were formerly there. ================================================================ SPECBIND SANITY ================================================================ backtrace.h: - Improved comments backtrace.h, bytecode.c, eval.c: Add new mechanism check_specbind_stack_sanity() for sanity checking code each time the catchlist or specbind stack change. Removed older prototype of same mechanism. ================================================================ MISC ================================================================ lisp.h, insdel.c, window.c, device.c, console.c, buffer.c: Fleshed out authorship. device-msw.c: Correct bad Unicode-ization. print.c: Be more careful when not initialized or in fatal error handling. search.c: Eliminate running_asynch_code, an FSF holdover. alloc.c: Added comments about gc-cons-threshold. dialog-x.c: Use begin_gc_forbidden() around code to build up a widget value tree, like in menubar-x.c. gui.c: Use Qunbound not Qnil as the default for gethash. lisp-disunion.h, lisp-union.h: Added warnings on use of VOID_TO_LISP(). lisp.h: Use ERROR_CHECK_STRUCTURES to turn on ERROR_CHECK_TRAPPING_PROBLEMS and ERROR_CHECK_TYPECHECK lisp.h: Add assert_with_message. lisp.h: Add macros for gcproing entire arrays. (You could do this before but it required manual twiddling the gcpro structure.) lisp.h: Add prototypes for new functions defined elsewhere.
author ben
date Tue, 28 May 2002 08:45:36 +0000
parents e7ee5f8bde58
children 1d8fb2eee1bb
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Asynchronous subprocess implementation for Win32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 Copyright (C) 1995 Sun Microsystems, Inc.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
5 Copyright (C) 1995, 1996, 2000, 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* Written by Kirill M. Katsnelson <kkm@kis.ru>, April 1998 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
26 /* Mule-ized as of 8-6-00 */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
27
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
31 #include "console-msw.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "hash.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "lstream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "process.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "procimpl.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 546
diff changeset
37 #include "syssignal.h"
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 546
diff changeset
38 #include "sysfile.h"
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 546
diff changeset
39 #include "sysproc.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
41 /* Bound by win32-native.el */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
42 Lisp_Object Qmswindows_construct_process_command_line;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
43
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 /* Arbitrary size limit for code fragments passed to run_in_other_process */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #define FRAGMENT_CODE_SIZE 32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 /* Implementation-specific data. Pointed to by Lisp_Process->process_data */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 struct nt_process_data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 HANDLE h_process;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
51 DWORD dwProcessId;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
52 HWND hwnd; /* console window */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
53 int selected_for_exit_notify;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
56 /* Control whether create_child causes the process to inherit Emacs'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
57 console window, or be given a new one of its own. The default is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
58 nil, to allow multiple DOS programs to run on Win95. Having separate
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
59 consoles also allows Emacs to cleanly terminate process groups. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
60 Lisp_Object Vmswindows_start_process_share_console;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
61
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
62 /* Control whether create_child cause the process to inherit Emacs'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
63 error mode setting. The default is t, to minimize the possibility of
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
64 subprocesses blocking when accessing unmounted drives. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
65 Lisp_Object Vmswindows_start_process_inherit_error_mode;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
66
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
67 #define NT_DATA(p) ((struct nt_process_data *)((p)->process_data))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 /* Process helpers */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
73 /* These break process abstraction. Prototypes in console-msw.h,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
74 used by select_process method in event-msw.c.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
75
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
76 If called the first time on a process, return the process handle, so we
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
77 can select on it and receive exit notification. "First time only" so we
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
78 don't select the same process multiple times if someone turns off and on
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
79 the receipt of process data. */
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
80
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
81 HANDLE
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
82 get_nt_process_handle_only_first_time (Lisp_Process *p)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
83 {
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
84 if (NT_DATA (p)->selected_for_exit_notify)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
85 return INVALID_HANDLE_VALUE;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
86 NT_DATA (p)->selected_for_exit_notify = 1;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
87 return (NT_DATA (p)->h_process);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
88 }
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
89
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 HANDLE
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
91 get_nt_process_handle (Lisp_Process *p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 return (NT_DATA (p)->h_process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
95
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
96 static struct Lisp_Process *
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
97 find_process_from_pid (DWORD pid)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
98 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
99 Lisp_Object tail, proc;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
100
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
101 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
102 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
103 proc = XCAR (tail);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
104 if (NT_DATA (XPROCESS (proc))->dwProcessId == pid)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
105 return XPROCESS (proc);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
106 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
107 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
108 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
109
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 /* Running remote threads. See Microsoft Systems Journal 1994 Number 5 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 /* Jeffrey Richter, Load Your 32-bit DLL into Another Process's Address..*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 typedef struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 HANDLE h_process;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 HANDLE h_thread;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 LPVOID address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 } process_memory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 * Allocate SIZE bytes in H_PROCESS address space. Fill in PMC used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 * further by other routines. Return nonzero if successful.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 * The memory in other process is allocated by creating a suspended
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 * thread. Initial stack of that thread is used as the memory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 * block. The thread entry point is the routine ExitThread in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 * kernel32.dll, so the allocated memory is freed just by resuming the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 * thread, which immediately terminates after that.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 static int
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
135 alloc_process_memory (HANDLE h_process, Bytecount size,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
136 process_memory *pmc)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 LPTHREAD_START_ROUTINE adr_ExitThread =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 (LPTHREAD_START_ROUTINE)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
140 GetProcAddress (qxeGetModuleHandle (XETEXT ("kernel32")), "ExitThread");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 DWORD dw_unused;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 CONTEXT context;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 MEMORY_BASIC_INFORMATION mbi;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 pmc->h_process = h_process;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 pmc->h_thread = CreateRemoteThread (h_process, NULL, size,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
147 adr_ExitThread, NULL,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
148 CREATE_SUSPENDED, &dw_unused);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 if (pmc->h_thread == NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 /* Get context, for thread's stack pointer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 context.ContextFlags = CONTEXT_CONTROL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 if (!GetThreadContext (pmc->h_thread, &context))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 goto failure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 /* Determine base address of the committed range */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 if (sizeof(mbi) != VirtualQueryEx (h_process,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 #if defined (_X86_)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (LPDWORD)context.Esp - 1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 #elif defined (_ALPHA_)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 (LPDWORD)context.IntSp - 1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 #error Unknown processor architecture
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 &mbi, sizeof(mbi)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 goto failure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 /* Change the page protection of the allocated memory to executable,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 read, and write. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 if (!VirtualProtectEx (h_process, mbi.BaseAddress, size,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 PAGE_EXECUTE_READWRITE, &dw_unused))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 goto failure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 pmc->address = mbi.BaseAddress;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 failure:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 ResumeThread (pmc->h_thread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 pmc->address = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 static void
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
185 free_process_memory (process_memory *pmc)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 ResumeThread (pmc->h_thread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 * Run ROUTINE in the context of process determined by H_PROCESS. The
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 * routine is passed the address of DATA as parameter. The ROUTINE must
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 * not be longer than ROUTINE_CODE_SIZE bytes. DATA_SIZE is the size of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 * DATA structure.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 * Note that the code must be positionally independent, and compiled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 * without stack checks (they cause implicit calls into CRT so will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 * fail). DATA should not refer any data in calling process, as both
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 * routine and its data are copied into remote process. Size of data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 * and code together should not exceed one page (4K on x86 systems).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 * Return the value returned by ROUTINE, or (DWORD)-1 if call failed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 static DWORD
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 run_in_other_process (HANDLE h_process,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 LPTHREAD_START_ROUTINE routine,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
207 LPVOID data, Bytecount data_size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 process_memory pm;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
210 const Bytecount code_size = FRAGMENT_CODE_SIZE;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 /* Need at most 3 extra bytes of memory, for data alignment */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
212 Bytecount total_size = code_size + data_size + 3;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 LPVOID remote_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 HANDLE h_thread;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 DWORD dw_unused;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 /* Allocate memory */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 if (!alloc_process_memory (h_process, total_size, &pm))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 return (DWORD)-1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 /* Copy code */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 if (!WriteProcessMemory (h_process, pm.address, (LPVOID)routine,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 code_size, NULL))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 goto failure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 /* Copy data */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 if (data_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 remote_data = (LPBYTE)pm.address + ((code_size + 4) & ~3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 if (!WriteProcessMemory (h_process, remote_data, data, data_size, NULL))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 goto failure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 remote_data = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 /* Execute the remote copy of code, passing it remote data */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 h_thread = CreateRemoteThread (h_process, NULL, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 (LPTHREAD_START_ROUTINE) pm.address,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 remote_data, 0, &dw_unused);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 if (h_thread == NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 goto failure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 /* Wait till thread finishes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 WaitForSingleObject (h_thread, INFINITE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 /* Free remote memory */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 free_process_memory (&pm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 /* Return thread's exit code */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 DWORD exit_code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 GetExitCodeThread (h_thread, &exit_code);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 CloseHandle (h_thread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 return exit_code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 failure:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 free_process_memory (&pm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 return (DWORD)-1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 /* Sending signals */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
266 /* ---------------------------- the NT way ------------------------------- */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
267
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 * We handle the following signals:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 * SIGKILL, SIGTERM, SIGQUIT, SIGHUP - These four translate to ExitProcess
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 * executed by the remote process
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 * SIGINT - The remote process is sent CTRL_BREAK_EVENT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 * The MSVC5.0 compiler feels free to re-order functions within a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 * compilation unit, so we have no way of finding out the size of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 * following functions. Therefore these functions must not be larger than
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 * FRAGMENT_CODE_SIZE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 * Sending SIGKILL
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 typedef struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 void (WINAPI *adr_ExitProcess) (UINT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 } sigkill_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 static DWORD WINAPI
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
290 sigkill_proc (sigkill_data *data)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 (*data->adr_ExitProcess)(255);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 * Sending break or control c
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 typedef struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 BOOL (WINAPI *adr_GenerateConsoleCtrlEvent) (DWORD, DWORD);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 DWORD event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 } sigint_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 static DWORD WINAPI
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
306 sigint_proc (sigint_data *data)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 return (*data->adr_GenerateConsoleCtrlEvent) (data->event, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 * Enabling signals
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 typedef struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 BOOL (WINAPI *adr_SetConsoleCtrlHandler) (LPVOID, BOOL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 } sig_enable_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 static DWORD WINAPI
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
320 sig_enable_proc (sig_enable_data *data)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (*data->adr_SetConsoleCtrlHandler) (NULL, FALSE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 * Send signal SIGNO to process H_PROCESS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 * Return nonzero if successful.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 static int
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
332 send_signal_the_nt_way (struct nt_process_data *cp, int pid, int signo)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
334 HANDLE h_process;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
335 HMODULE h_kernel = qxeGetModuleHandle (XETEXT ("kernel32"));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
336 int close_process = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 DWORD retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 assert (h_kernel != NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
341 if (cp)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
342 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
343 pid = cp->dwProcessId;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
344 h_process = cp->h_process;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
345 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
346 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
347 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
348 close_process = 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
349 /* Try to open the process with required privileges */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
350 h_process = OpenProcess (PROCESS_CREATE_THREAD
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
351 | PROCESS_QUERY_INFORMATION
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
352 | PROCESS_VM_OPERATION
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
353 | PROCESS_VM_WRITE,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
354 FALSE, pid);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
355 if (!h_process)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
356 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
357 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
358
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 switch (signo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 case SIGKILL:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 case SIGTERM:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 case SIGQUIT:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 case SIGHUP:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 sigkill_data d;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
367
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
368 d.adr_ExitProcess =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
369 (void (WINAPI *) (UINT)) GetProcAddress (h_kernel, "ExitProcess");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 assert (d.adr_ExitProcess);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 retval = run_in_other_process (h_process,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
372 (LPTHREAD_START_ROUTINE) sigkill_proc,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 &d, sizeof (d));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 case SIGINT:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 sigint_data d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 d.adr_GenerateConsoleCtrlEvent =
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
380 (BOOL (WINAPI *) (DWORD, DWORD))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 GetProcAddress (h_kernel, "GenerateConsoleCtrlEvent");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 assert (d.adr_GenerateConsoleCtrlEvent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 d.event = CTRL_C_EVENT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 retval = run_in_other_process (h_process,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
385 (LPTHREAD_START_ROUTINE) sigint_proc,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 &d, sizeof (d));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 assert (0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
393 if (close_process)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
394 CloseHandle (h_process);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 return (int)retval > 0 ? 1 : 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 * Enable CTRL_C_EVENT handling in a new child process
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 enable_child_signals (HANDLE h_process)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
404 HMODULE h_kernel = qxeGetModuleHandle (XETEXT ("kernel32"));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 sig_enable_data d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 assert (h_kernel != NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 d.adr_SetConsoleCtrlHandler =
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
409 (BOOL (WINAPI *) (LPVOID, BOOL))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 GetProcAddress (h_kernel, "SetConsoleCtrlHandler");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 assert (d.adr_SetConsoleCtrlHandler);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 run_in_other_process (h_process, (LPTHREAD_START_ROUTINE)sig_enable_proc,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 &d, sizeof (d));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
416 /* ---------------------------- the 95 way ------------------------------- */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
417
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
418 static BOOL CALLBACK
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
419 find_child_console (HWND hwnd, long putada)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
420 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
421 DWORD thread_id;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
422 DWORD process_id;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
423 struct nt_process_data *cp = (struct nt_process_data *) putada;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
424
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
425 thread_id = GetWindowThreadProcessId (hwnd, &process_id);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
426 if (process_id == cp->dwProcessId)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
427 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
428 Extbyte window_class[32];
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
429
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
430 /* GetClassNameA to avoid problems with Unicode return values */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
431 GetClassNameA (hwnd, window_class, sizeof (window_class));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
432 if (strcmp (window_class,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
433 mswindows_windows9x_p
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
434 ? "tty"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
435 : "ConsoleWindowClass") == 0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
436 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
437 cp->hwnd = hwnd;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
438 return FALSE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
439 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
440 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
441 /* keep looking */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
442 return TRUE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
443 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
444
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
445 static int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
446 send_signal_the_95_way (struct nt_process_data *cp, int pid, int signo)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
447 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
448 HANDLE h_process;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
449 int close_process = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
450 int rc = 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
451
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
452 if (cp)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
453 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
454 pid = cp->dwProcessId;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
455 h_process = cp->h_process;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
456
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
457 /* Try to locate console window for process. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
458 EnumWindows (find_child_console, (LPARAM) cp);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
459 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
460 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
461 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
462 close_process = 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
463 /* Try to open the process with required privileges */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
464 h_process = OpenProcess (PROCESS_TERMINATE, FALSE, pid);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
465 if (!h_process)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
466 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
467 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
468
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
469 if (signo == SIGINT)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
470 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
471 if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
472 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
473 BYTE control_scan_code = (BYTE) MapVirtualKeyA (VK_CONTROL, 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
474 BYTE vk_break_code = VK_CANCEL;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
475 BYTE break_scan_code = (BYTE) MapVirtualKeyA (vk_break_code, 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
476 HWND foreground_window;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
477
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
478 if (break_scan_code == 0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
479 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
480 /* Fake Ctrl-C if we can't manage Ctrl-Break. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
481 vk_break_code = 'C';
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
482 break_scan_code = (BYTE) MapVirtualKeyA (vk_break_code, 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
483 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
484
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
485 foreground_window = GetForegroundWindow ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
486 if (foreground_window)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
487 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
488 /* NT 5.0, and apparently also Windows 98, will not allow
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
489 a Window to be set to foreground directly without the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
490 user's involvement. The workaround is to attach
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
491 ourselves to the thread that owns the foreground
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
492 window, since that is the only thread that can set the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
493 foreground window. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
494 DWORD foreground_thread, child_thread;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
495 foreground_thread =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
496 GetWindowThreadProcessId (foreground_window, NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
497 if (foreground_thread == GetCurrentThreadId ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
498 || !AttachThreadInput (GetCurrentThreadId (),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
499 foreground_thread, TRUE))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
500 foreground_thread = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
501
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
502 child_thread = GetWindowThreadProcessId (cp->hwnd, NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
503 if (child_thread == GetCurrentThreadId ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
504 || !AttachThreadInput (GetCurrentThreadId (),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
505 child_thread, TRUE))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
506 child_thread = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
507
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
508 /* Set the foreground window to the child. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
509 if (SetForegroundWindow (cp->hwnd))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
510 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
511 /* Generate keystrokes as if user had typed Ctrl-Break or
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
512 Ctrl-C. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
513 keybd_event (VK_CONTROL, control_scan_code, 0, 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
514 keybd_event (vk_break_code, break_scan_code,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
515 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
516 keybd_event (vk_break_code, break_scan_code,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
517 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
518 | KEYEVENTF_KEYUP, 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
519 keybd_event (VK_CONTROL, control_scan_code,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
520 KEYEVENTF_KEYUP, 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
521
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
522 /* Sleep for a bit to give time for Emacs frame to respond
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
523 to focus change events (if Emacs was active app). */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
524 Sleep (100);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
525
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
526 SetForegroundWindow (foreground_window);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
527 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
528 /* Detach from the foreground and child threads now that
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
529 the foreground switching is over. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
530 if (foreground_thread)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
531 AttachThreadInput (GetCurrentThreadId (),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
532 foreground_thread, FALSE);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
533 if (child_thread)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
534 AttachThreadInput (GetCurrentThreadId (),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
535 child_thread, FALSE);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
536 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
537 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
538 /* Ctrl-Break is NT equivalent of SIGINT. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
539 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
540 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
541 #if 0 /* FSF Emacs */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
542 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
543 "for pid %lu\n", GetLastError (), pid));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
544 errno = EINVAL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
545 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
546 rc = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
547 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
548 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
549 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
550 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
551 if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
552 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
553 #if 1
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
554 if (mswindows_windows9x_p)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
555 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
556 /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
557 Another possibility is to try terminating the VDM out-right by
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
558 calling the Shell VxD (id 0x17) V86 interface, function #4
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
559 "SHELL_Destroy_VM", ie.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
560
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
561 mov edx,4
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
562 mov ebx,vm_handle
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
563 call shellapi
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
564
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
565 First need to determine the current VM handle, and then arrange for
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
566 the shellapi call to be made from the system vm (by using
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
567 Switch_VM_and_callback).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
568
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
569 Could try to invoke DestroyVM through CallVxD.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
570
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
571 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
572 #if 0
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
573 /* On Win95, posting WM_QUIT causes the 16-bit subsystem
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
574 to hang when cmdproxy is used in conjunction with
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
575 command.com for an interactive shell. Posting
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
576 WM_CLOSE pops up a dialog that, when Yes is selected,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
577 does the same thing. TerminateProcess is also less
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
578 than ideal in that subprocesses tend to stick around
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
579 until the machine is shutdown, but at least it
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
580 doesn't freeze the 16-bit subsystem. */
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 791
diff changeset
581 qxePostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
582 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
583 if (!TerminateProcess (h_process, 0xff))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
584 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
585 #if 0 /* FSF Emacs */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
586 DebPrint (("sys_kill.TerminateProcess returned %d "
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
587 "for pid %lu\n", GetLastError (), pid));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
588 errno = EINVAL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
589 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
590 rc = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
591 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
592 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
593 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
594 #endif
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 791
diff changeset
595 qxePostMessage (cp->hwnd, WM_CLOSE, 0, 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
596 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
597 /* Kill the process. On W32 this doesn't kill child processes
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
598 so it doesn't work very well for shells which is why it's not
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
599 used in every case. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
600 else if (!TerminateProcess (h_process, 0xff))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
601 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
602 #if 0 /* FSF Emacs */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
603 DebPrint (("sys_kill.TerminateProcess returned %d "
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
604 "for pid %lu\n", GetLastError (), pid));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
605 errno = EINVAL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
606 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
607 rc = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
608 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
609 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
610
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
611 if (close_process)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
612 CloseHandle (h_process);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
613
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
614 return rc;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
615 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
616
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
617 /* -------------------------- all-OS functions ---------------------------- */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
618
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
619 static int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
620 send_signal (struct nt_process_data *cp, int pid, int signo)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
621 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
622 return (!mswindows_windows9x_p && send_signal_the_nt_way (cp, pid, signo))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
623 || send_signal_the_95_way (cp, pid, signo);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
624 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
625
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 * Signal error if SIGNO is not supported
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 validate_signal_number (int signo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 if (signo != SIGKILL && signo != SIGTERM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 && signo != SIGQUIT && signo != SIGINT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 && signo != SIGHUP)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
635 invalid_constant ("Signal number not supported", make_int (signo));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 /* Process methods */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 * Allocate and initialize Lisp_Process->process_data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 static void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
647 nt_alloc_process_data (Lisp_Process *p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 p->process_data = xnew_and_zero (struct nt_process_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 static void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
653 nt_finalize_process_data (Lisp_Process *p, int for_disksave)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 assert (!for_disksave);
791
7b1f30330a19 [xemacs-hg @ 2002-03-21 18:55:01 by adrian]
adrian
parents: 771
diff changeset
656 /* If it's still in the list of processes we are waiting on delete
7b1f30330a19 [xemacs-hg @ 2002-03-21 18:55:01 by adrian]
adrian
parents: 771
diff changeset
657 it. */
7b1f30330a19 [xemacs-hg @ 2002-03-21 18:55:01 by adrian]
adrian
parents: 771
diff changeset
658 mswindows_unwait_process (p);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
659 if (NT_DATA (p)->h_process)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
660 CloseHandle (NT_DATA (p)->h_process);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 * Initialize XEmacs process implementation once
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 nt_init_process (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 /* Initialize winsock */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 WSADATA wsa_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 /* Request Winsock v1.1 Note the order: (minor=1, major=1) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 WSAStartup (MAKEWORD (1,1), &wsa_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
675 /*
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
676 * Fork off a subprocess. P is a pointer to newly created subprocess
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
677 * object. If this function signals, the caller is responsible for
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
678 * deleting (and finalizing) the process object.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
679 *
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
680 * The method must return PID of the new process, a (positive??? ####) number
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
681 * which fits into Lisp_Int. No return value indicates an error, the method
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
682 * must signal an error instead.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
683 */
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
684
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
685 static DOESNT_RETURN
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
686 mswindows_report_winsock_error (const char *string, Lisp_Object data,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
687 int errnum)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
689 report_file_type_error (Qnetwork_error, mswindows_lisp_error (errnum),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
690 string, data);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
691 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
692
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
693 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
694 ensure_console_window_exists (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
695 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
696 if (mswindows_windows9x_p)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
697 mswindows_hide_console ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
698 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
699
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
700 int
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
701 mswindows_compare_env (const void *strp1, const void *strp2)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
702 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
703 const Intbyte *str1 = *(const Intbyte **)strp1,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
704 *str2 = *(const Intbyte **)strp2;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
705
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
706 while (*str1 && *str2 && *str1 != '=' && *str2 != '=')
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
707 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
708 if ((*str1) > (*str2))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
709 return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
710 else if ((*str1) < (*str2))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
711 return -1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
712 str1++, str2++;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
713 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
714
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
715 if (*str1 == '=' && *str2 == '=')
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
716 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
717 else if (*str1 == '=')
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
718 return -1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
719 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
720 return 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
723 /*
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
724 * Fork off a subprocess. P is a pointer to newly created subprocess
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
725 * object. If this function signals, the caller is responsible for
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
726 * deleting (and finalizing) the process object.
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
727 *
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
728 * The method must return PID of the new process, a (positive??? ####) number
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
729 * which fits into Lisp_Int. No return value indicates an error, the method
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
730 * must signal an error instead.
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
731 */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
732
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 static int
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
734 nt_create_process (Lisp_Process *p,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 Lisp_Object *argv, int nargv,
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
736 Lisp_Object program, Lisp_Object cur_dir,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
737 int separate_err)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
739 /* Synched up with sys_spawnve in FSF 20.6. Significantly different
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
740 but still synchable. */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
741 HANDLE hmyshove, hmyslurp, hmyslurp_err, hprocin, hprocout, hprocerr;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
742 Extbyte *command_line;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 BOOL do_io, windowed;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
744 Extbyte *proc_env;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
746 /* No need to DOS-ize the filename; expand-file-name (called prior)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
747 already does this. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
748
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 /* Find out whether the application is windowed or not */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
750 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
751 /* SHGetFileInfo tends to return ERROR_FILE_NOT_FOUND on most
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
752 errors. This leads to bogus error message. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
753 DWORD image_type;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
754 Intbyte *p = qxestrrchr (XSTRING_DATA (program), '.');
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
755 if (p != NULL &&
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
756 (qxestrcasecmp (p, ".exe") == 0 ||
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
757 qxestrcasecmp (p, ".com") == 0 ||
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
758 qxestrcasecmp (p, ".bat") == 0 ||
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
759 qxestrcasecmp (p, ".cmd") == 0))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
760 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
761 Extbyte *progext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
762 LISP_STRING_TO_TSTR (program, progext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
763 image_type = qxeSHGetFileInfo (progext, 0, NULL, 0, SHGFI_EXETYPE);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
764 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
765 else
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
766 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
767 DECLARE_EISTRING (progext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
768 eicpy_lstr (progext, program);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
769 eicat_c (progext, ".exe");
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
770 eito_external (progext, Qmswindows_tstr);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
771 image_type = qxeSHGetFileInfo (eiextdata (progext), 0, NULL, 0,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
772 SHGFI_EXETYPE);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
773 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
774 if (image_type == 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
775 mswindows_report_process_error
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
776 ("Determining executable file type",
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
777 program,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
778 GetLastError () == ERROR_FILE_NOT_FOUND
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
779 ? ERROR_BAD_FORMAT : GetLastError ());
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
780 windowed = HIWORD (image_type) != 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
781 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
782
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 /* Decide whether to do I/O on process handles, or just mark the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 process exited immediately upon successful launching. We do I/O if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 process is a console one, or if it is windowed but windowed_process_io
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 is non-zero */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 do_io = !windowed || windowed_process_io ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 if (do_io)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 /* Create two unidirectional named pipes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 HANDLE htmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 SECURITY_ATTRIBUTES sa;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
796 sa.nLength = sizeof (sa);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 sa.bInheritHandle = TRUE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 sa.lpSecurityDescriptor = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 CreatePipe (&hprocin, &hmyshove, &sa, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 CreatePipe (&hmyslurp, &hprocout, &sa, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
803 if (separate_err)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
804 CreatePipe (&hmyslurp_err, &hprocerr, &sa, 0);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
805 else
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
806 /* Duplicate the stdout handle for use as stderr */
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
807 DuplicateHandle(GetCurrentProcess(), hprocout, GetCurrentProcess(),
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
808 &hprocerr, 0, TRUE, DUPLICATE_SAME_ACCESS);
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
809
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 /* Stupid Win32 allows to create a pipe with *both* ends either
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 inheritable or not. We need process ends inheritable, and local
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 ends not inheritable. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
813 DuplicateHandle (GetCurrentProcess(), hmyshove, GetCurrentProcess(),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
814 &htmp, 0, FALSE,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
815 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 hmyshove = htmp;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
817 DuplicateHandle (GetCurrentProcess(), hmyslurp, GetCurrentProcess(),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
818 &htmp, 0, FALSE,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
819 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 hmyslurp = htmp;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
821 if (separate_err)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
822 {
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
823 DuplicateHandle (GetCurrentProcess(), hmyslurp_err,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
824 GetCurrentProcess(), &htmp, 0, FALSE,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
825 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
826 hmyslurp_err = htmp;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
827 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 /* Convert an argv vector into Win32 style command line by a call to
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
831 lisp function `mswindows-construct-process-command-line'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
832 (in win32-native.el) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 Lisp_Object args_or_ret = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 GCPRO1 (args_or_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 for (i = 0; i < nargv; ++i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 args_or_ret = Fcons (*argv++, args_or_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 args_or_ret = Fnreverse (args_or_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 args_or_ret = Fcons (program, args_or_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
845 args_or_ret = call1 (Qmswindows_construct_process_command_line,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
846 args_or_ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 if (!STRINGP (args_or_ret))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 /* Luser wrote his/her own clever version */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
850 invalid_argument
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
851 ("Bogus return value from `mswindows-construct-process-command-line'",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
852 args_or_ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
854 LISP_STRING_TO_TSTR (args_or_ret, command_line);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 UNGCPRO; /* args_or_ret */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 /* Set `proc_env' to a nul-separated array of the strings in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 Vprocess_environment terminated by 2 nuls. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
861
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
863 Intbyte **env;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 REGISTER Lisp_Object tem;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
865 REGISTER Intbyte **new_env;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
866 REGISTER int new_length = 0, i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 for (tem = Vprocess_environment;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 (CONSP (tem)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 && STRINGP (XCAR (tem)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 tem = XCDR (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 new_length++;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
873
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
874 /* FSF adds an extra env var to hold the current process ID of the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
875 Emacs process. Apparently this is used only by emacsserver.c,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
876 which we have superseded by gnuserv.c. (#### Does it work under
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
877 MS Windows?)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
878
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
879 sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
880 GetCurrentProcessId ());
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
881 arglen += strlen (ppid_env_var_buffer) + 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
882 numenv++;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
883 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 /* new_length + 1 to include terminating 0. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
886 env = new_env = alloca_array (Intbyte *, new_length + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 /* Copy the Vprocess_environment strings into new_env. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 for (tem = Vprocess_environment;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 (CONSP (tem)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 && STRINGP (XCAR (tem)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 tem = XCDR (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
894 Intbyte **ep = env;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
895 Intbyte *string = XSTRING_DATA (XCAR (tem));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 /* See if this string duplicates any string already in the env.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 If so, don't put it in.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 When an env var has multiple definitions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 we keep the definition that comes first in process-environment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 for (; ep != new_env; ep++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
902 Intbyte *p = *ep, *q = string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 if (*q == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 /* The string is malformed; might as well drop it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 goto duplicate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 if (*q != *p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 if (*q == '=')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 goto duplicate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 p++, q++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 *new_env++ = string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 duplicate: ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 *new_env = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 /* Sort the environment variables */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 new_length = new_env - env;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
922 qsort (env, new_length, sizeof (Intbyte *), mswindows_compare_env);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
923
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
924 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
925 DECLARE_EISTRING (envout);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
926
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
927 for (i = 0; i < new_length; i++)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
928 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
929 eicat_raw (envout, env[i], strlen (env[i]));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
930 eicat_raw (envout, "\0", 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
931 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
932
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
933 eicat_raw (envout, "\0", 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
934 eito_external (envout, Qmswindows_tstr);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
935 proc_env = eiextdata (envout);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
936 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
938
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
939 #if 0
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
940 /* #### we need to port this. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
941 /* On Windows 95, if cmdname is a DOS app, we invoke a helper
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
942 application to start it by specifying the helper app as cmdname,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
943 while leaving the real app name as argv[0]. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
944 if (is_dos_app)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
945 {
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 826
diff changeset
946 cmdname = (Intbyte *) ALLOCA (PATH_MAX);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
947 if (egetenv ("CMDPROXY"))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
948 qxestrcpy (cmdname, egetenv ("CMDPROXY"));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
949 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
950 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
951 qxestrcpy (cmdname, XSTRING_DATA (Vinvocation_directory));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
952 qxestrcat (cmdname, (Intbyte *) "cmdproxy.exe");
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
953 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
954 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
955 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 /* Create process */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
959 STARTUPINFOW si;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 PROCESS_INFORMATION pi;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 DWORD err;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
962 DWORD flags;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 xzero (si);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 si.dwFlags = STARTF_USESHOWWINDOW;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 si.wShowWindow = windowed ? SW_SHOWNORMAL : SW_HIDE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 if (do_io)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 si.hStdInput = hprocin;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 si.hStdOutput = hprocout;
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
971 si.hStdError = hprocerr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 si.dwFlags |= STARTF_USESTDHANDLES;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
975 flags = CREATE_SUSPENDED;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
976 if (mswindows_windows9x_p)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
977 flags |= (!NILP (Vmswindows_start_process_share_console)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
978 ? CREATE_NEW_PROCESS_GROUP
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
979 : CREATE_NEW_CONSOLE);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
980 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
981 flags |= CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
982 if (NILP (Vmswindows_start_process_inherit_error_mode))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
983 flags |= CREATE_DEFAULT_ERROR_MODE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
984
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
985 ensure_console_window_exists ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
986
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
987 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
988 Extbyte *curdirext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
989
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
990 LISP_STRING_TO_TSTR (cur_dir, curdirext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
991
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
992 err = (qxeCreateProcess (NULL, command_line, NULL, NULL, TRUE,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
993 (XEUNICODE_P ?
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
994 flags | CREATE_UNICODE_ENVIRONMENT :
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
995 flags), proc_env,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
996 curdirext, &si, &pi)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
997 ? 0 : GetLastError ());
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
998 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 if (do_io)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 /* These just have been inherited; we do not need a copy */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 CloseHandle (hprocin);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 CloseHandle (hprocout);
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
1005 CloseHandle (hprocerr);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 /* Handle process creation failure */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 if (err)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 if (do_io)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 CloseHandle (hmyshove);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 CloseHandle (hmyslurp);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1015 if (separate_err)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1016 CloseHandle (hmyslurp_err);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 }
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1018 mswindows_report_process_error
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1019 ("Error starting",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1020 program, GetLastError ());
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 /* The process started successfully */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 if (do_io)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 NT_DATA(p)->h_process = pi.hProcess;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1027 NT_DATA(p)->dwProcessId = pi.dwProcessId;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1028 init_process_io_handles (p, (void *) hmyslurp, (void *) hmyshove,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1029 separate_err ? (void *) hmyslurp_err
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1030 : (void *) -1, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 /* Indicate as if the process has exited immediately. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 p->status_symbol = Qexit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 CloseHandle (pi.hProcess);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1039 if (!windowed)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1040 enable_child_signals (pi.hProcess);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1041
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 ResumeThread (pi.hThread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 CloseHandle (pi.hThread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044
432
3a7e78e1142d Import from CVS: tag r21-2-24
cvs
parents: 430
diff changeset
1045 return ((int)pi.dwProcessId);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 * This method is called to update status fields of the process
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 * structure. If the process has not existed, this method is expected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 * to do nothing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 * The method is called only for real child processes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 static void
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1058 nt_update_status_if_terminated (Lisp_Process *p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 DWORD exit_code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 if (GetExitCodeProcess (NT_DATA(p)->h_process, &exit_code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 && exit_code != STILL_ACTIVE)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 p->tick++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 p->core_dumped = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 /* The exit code can be a code returned by process, or an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 NTSTATUS value. We cannot accurately handle the latter since
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 it is a full 32 bit integer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 if (exit_code & 0xC0000000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 p->status_symbol = Qsignal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 p->exit_code = exit_code & 0x1FFFFFFF;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 p->status_symbol = Qexit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 p->exit_code = exit_code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 * Stuff the entire contents of LSTREAM to the process output pipe
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 /* #### If only this function could be somehow merged with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 unix_send_process... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 static void
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1090 nt_send_process (Lisp_Object proc, struct lstream *lstream)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 {
432
3a7e78e1142d Import from CVS: tag r21-2-24
cvs
parents: 430
diff changeset
1092 volatile Lisp_Object vol_proc = proc;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
1093 Lisp_Process *volatile p = XPROCESS (proc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 /* use a reasonable-sized buffer (somewhere around the size of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 stream buffer) so as to avoid inundating the stream with blocked
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 data. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1098 Intbyte chunkbuf[512];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 Bytecount chunklen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1103 int writeret;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1105 chunklen = Lstream_read (lstream, chunkbuf, 512);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 if (chunklen <= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 break; /* perhaps should abort() if < 0?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 This should never happen. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 /* Lstream_write() will never successfully write less than the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 amount sent in. In the worst case, it just buffers the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 unwritten data. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1113 writeret = Lstream_write (XLSTREAM (DATA_OUTSTREAM (p)), chunkbuf,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 chunklen);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1115 Lstream_flush (XLSTREAM (DATA_OUTSTREAM (p)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 if (writeret < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 p->status_symbol = Qexit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 p->exit_code = ERROR_BROKEN_PIPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 p->core_dumped = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 p->tick++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 process_tick++;
432
3a7e78e1142d Import from CVS: tag r21-2-24
cvs
parents: 430
diff changeset
1123 deactivate_process (*((Lisp_Object *) (&vol_proc)));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1124 invalid_operation ("Broken pipe error sending to process; closed it",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1125 p->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 int wait_ms = 25;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 /* Buffer is full. Wait, accepting input; that may allow
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 the program to finish doing output and read more. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 Faccept_process_output (Qnil, Qzero, make_int (wait_ms));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 Lstream_flush (XLSTREAM (p->pipe_outstream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 wait_ms = min (1000, 2 * wait_ms);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 * Send a signal number SIGNO to PROCESS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 * CURRENT_GROUP means send to the process group that currently owns
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 * the terminal being used to communicate with PROCESS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 * This is used for various commands in shell mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 * If NOMSG is zero, insert signal-announcements into process's buffers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 * right away.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 * If we can, we try to signal PROCESS by sending control characters
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 * down the pty. This allows us to signal inferiors who have changed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 * their uid, for which killpg would return an EPERM error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 * The method signals an error if the given SIGNO is not valid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 nt_kill_child_process (Lisp_Object proc, int signo,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 int current_group, int nomsg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
1161 Lisp_Process *p = XPROCESS (proc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 /* Signal error if SIGNO cannot be sent */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 validate_signal_number (signo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 /* Send signal */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1167 if (!send_signal (NT_DATA (p), 0, signo))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1168 invalid_operation ("Cannot send signal to process", proc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1172 * Kill any process in the system given its PID
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 * Returns zero if a signal successfully sent, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 * negative number upon failure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 nt_kill_process_by_pid (int pid, int signo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1180 struct Lisp_Process *p;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1181
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 /* Signal error if SIGNO cannot be sent */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 validate_signal_number (signo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1185 p = find_process_from_pid (pid);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1186 return send_signal (p ? NT_DATA (p) : 0, pid, signo) ? 0 : -1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 /* Sockets connections */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 #ifdef HAVE_SOCKETS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 /* #### Hey MS, how long Winsock 2 for '95 will be in beta? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 #define SOCK_TIMER_ID 666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 #define XM_SOCKREPLY (WM_USER + 666)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1199 /* Return 0 for success, or error code */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1200
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 static int
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1202 get_internet_address (Lisp_Object host, struct sockaddr_in *address)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1204 Char_Binary buf[MAXGETHOSTSTRUCT];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 HWND hwnd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 HANDLE hasync;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1207 int errcode = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 address->sin_family = AF_INET;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 /* First check if HOST is already a numeric address */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 unsigned long inaddr = inet_addr (XSTRING_DATA (host));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 if (inaddr != INADDR_NONE)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 address->sin_addr.s_addr = inaddr;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1217 return 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 /* Create a window which will receive completion messages */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1222 hwnd = qxeCreateWindow (XETEXT ("STATIC"), NULL, WS_OVERLAPPED, 0, 0, 1, 1,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1223 NULL, NULL, NULL, NULL);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 assert (hwnd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 /* Post name resolution request */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1227 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1228 Extbyte *hostext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1229
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1230 LISP_STRING_TO_EXTERNAL (host, hostext, Qmswindows_host_name_encoding);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1231
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1232 hasync = WSAAsyncGetHostByName (hwnd, XM_SOCKREPLY, hostext,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1233 buf, sizeof (buf));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1234 if (hasync == NULL)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1235 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1236 errcode = WSAGetLastError ();
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1237 goto done;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1238 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1239 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 /* Set a timer to poll for quit every 250 ms */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 MSG msg;
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 791
diff changeset
1247 qxeGetMessage (&msg, hwnd, 0, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 if (msg.message == XM_SOCKREPLY)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 /* Ok, got an answer */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1251 errcode = WSAGETASYNCERROR (msg.lParam);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 goto done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 if (QUITP)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 WSACancelAsyncRequest (hasync);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 KillTimer (hwnd, SOCK_TIMER_ID);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 DestroyWindow (hwnd);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1261 QUIT;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 }
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 791
diff changeset
1264 qxeDispatchMessage (&msg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 done:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 KillTimer (hwnd, SOCK_TIMER_ID);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 DestroyWindow (hwnd);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1270 if (!errcode)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 /* BUF starts with struct hostent */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1273 struct hostent *he = (struct hostent *) buf;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1274 address->sin_addr.s_addr = * (unsigned long *) he->h_addr_list[0];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 }
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1276 return errcode;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 nt_canonicalize_host_name (Lisp_Object host)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 struct sockaddr_in address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1284 if (get_internet_address (host, &address)) /* error */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 return host;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 if (address.sin_family == AF_INET)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 return build_string (inet_ntoa (address.sin_addr));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 return host;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 /* open a TCP network connection to a given HOST/SERVICE. Treated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 exactly like a normal process when reading and writing. Only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 differences are in status display and process deletion. A network
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 connection has no PID; you cannot signal it. All you can do is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 deactivate and close it via delete-process */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 static void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1300 nt_open_network_stream (Lisp_Object name, Lisp_Object host,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1301 Lisp_Object service,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1302 Lisp_Object protocol, void **vinfd, void **voutfd)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 struct sockaddr_in address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 SOCKET s;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 int port;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 int retval;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1308 int errnum;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 CHECK_STRING (host);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 if (!EQ (protocol, Qtcp))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1313 invalid_constant ("Unsupported protocol", protocol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 if (INTP (service))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 port = htons ((unsigned short) XINT (service));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 struct servent *svc_info;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1320 Extbyte *servext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1321
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 CHECK_STRING (service);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1323 LISP_STRING_TO_EXTERNAL (service, servext,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1324 Qmswindows_service_name_encoding);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1325
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1326 svc_info = getservbyname (servext, "tcp");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 if (svc_info == 0)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1328 invalid_argument ("Unknown service", service);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 port = svc_info->s_port;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1332 retval = get_internet_address (host, &address);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1333 if (retval)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1334 mswindows_report_winsock_error ("Getting IP address", host,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1335 retval);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 address.sin_port = port;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 s = socket (address.sin_family, SOCK_STREAM, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 if (s < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1340 mswindows_report_winsock_error ("Creating socket", name,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1341 WSAGetLastError ());
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 /* We don't want to be blocked on connect */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 unsigned long nonblock = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 ioctlsocket (s, FIONBIO, &nonblock);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 retval = connect (s, (struct sockaddr *) &address, sizeof (address));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 if (retval != NO_ERROR && WSAGetLastError() != WSAEWOULDBLOCK)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1351 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1352 errnum = WSAGetLastError ();
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1353 goto connect_failed;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1354 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1355
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1356 #if 0 /* PUTA! I thought getsockopt() was failing, so I created the
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1357 following based on the code in get_internet_address(), but
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1358 it was my own fault down below. Both versions should work. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 /* Wait while connection is established */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1360 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1361 HWND hwnd;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1362
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1363 /* Create a window which will receive completion messages */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1364 hwnd = qxeCreateWindow (XETEXT ("STATIC"), NULL, WS_OVERLAPPED, 0, 0, 1, 1,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1365 NULL, NULL, NULL, NULL);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1366 assert (hwnd);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1367
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1368 /* Post request */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1369 if (WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, FD_CONNECT))
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1370 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1371 errnum = WSAGetLastError ();
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1372 goto done;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1373 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1374
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1375 /* Set a timer to poll for quit every 250 ms */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1376 SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1377
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1378 while (1)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1379 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1380 MSG msg;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1381 GetMessage (&msg, hwnd, 0, 0);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1382 if (msg.message == XM_SOCKREPLY)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1383 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1384 /* Ok, got an answer */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1385 errnum = WSAGETASYNCERROR (msg.lParam);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1386 goto done;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1387 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1388
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1389 else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1390 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1391 if (QUITP)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1392 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1393 WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, 0);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1394 KillTimer (hwnd, SOCK_TIMER_ID);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1395 DestroyWindow (hwnd);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1396 QUIT;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1397 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1398 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1399 DispatchMessage (&msg);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1400 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1401
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1402 done:
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1403 WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, 0);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1404 KillTimer (hwnd, SOCK_TIMER_ID);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1405 DestroyWindow (hwnd);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1406 if (errnum)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1407 goto connect_failed;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1408 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1409
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1410 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1413 fd_set fdwriteset, fdexceptset;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 struct timeval tv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 int nsel;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 if (QUITP)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 closesocket (s);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1420 QUIT;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 /* Poll for quit every 250 ms */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 tv.tv_sec = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 tv.tv_usec = 250 * 1000;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1427 FD_ZERO (&fdwriteset);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1428 FD_SET (s, &fdwriteset);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1429 FD_ZERO (&fdexceptset);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1430 FD_SET (s, &fdexceptset);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1431 nsel = select (0, NULL, &fdwriteset, &fdexceptset, &tv);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1432
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1433 if (nsel == SOCKET_ERROR)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1434 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1435 errnum = WSAGetLastError ();
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1436 goto connect_failed;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1437 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 if (nsel > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 /* Check: was connection successful or not? */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1442 if (FD_ISSET (s, &fdwriteset))
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1443 break;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1444 else if (FD_ISSET (s, &fdexceptset))
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1445 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1446 int store_me_harder = sizeof (errnum);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1447 /* OK, we finally can get the REAL error code. Any paths
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1448 in this code that lead to a call of WSAGetLastError()
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1449 indicate probable logic failure. */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1450 if (getsockopt (s, SOL_SOCKET, SO_ERROR, (char *) &errnum,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1451 &store_me_harder))
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1452 errnum = WSAGetLastError ();
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1453 goto connect_failed;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1454 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1456 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1457 signal_error (Qinternal_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1458 "Porra, esse caralho de um sistema de operacao",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1459 Qunbound);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1460 break;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1461 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 }
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1464 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 /* We are connected at this point */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1467 *vinfd = (void *)s;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 DuplicateHandle (GetCurrentProcess(), (HANDLE)s,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 GetCurrentProcess(), (LPHANDLE)voutfd,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 0, FALSE, DUPLICATE_SAME_ACCESS);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1473 connect_failed:
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1474 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1475 closesocket (s);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1476 mswindows_report_winsock_error ("Connection failed",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1477 list3 (Qunbound, host, service),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1478 errnum);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1479 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 #endif
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1483
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1484
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1485 DEFUN ("mswindows-set-process-priority", Fmswindows_set_process_priority, 2, 2, "", /*
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1486 Set the priority of PROCESS to PRIORITY.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1487 If PROCESS is nil, the priority of Emacs is changed, otherwise the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1488 priority of the process whose pid is PROCESS is changed.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1489 PRIORITY should be one of the symbols high, normal, or low;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1490 any other symbol will be interpreted as normal.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1491
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1492 If successful, the return value is t, otherwise nil.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1493 */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1494 (process, priority))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1495 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1496 HANDLE proc_handle = GetCurrentProcess ();
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1497 DWORD priority_class = NORMAL_PRIORITY_CLASS;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1498 Lisp_Object result = Qnil;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1499
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1500 CHECK_SYMBOL (priority);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1501
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1502 if (!NILP (process))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1503 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1504 DWORD pid;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1505 struct Lisp_Process *p = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1506
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1507 if (PROCESSP (process))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1508 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1509 CHECK_LIVE_PROCESS (process);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1510 p = XPROCESS (process);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1511 pid = NT_DATA (p)->dwProcessId;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1512 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1513 else
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1514 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1515 CHECK_INT (process);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1516
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1517 /* Allow pid to be an internally generated one, or one obtained
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1518 externally. This is necessary because real pids on Win95 are
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1519 negative. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1520
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1521 pid = XINT (process);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1522 p = find_process_from_pid (pid);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1523 if (p != NULL)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1524 pid = NT_DATA (p)->dwProcessId;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1525 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1526
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1527 /* #### Should we be using the existing process handle from NT_DATA(p)?
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1528 Will we fail if we open it a second time? */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1529 proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1530 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1531
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1532 if (EQ (priority, Qhigh))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1533 priority_class = HIGH_PRIORITY_CLASS;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1534 else if (EQ (priority, Qlow))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1535 priority_class = IDLE_PRIORITY_CLASS;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1536
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1537 if (proc_handle != NULL)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1538 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1539 if (SetPriorityClass (proc_handle, priority_class))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1540 result = Qt;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1541 if (!NILP (process))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1542 CloseHandle (proc_handle);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1543 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1544
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1545 return result;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1546 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1547
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 /* Initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 process_type_create_nt (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 PROCESS_HAS_METHOD (nt, alloc_process_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 PROCESS_HAS_METHOD (nt, finalize_process_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 PROCESS_HAS_METHOD (nt, init_process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 PROCESS_HAS_METHOD (nt, create_process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 PROCESS_HAS_METHOD (nt, update_status_if_terminated);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 PROCESS_HAS_METHOD (nt, send_process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 PROCESS_HAS_METHOD (nt, kill_child_process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 PROCESS_HAS_METHOD (nt, kill_process_by_pid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 #ifdef HAVE_SOCKETS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 PROCESS_HAS_METHOD (nt, canonicalize_host_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 PROCESS_HAS_METHOD (nt, open_network_stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 #ifdef HAVE_MULTICAST
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 #error I won't do this until '95 has winsock2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 PROCESS_HAS_METHOD (nt, open_multicast_group);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 syms_of_process_nt (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1577 DEFSUBR (Fmswindows_set_process_priority);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1578 DEFSYMBOL (Qmswindows_construct_process_command_line);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 vars_of_process_nt (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1584 DEFVAR_LISP ("mswindows-start-process-share-console",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1585 &Vmswindows_start_process_share_console /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1586 When nil, new child processes are given a new console.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1587 When non-nil, they share the Emacs console; this has the limitation of
638
373ced43e288 [xemacs-hg @ 2001-07-26 21:10:44 by adrian]
adrian
parents: 563
diff changeset
1588 allowing only one DOS subprocess to run at a time (whether started directly
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1589 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1590 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1591 otherwise respond to interrupts from Emacs.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1592 */ );
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1593 Vmswindows_start_process_share_console = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1594
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1595 DEFVAR_LISP ("mswindows-start-process-inherit-error-mode",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1596 &Vmswindows_start_process_inherit_error_mode /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1597 "When nil, new child processes revert to the default error mode.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1598 When non-nil, they inherit their error mode setting from Emacs, which stops
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1599 them blocking when trying to access unmounted drives etc.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1600 */ );
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1601 Vmswindows_start_process_inherit_error_mode = Qt;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 }