annotate src/process-nt.c @ 2500:3d8143fc88e1

[xemacs-hg @ 2005-01-24 23:33:30 by ben] get working with VC7 config.inc.samp: Declare OPTIONAL_LIBRARY_DIR as root of library directories. Redo all graphics library defaults to mirror the versions and directories in the current binary aux distribution on xemacs web site. Enable TIFF and COMPFACE by default since you can now compile with them and binary libs are provided. xemacs.mak: Put our own directories first in case of conflict (e.g. config.h in compface). xemacs.mak: Use MSVCRT to avoid link problems. s/windowsnt.h: bytecode.c, print.c: Add casts to avoid warning. compiler.h: Add MSC_VERSION and include definitions of DOESNT_RETURN and friends here, like for GCC. Need different definitions for VC7 and VC6. s/windowsnt.h: Remove stuff moved to compiler.h. Disable warning 4646 ("function declared with __declspec(noreturn) has non-void return type") on VC7 since lots of Lisp primitives trigger this and there is no easy way to kludge around the warning. glyphs-eimage.c: Some really nasty hacks to allow TIFF and JPEG to both be compiled. #### The better solution is to move the TIFF and JPEG code to different files. glyphs-msw.c: Define __STDC__ to avoid problems with compface.h. intl-auto-encap-win32.c, intl-auto-encap-win32.h, intl-encap-win32.c, syswindows.h: Those wankers at Microsoft cannot leave well enough alone. Various functions change parameter types semi-randomly between VC6 and VC7, so we need to include our own versions that can handle both kinds with appropriate casting. EmacsFrame.c, EmacsShell-sub.c, EmacsShell.c, alloc.c, alloca.c, buffer.c, bytecode.c, charset.h, chartab.c, cm.c, console-stream.c, console.c, data.c, debug.h, device-msw.c, device-tty.c, device-x.c, doprnt.c, dumper.c, dynarr.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, extents.c, faces.c, file-coding.c, fileio.c, fns.c, font-lock.c, frame-gtk.c, frame-x.c, frame.c, free-hook.c, gccache-gtk.c, glyphs-eimage.c, glyphs-gtk.c, glyphs-msw.c, glyphs-x.c, glyphs.c, gtk-glue.c, gutter.c, input-method-xlib.c, insdel.c, intl-win32.c, keymap.c, lisp.h, lread.c, lstream.c, macros.c, malloc.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, mule-coding.c, native-gtk-toolbar.c, number.c, objects-msw.c, objects.c, print.c, process-nt.c, process-unix.c, process.c, ralloc.c, rangetab.c, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-tty.c, redisplay-x.c, redisplay.c, regex.c, scrollbar-gtk.c, scrollbar-x.c, search.c, select-x.c, signal.c, specifier.c, specifier.h, strftime.c, sunplay.c, symbols.c, sysdep.c, sysproc.h, text.c, text.h, toolbar-common.c, toolbar-msw.c, toolbar.c, ui-gtk.c, unexnt.c, unicode.c, win32.c, window.c, xgccache.c, s/windowsnt.h: abort() -> ABORT(). Eliminate preprocessor games with abort() since it creates huge problems in VC7, solvable only by including massive amounts of files in every compile (and not worth it).
author ben
date Mon, 24 Jan 2005 23:34:34 +0000
parents ab71ad6ff3dd
children 902d5bd9b75c
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.
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
5 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 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
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
28 /* Major comment about parsing and/or constructing a command line taken
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
29 from Windows, or suitable for giving to one of the library routines that
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
30 calls a subprocess is in win32-native.el */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
31
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
35 #include "console-msw.h"
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
36 #include "events.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "hash.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include "lstream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "process.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #include "procimpl.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
558
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 546
diff changeset
42 #include "sysfile.h"
ed498ef2108b [xemacs-hg @ 2001-05-23 09:59:33 by ben]
ben
parents: 546
diff changeset
43 #include "sysproc.h"
859
84762348c6f9 [xemacs-hg @ 2002-06-01 08:06:46 by ben]
ben
parents: 854
diff changeset
44 #include "syssignal.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
46 /* Bound by win32-native.el */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
47 Lisp_Object Qmswindows_construct_process_command_line;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
48
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 /* Arbitrary size limit for code fragments passed to run_in_other_process */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 #define FRAGMENT_CODE_SIZE 32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 /* Implementation-specific data. Pointed to by Lisp_Process->process_data */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 struct nt_process_data
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 HANDLE h_process;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
56 DWORD dwProcessId;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
57 HWND hwnd; /* console window */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
58 int selected_for_exit_notify;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
61 /* Control whether create_child causes the process to inherit Emacs'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
62 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
63 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
64 consoles also allows Emacs to cleanly terminate process groups. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
65 Lisp_Object Vmswindows_start_process_share_console;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
66
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
67 /* Control whether create_child cause the process to inherit Emacs'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
68 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
69 subprocesses blocking when accessing unmounted drives. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
70 Lisp_Object Vmswindows_start_process_inherit_error_mode;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
71
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
72 #define NT_DATA(p) ((struct nt_process_data *)((p)->process_data))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 /* Process helpers */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
78 /* 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
79 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
80
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
81 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
82 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
83 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
84 the receipt of process data. */
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
85
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
86 HANDLE
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
87 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
88 {
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
89 if (NT_DATA (p)->selected_for_exit_notify)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
90 return INVALID_HANDLE_VALUE;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
91 NT_DATA (p)->selected_for_exit_notify = 1;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
92 return (NT_DATA (p)->h_process);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
93 }
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
94
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 HANDLE
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
96 get_nt_process_handle (Lisp_Process *p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 return (NT_DATA (p)->h_process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 }
442
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 static struct Lisp_Process *
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
102 find_process_from_pid (DWORD pid)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
103 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
104 Lisp_Object tail, proc;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
105
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
106 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
107 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
108 proc = XCAR (tail);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
109 if (NT_DATA (XPROCESS (proc))->dwProcessId == pid)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
110 return XPROCESS (proc);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
111 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
112 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
113 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
114
428
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 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 /* Running remote threads. See Microsoft Systems Journal 1994 Number 5 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 /* Jeffrey Richter, Load Your 32-bit DLL into Another Process's Address..*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 typedef struct
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 HANDLE h_process;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 HANDLE h_thread;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 LPVOID address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 } process_memory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
128 static void
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
129 free_process_memory (process_memory *pmc)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
130 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
131 ResumeThread (pmc->h_thread);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
132 CloseHandle (pmc->h_thread);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
133 }
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
134
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 * Allocate SIZE bytes in H_PROCESS address space. Fill in PMC used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 * further by other routines. Return nonzero if successful.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 * The memory in other process is allocated by creating a suspended
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 * thread. Initial stack of that thread is used as the memory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 * block. The thread entry point is the routine ExitThread in
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
142 * kernel32.dll, so the allocated memory is freed just by resuming the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 * thread, which immediately terminates after that.
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
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
146 static int
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
147 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
148 process_memory *pmc)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 LPTHREAD_START_ROUTINE adr_ExitThread =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 (LPTHREAD_START_ROUTINE)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
152 GetProcAddress (qxeGetModuleHandle (XETEXT ("kernel32")), "ExitThread");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 DWORD dw_unused;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 CONTEXT context;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 MEMORY_BASIC_INFORMATION mbi;
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 pmc->h_process = h_process;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 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
159 adr_ExitThread, NULL,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
160 CREATE_SUSPENDED, &dw_unused);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 if (pmc->h_thread == NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 /* Get context, for thread's stack pointer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 context.ContextFlags = CONTEXT_CONTROL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 if (!GetThreadContext (pmc->h_thread, &context))
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 /* Determine base address of the committed range */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 if (sizeof(mbi) != VirtualQueryEx (h_process,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 #if defined (_X86_)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (LPDWORD)context.Esp - 1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 #elif defined (_ALPHA_)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 (LPDWORD)context.IntSp - 1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 #error Unknown processor architecture
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 &mbi, sizeof(mbi)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 goto failure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 /* Change the page protection of the allocated memory to executable,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 read, and write. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 if (!VirtualProtectEx (h_process, mbi.BaseAddress, size,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 PAGE_EXECUTE_READWRITE, &dw_unused))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 goto failure;
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 pmc->address = mbi.BaseAddress;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 return 1;
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 failure:
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
191 free_process_memory (pmc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 pmc->address = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 }
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 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 * Run ROUTINE in the context of process determined by H_PROCESS. The
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 * routine is passed the address of DATA as parameter. The ROUTINE must
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 * 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
200 * DATA structure.
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 * Note that the code must be positionally independent, and compiled
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 * without stack checks (they cause implicit calls into CRT so will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 * fail). DATA should not refer any data in calling process, as both
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 * routine and its data are copied into remote process. Size of data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 * and code together should not exceed one page (4K on x86 systems).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 * Return the value returned by ROUTINE, or (DWORD)-1 if call failed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 static DWORD
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 run_in_other_process (HANDLE h_process,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 LPTHREAD_START_ROUTINE routine,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
213 LPVOID data, Bytecount data_size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 process_memory pm;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
216 const Bytecount code_size = FRAGMENT_CODE_SIZE;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 /* 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
218 Bytecount total_size = code_size + data_size + 3;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 LPVOID remote_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 HANDLE h_thread;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 DWORD dw_unused;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 /* Allocate memory */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 if (!alloc_process_memory (h_process, total_size, &pm))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 return (DWORD)-1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 /* Copy code */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 if (!WriteProcessMemory (h_process, pm.address, (LPVOID)routine,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 code_size, NULL))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 goto failure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 /* Copy data */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 if (data_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 remote_data = (LPBYTE)pm.address + ((code_size + 4) & ~3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 if (!WriteProcessMemory (h_process, remote_data, data, data_size, NULL))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 goto failure;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 remote_data = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 /* Execute the remote copy of code, passing it remote data */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 h_thread = CreateRemoteThread (h_process, NULL, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (LPTHREAD_START_ROUTINE) pm.address,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 remote_data, 0, &dw_unused);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 if (h_thread == NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 goto failure;
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 /* Wait till thread finishes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 WaitForSingleObject (h_thread, INFINITE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 /* Free remote memory */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 free_process_memory (&pm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 /* Return thread's exit code */
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 DWORD exit_code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 GetExitCodeThread (h_thread, &exit_code);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 CloseHandle (h_thread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 return exit_code;
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 failure:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 free_process_memory (&pm);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
265 return (DWORD) -1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267
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 /* Sending 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
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
272 /* ---------------------------- the NT way ------------------------------- */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
273
428
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 * We handle the following signals:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 * SIGKILL, SIGTERM, SIGQUIT, SIGHUP - These four translate to ExitProcess
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 * executed by the remote process
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 * SIGINT - The remote process is sent CTRL_BREAK_EVENT
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 * The MSVC5.0 compiler feels free to re-order functions within a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 * 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
283 * following functions. Therefore these functions must not be larger than
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 * FRAGMENT_CODE_SIZE.
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 * Sending SIGKILL
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 typedef struct
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 void (WINAPI *adr_ExitProcess) (UINT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 } sigkill_data;
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 static DWORD WINAPI
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
296 sigkill_proc (sigkill_data *data)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 (*data->adr_ExitProcess)(255);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 return 1;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 * Sending break or control c
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 typedef struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 BOOL (WINAPI *adr_GenerateConsoleCtrlEvent) (DWORD, DWORD);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 DWORD event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 } sigint_data;
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 static DWORD WINAPI
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
312 sigint_proc (sigint_data *data)
428
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 return (*data->adr_GenerateConsoleCtrlEvent) (data->event, 0);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 * Enabling signals
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 typedef struct
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 BOOL (WINAPI *adr_SetConsoleCtrlHandler) (LPVOID, BOOL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 } sig_enable_data;
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 static DWORD WINAPI
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
326 sig_enable_proc (sig_enable_data *data)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 (*data->adr_SetConsoleCtrlHandler) (NULL, FALSE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 return 1;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 * Send signal SIGNO to process H_PROCESS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 * Return nonzero if successful.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 static int
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
338 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
339 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
340 HANDLE h_process;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
341 HMODULE h_kernel = qxeGetModuleHandle (XETEXT ("kernel32"));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
342 int close_process = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 DWORD retval;
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
344
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 assert (h_kernel != NULL);
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
346
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
347 if (cp)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
348 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
349 pid = cp->dwProcessId;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
350 h_process = cp->h_process;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
351 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
352 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
353 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
354 close_process = 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
355 /* Try to open the process with required privileges */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
356 h_process = OpenProcess (PROCESS_CREATE_THREAD
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
357 | PROCESS_QUERY_INFORMATION
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
358 | PROCESS_VM_OPERATION
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
359 | PROCESS_VM_WRITE,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
360 FALSE, pid);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
361 if (!h_process)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
362 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
363 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
364
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 switch (signo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 case SIGKILL:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 case SIGTERM:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 case SIGQUIT:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 case SIGHUP:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 sigkill_data d;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
373
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
374 d.adr_ExitProcess =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
375 (void (WINAPI *) (UINT)) GetProcAddress (h_kernel, "ExitProcess");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 assert (d.adr_ExitProcess);
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
377 retval = run_in_other_process (h_process,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
378 (LPTHREAD_START_ROUTINE) sigkill_proc,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 &d, sizeof (d));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 case SIGINT:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 sigint_data d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 d.adr_GenerateConsoleCtrlEvent =
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
386 (BOOL (WINAPI *) (DWORD, DWORD))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 GetProcAddress (h_kernel, "GenerateConsoleCtrlEvent");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 assert (d.adr_GenerateConsoleCtrlEvent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 d.event = CTRL_C_EVENT;
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
390 retval = run_in_other_process (h_process,
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
391 (LPTHREAD_START_ROUTINE) sigint_proc,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 &d, sizeof (d));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 assert (0);
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
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
399 if (close_process)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
400 CloseHandle (h_process);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
401 return (int) retval > 0 ? 1 : 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 * Enable CTRL_C_EVENT handling in a new child process
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 enable_child_signals (HANDLE h_process)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
410 HMODULE h_kernel = qxeGetModuleHandle (XETEXT ("kernel32"));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 sig_enable_data d;
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
412
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 assert (h_kernel != NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 d.adr_SetConsoleCtrlHandler =
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
415 (BOOL (WINAPI *) (LPVOID, BOOL))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 GetProcAddress (h_kernel, "SetConsoleCtrlHandler");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 assert (d.adr_SetConsoleCtrlHandler);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 run_in_other_process (h_process, (LPTHREAD_START_ROUTINE)sig_enable_proc,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 &d, sizeof (d));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 }
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
421
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
422 /* ---------------------------- the 95 way ------------------------------- */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
423
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
424 static BOOL CALLBACK
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
425 find_child_console (HWND hwnd, long putada)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
426 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
427 DWORD thread_id;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
428 DWORD process_id;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
429 struct nt_process_data *cp = (struct nt_process_data *) putada;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
430
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
431 thread_id = GetWindowThreadProcessId (hwnd, &process_id);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
432 if (process_id == cp->dwProcessId)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
433 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
434 Extbyte window_class[32];
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
435
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
436 /* GetClassNameA to avoid problems with Unicode return values */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
437 GetClassNameA (hwnd, window_class, sizeof (window_class));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
438 if (strcmp (window_class,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
439 mswindows_windows9x_p
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
440 ? "tty"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
441 : "ConsoleWindowClass") == 0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
442 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
443 cp->hwnd = hwnd;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
444 return FALSE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
445 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
446 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
447 /* keep looking */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
448 return TRUE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
449 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
450
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
451 static int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
452 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
453 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
454 HANDLE h_process;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
455 int close_process = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
456 int rc = 1;
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
457
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
458 if (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 pid = cp->dwProcessId;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
461 h_process = cp->h_process;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
462
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
463 /* Try to locate console window for process. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
464 EnumWindows (find_child_console, (LPARAM) cp);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
465 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
466 else
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 close_process = 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
469 /* Try to open the process with required privileges */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
470 h_process = OpenProcess (PROCESS_TERMINATE, FALSE, pid);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
471 if (!h_process)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
472 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
473 }
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
474
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
475 if (signo == SIGINT)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
476 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
477 if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
478 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
479 BYTE control_scan_code = (BYTE) MapVirtualKeyA (VK_CONTROL, 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
480 BYTE vk_break_code = VK_CANCEL;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
481 BYTE break_scan_code = (BYTE) MapVirtualKeyA (vk_break_code, 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
482 HWND foreground_window;
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 if (break_scan_code == 0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
485 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
486 /* Fake Ctrl-C if we can't manage Ctrl-Break. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
487 vk_break_code = 'C';
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
488 break_scan_code = (BYTE) MapVirtualKeyA (vk_break_code, 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
489 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
490
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
491 foreground_window = GetForegroundWindow ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
492 if (foreground_window)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
493 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
494 /* NT 5.0, and apparently also Windows 98, will not allow
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
495 a Window to be set to foreground directly without the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
496 user's involvement. The workaround is to attach
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
497 ourselves to the thread that owns the foreground
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
498 window, since that is the only thread that can set the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
499 foreground window. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
500 DWORD foreground_thread, child_thread;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
501 foreground_thread =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
502 GetWindowThreadProcessId (foreground_window, NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
503 if (foreground_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 foreground_thread, TRUE))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
506 foreground_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 child_thread = GetWindowThreadProcessId (cp->hwnd, NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
509 if (child_thread == GetCurrentThreadId ()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
510 || !AttachThreadInput (GetCurrentThreadId (),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
511 child_thread, TRUE))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
512 child_thread = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
513
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
514 /* Set the foreground window to the child. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
515 if (SetForegroundWindow (cp->hwnd))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
516 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
517 /* Generate keystrokes as if user had typed Ctrl-Break or
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
518 Ctrl-C. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
519 keybd_event (VK_CONTROL, control_scan_code, 0, 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
520 keybd_event (vk_break_code, break_scan_code,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
521 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
522 keybd_event (vk_break_code, break_scan_code,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
523 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
524 | KEYEVENTF_KEYUP, 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
525 keybd_event (VK_CONTROL, control_scan_code,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
526 KEYEVENTF_KEYUP, 0);
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 /* 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
529 to focus change events (if Emacs was active app). */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
530 Sleep (100);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
531
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
532 SetForegroundWindow (foreground_window);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
533 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
534 /* Detach from the foreground and child threads now that
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
535 the foreground switching is over. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
536 if (foreground_thread)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
537 AttachThreadInput (GetCurrentThreadId (),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
538 foreground_thread, FALSE);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
539 if (child_thread)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
540 AttachThreadInput (GetCurrentThreadId (),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
541 child_thread, FALSE);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
542 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
543 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
544 /* Ctrl-Break is NT equivalent of SIGINT. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
545 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
546 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
547 #if 0 /* FSF Emacs */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
548 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
549 "for pid %lu\n", GetLastError (), pid));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
550 errno = EINVAL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
551 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
552 rc = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
553 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
554 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
555 else
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 if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
558 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
559 #if 1
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
560 if (mswindows_windows9x_p)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
561 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
562 /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
563 Another possibility is to try terminating the VDM out-right by
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
564 calling the Shell VxD (id 0x17) V86 interface, function #4
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
565 "SHELL_Destroy_VM", ie.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
566
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
567 mov edx,4
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
568 mov ebx,vm_handle
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
569 call shellapi
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 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
572 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
573 Switch_VM_and_callback).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
574
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
575 Could try to invoke DestroyVM through CallVxD.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
576
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
577 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
578 #if 0
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
579 /* On Win95, posting WM_QUIT causes the 16-bit subsystem
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
580 to hang when cmdproxy is used in conjunction with
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
581 command.com for an interactive shell. Posting
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
582 WM_CLOSE pops up a dialog that, when Yes is selected,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
583 does the same thing. TerminateProcess is also less
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
584 than ideal in that subprocesses tend to stick around
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
585 until the machine is shutdown, but at least it
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
586 doesn't freeze the 16-bit subsystem. */
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 791
diff changeset
587 qxePostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
588 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
589 if (!TerminateProcess (h_process, 0xff))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
590 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
591 #if 0 /* FSF Emacs */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
592 DebPrint (("sys_kill.TerminateProcess returned %d "
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
593 "for pid %lu\n", GetLastError (), pid));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
594 errno = EINVAL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
595 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
596 rc = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
597 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
598 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
599 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
600 #endif
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 791
diff changeset
601 qxePostMessage (cp->hwnd, WM_CLOSE, 0, 0);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
602 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
603 /* Kill the process. On W32 this doesn't kill child processes
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
604 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
605 used in every case. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
606 else if (!TerminateProcess (h_process, 0xff))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
607 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
608 #if 0 /* FSF Emacs */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
609 DebPrint (("sys_kill.TerminateProcess returned %d "
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
610 "for pid %lu\n", GetLastError (), pid));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
611 errno = EINVAL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
612 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
613 rc = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
614 }
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 if (close_process)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
618 CloseHandle (h_process);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
619
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
620 return rc;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
621 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
622
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
623 /* -------------------------- all-OS functions ---------------------------- */
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 static int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
626 send_signal (struct nt_process_data *cp, int pid, int signo)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
627 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
628 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
629 || send_signal_the_95_way (cp, pid, signo);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
630 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
631
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 * Signal error if SIGNO is not supported
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 validate_signal_number (int signo)
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 if (signo != SIGKILL && signo != SIGTERM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 && signo != SIGQUIT && signo != SIGINT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 && signo != SIGHUP)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
641 invalid_constant ("Signal number not supported", make_int (signo));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 }
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
643
428
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 /* Process methods */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647
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 * Allocate and initialize Lisp_Process->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_alloc_process_data (Lisp_Process *p)
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 p->process_data = xnew_and_zero (struct nt_process_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 static void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
659 nt_finalize_process_data (Lisp_Process *p, int for_disksave)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 assert (!for_disksave);
791
7b1f30330a19 [xemacs-hg @ 2002-03-21 18:55:01 by adrian]
adrian
parents: 771
diff changeset
662 /* If it's still in the list of processes we are waiting on delete
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
663 it. This can happen if we forcibly delete a process and are unable
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
664 to kill it. */
791
7b1f30330a19 [xemacs-hg @ 2002-03-21 18:55:01 by adrian]
adrian
parents: 771
diff changeset
665 mswindows_unwait_process (p);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
666 if (NT_DATA (p)->h_process)
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
667 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
668 CloseHandle (NT_DATA (p)->h_process);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
669 NT_DATA (p)->h_process = 0;
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
670 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672
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 * Initialize XEmacs process implementation once
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 nt_init_process (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 /* Initialize winsock */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 WSADATA wsa_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 /* Request Winsock v1.1 Note the order: (minor=1, major=1) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 WSAStartup (MAKEWORD (1,1), &wsa_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
685 /*
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
686 * 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
687 * 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
688 * deleting (and finalizing) the process object.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
689 *
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
690 * 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
691 * 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
692 * must signal an error instead.
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
693 */
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
694
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
695 static DOESNT_RETURN
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
696 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
697 int errnum)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
699 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
700 string, data);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
701 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
702
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
703 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
704 ensure_console_window_exists (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
705 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
706 if (mswindows_windows9x_p)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
707 mswindows_hide_console ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
708 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
709
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
710 int
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
711 mswindows_compare_env (const void *strp1, const void *strp2)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
712 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
713 const Itext *str1 = * (const Itext **) strp1,
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
714 *str2 = * (const Itext **) strp2;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
715
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
716 while (*str1 && *str2 && *str1 != '=' && *str2 != '=')
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
717 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
718 if ((*str1) > (*str2))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
719 return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
720 else if ((*str1) < (*str2))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
721 return -1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
722 str1++, str2++;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
723 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
724
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
725 if (*str1 == '=' && *str2 == '=')
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
726 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
727 else if (*str1 == '=')
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
728 return -1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
729 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
730 return 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
733 /*
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
734 * 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
735 * 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
736 * deleting (and finalizing) the process object.
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
737 *
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
738 * 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
739 * 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
740 * must signal an error instead.
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
741 */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
742
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 static int
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
744 nt_create_process (Lisp_Process *p,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 Lisp_Object *argv, int nargv,
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
746 Lisp_Object program, Lisp_Object cur_dir,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
747 int separate_err)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
749 /* Synched up with sys_spawnve in FSF 20.6. Significantly different
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
750 but still synchable. */
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
751 HANDLE hmyshove, hmyslurp, hmyslurp_err, hprocin, hprocout, hprocerr;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
752 Extbyte *command_line;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 BOOL do_io, windowed;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
754 Extbyte *proc_env;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
756 /* 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
757 already does this. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
758
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 /* 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
760 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
761 /* 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
762 errors. This leads to bogus error message. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
763 DWORD image_type;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 867
diff changeset
764 if (mswindows_is_executable (XSTRING_DATA (program)))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
765 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
766 Extbyte *progext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
767 LISP_STRING_TO_TSTR (program, progext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
768 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
769 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
770 else
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
771 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
772 DECLARE_EISTRING (progext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
773 eicpy_lstr (progext, program);
2421
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
774 eicat_ascii (progext, ".exe");
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
775 eito_external (progext, Qmswindows_tstr);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
776 image_type = qxeSHGetFileInfo (eiextdata (progext), 0, NULL, 0,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
777 SHGFI_EXETYPE);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
778 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
779 if (image_type == 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
780 mswindows_report_process_error
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
781 ("Determining executable file type",
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
782 program,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
783 GetLastError () == ERROR_FILE_NOT_FOUND
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
784 ? ERROR_BAD_FORMAT : GetLastError ());
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
785 windowed = HIWORD (image_type) != 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
786 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
787
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 /* 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
790 process exited immediately upon successful launching. We do I/O if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 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
792 is non-zero */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 do_io = !windowed || windowed_process_io ;
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
794
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 if (do_io)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 /* Create two unidirectional named pipes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 HANDLE htmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 SECURITY_ATTRIBUTES sa;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
801 sa.nLength = sizeof (sa);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 sa.bInheritHandle = TRUE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 sa.lpSecurityDescriptor = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 CreatePipe (&hprocin, &hmyshove, &sa, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 CreatePipe (&hmyslurp, &hprocout, &sa, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
808 if (separate_err)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
809 CreatePipe (&hmyslurp_err, &hprocerr, &sa, 0);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
810 else
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
811 /* Duplicate the stdout handle for use as stderr */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
812 DuplicateHandle (GetCurrentProcess(), hprocout, GetCurrentProcess(),
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
813 &hprocerr, 0, TRUE, DUPLICATE_SAME_ACCESS);
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
814
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 /* Stupid Win32 allows to create a pipe with *both* ends either
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 inheritable or not. We need process ends inheritable, and local
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 ends not inheritable. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
818 DuplicateHandle (GetCurrentProcess(), hmyshove, GetCurrentProcess(),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
819 &htmp, 0, FALSE,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
820 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 hmyshove = htmp;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
822 DuplicateHandle (GetCurrentProcess(), hmyslurp, GetCurrentProcess(),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
823 &htmp, 0, FALSE,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
824 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 hmyslurp = htmp;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
826 if (separate_err)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
827 {
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
828 DuplicateHandle (GetCurrentProcess(), hmyslurp_err,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
829 GetCurrentProcess(), &htmp, 0, FALSE,
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
830 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
831 hmyslurp_err = htmp;
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
832 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 /* 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
836 lisp function `mswindows-construct-process-command-line'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
837 (in win32-native.el) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 Lisp_Object args_or_ret = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 GCPRO1 (args_or_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 for (i = 0; i < nargv; ++i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 args_or_ret = Fcons (*argv++, args_or_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 args_or_ret = Fnreverse (args_or_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 args_or_ret = Fcons (program, args_or_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
850 /* This Lisp function is in win32-native.el and has lots of comments
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
851 about what exactly is going on. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
852 args_or_ret = call1 (Qmswindows_construct_process_command_line,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
853 args_or_ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 if (!STRINGP (args_or_ret))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 /* Luser wrote his/her own clever version */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
857 invalid_argument
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
858 ("Bogus return value from `mswindows-construct-process-command-line'",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
859 args_or_ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
861 LISP_STRING_TO_TSTR (args_or_ret, command_line);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 UNGCPRO; /* args_or_ret */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 /* Set `proc_env' to a nul-separated array of the strings in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 Vprocess_environment terminated by 2 nuls. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
868
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 859
diff changeset
870 Ibyte **env;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 REGISTER Lisp_Object tem;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 859
diff changeset
872 REGISTER Ibyte **new_env;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
873 REGISTER int new_length = 0, i;
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
874
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 for (tem = Vprocess_environment;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 (CONSP (tem)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 && STRINGP (XCAR (tem)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 tem = XCDR (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 new_length++;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
880
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
881 /* 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
882 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
883 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
884 MS Windows?)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
885
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
886 sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d",
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
887 GetCurrentProcessId ());
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
888 arglen += strlen (ppid_env_var_buffer) + 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
889 numenv++;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
890 */
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
891
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 /* new_length + 1 to include terminating 0. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 859
diff changeset
893 env = new_env = alloca_array (Ibyte *, new_length + 1);
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
894
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 /* Copy the Vprocess_environment strings into new_env. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 for (tem = Vprocess_environment;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 (CONSP (tem)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 && STRINGP (XCAR (tem)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 tem = XCDR (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 859
diff changeset
901 Ibyte **ep = env;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 859
diff changeset
902 Ibyte *string = XSTRING_DATA (XCAR (tem));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 /* See if this string duplicates any string already in the env.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 If so, don't put it in.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 When an env var has multiple definitions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 we keep the definition that comes first in process-environment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 for (; ep != new_env; ep++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 859
diff changeset
909 Ibyte *p = *ep, *q = string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 if (*q == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 /* The string is malformed; might as well drop it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 goto duplicate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 if (*q != *p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 if (*q == '=')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 goto duplicate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 p++, q++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 *new_env++ = string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 duplicate: ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 *new_env = 0;
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
926
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 /* Sort the environment variables */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 new_length = new_env - env;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 859
diff changeset
929 qsort (env, new_length, sizeof (Ibyte *), mswindows_compare_env);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
930
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 DECLARE_EISTRING (envout);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
933
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
934 for (i = 0; i < new_length; i++)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
935 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 867
diff changeset
936 eicat_raw (envout, env[i], qxestrlen (env[i]));
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 867
diff changeset
937 eicat_raw (envout, (Ibyte *) "\0", 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
938 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
939
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 867
diff changeset
940 eicat_raw (envout, (Ibyte *) "\0", 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
941 eito_external (envout, Qmswindows_tstr);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
942 proc_env = eiextdata (envout);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
943 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
945
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
946 #if 0
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
947 /* #### we need to port this. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
948 /* 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
949 application to start it by specifying the helper app as cmdname,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
950 while leaving the real app name as argv[0]. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
951 if (is_dos_app)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
952 {
2421
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
953 cmdname = alloca_ibytes (PATH_MAX_INTERNAL);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
954 if (egetenv ("CMDPROXY"))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
955 qxestrcpy (cmdname, egetenv ("CMDPROXY"));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
956 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
957 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
958 qxestrcpy (cmdname, XSTRING_DATA (Vinvocation_directory));
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 859
diff changeset
959 qxestrcat (cmdname, (Ibyte *) "cmdproxy.exe");
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
960 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
961 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
962 #endif
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
963
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 /* Create process */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
966 STARTUPINFOW si;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 PROCESS_INFORMATION pi;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 DWORD err;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
969 DWORD flags;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 xzero (si);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 si.dwFlags = STARTF_USESHOWWINDOW;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 si.wShowWindow = windowed ? SW_SHOWNORMAL : SW_HIDE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 if (do_io)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 si.hStdInput = hprocin;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 si.hStdOutput = hprocout;
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
978 si.hStdError = hprocerr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 si.dwFlags |= STARTF_USESTDHANDLES;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
982 flags = CREATE_SUSPENDED;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
983 if (mswindows_windows9x_p)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
984 flags |= (!NILP (Vmswindows_start_process_share_console)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
985 ? CREATE_NEW_PROCESS_GROUP
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
986 : CREATE_NEW_CONSOLE);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
987 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
988 flags |= CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
989 if (NILP (Vmswindows_start_process_inherit_error_mode))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
990 flags |= CREATE_DEFAULT_ERROR_MODE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
991
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
992 ensure_console_window_exists ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
993
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
994 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
995 Extbyte *curdirext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
996
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
997 LISP_STRING_TO_TSTR (cur_dir, curdirext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
998
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
999 err = (qxeCreateProcess (NULL, command_line, NULL, NULL, TRUE,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1000 (XEUNICODE_P ?
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1001 flags | CREATE_UNICODE_ENVIRONMENT :
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1002 flags), proc_env,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1003 curdirext, &si, &pi)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1004 ? 0 : GetLastError ());
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1005 }
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 if (do_io)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 /* These just have been inherited; we do not need a copy */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 CloseHandle (hprocin);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 CloseHandle (hprocout);
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
1012 CloseHandle (hprocerr);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 }
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
1014
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 /* Handle process creation failure */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 if (err)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 if (do_io)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 CloseHandle (hmyshove);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 CloseHandle (hmyslurp);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1022 if (separate_err)
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1023 CloseHandle (hmyslurp_err);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 }
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1025 mswindows_report_process_error
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1026 ("Error starting",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1027 program, GetLastError ());
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 /* The process started successfully */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 if (do_io)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 NT_DATA(p)->h_process = pi.hProcess;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1034 NT_DATA(p)->dwProcessId = pi.dwProcessId;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1035 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
1036 separate_err ? (void *) hmyslurp_err
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1037 : (void *) -1, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 /* Indicate as if the process has exited immediately. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 p->status_symbol = Qexit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 CloseHandle (pi.hProcess);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1046 if (!windowed)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1047 enable_child_signals (pi.hProcess);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1048
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 ResumeThread (pi.hThread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 CloseHandle (pi.hThread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051
432
3a7e78e1142d Import from CVS: tag r21-2-24
cvs
parents: 430
diff changeset
1052 return ((int)pi.dwProcessId);
428
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
1056 /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 * This method is called to update status fields of the process
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 * structure. If the process has not existed, this method is expected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 * to do nothing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 *
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
1061 * The method is called only for real child processes.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 */
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 static void
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1065 nt_update_status_if_terminated (Lisp_Process *p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 DWORD exit_code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 if (GetExitCodeProcess (NT_DATA(p)->h_process, &exit_code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 && exit_code != STILL_ACTIVE)
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->tick++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 p->core_dumped = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 /* The exit code can be a code returned by process, or an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 NTSTATUS value. We cannot accurately handle the latter since
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 it is a full 32 bit integer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 if (exit_code & 0xC0000000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 p->status_symbol = Qsignal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 p->exit_code = exit_code & 0x1FFFFFFF;
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 else
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 p->status_symbol = Qexit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 p->exit_code = exit_code;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 }
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 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 * Stuff the entire contents of LSTREAM to the process output pipe
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 /* #### If only this function could be somehow merged with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 unix_send_process... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 static void
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1097 nt_send_process (Lisp_Object proc, struct lstream *lstream)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 {
432
3a7e78e1142d Import from CVS: tag r21-2-24
cvs
parents: 430
diff changeset
1099 volatile Lisp_Object vol_proc = proc;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
1100 Lisp_Process *volatile p = XPROCESS (proc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 /* use a reasonable-sized buffer (somewhere around the size of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 stream buffer) so as to avoid inundating the stream with blocked
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 data. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 859
diff changeset
1105 Ibyte chunkbuf[512];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 Bytecount chunklen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1110 int writeret;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1112 chunklen = Lstream_read (lstream, chunkbuf, 512);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 if (chunklen <= 0)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2421
diff changeset
1114 break; /* perhaps should ABORT() if < 0?
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 This should never happen. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 /* Lstream_write() will never successfully write less than the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 amount sent in. In the worst case, it just buffers the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 unwritten data. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1120 writeret = Lstream_write (XLSTREAM (DATA_OUTSTREAM (p)), chunkbuf,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 chunklen);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1122 Lstream_flush (XLSTREAM (DATA_OUTSTREAM (p)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 if (writeret < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 p->status_symbol = Qexit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 p->exit_code = ERROR_BROKEN_PIPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 p->core_dumped = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 p->tick++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 process_tick++;
432
3a7e78e1142d Import from CVS: tag r21-2-24
cvs
parents: 430
diff changeset
1130 deactivate_process (*((Lisp_Object *) (&vol_proc)));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1131 invalid_operation ("Broken pipe error sending to process; closed it",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1132 p->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 int wait_ms = 25;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream)))
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 /* Buffer is full. Wait, accepting input; that may allow
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 the program to finish doing output and read more. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 Faccept_process_output (Qnil, Qzero, make_int (wait_ms));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 Lstream_flush (XLSTREAM (p->pipe_outstream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 wait_ms = min (1000, 2 * wait_ms);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1149 static void
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1150 nt_deactivate_process (Lisp_Process *p,
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1151 USID *in_usid,
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1152 USID *err_usid)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1153 {
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1154 event_stream_delete_io_streams (p->pipe_instream, p->pipe_outstream,
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1155 p->pipe_errstream, in_usid, err_usid);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1156 /* Go ahead and close the process handle now to prevent accumulation
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1157 of handles when lots of processes are run. (The handle gets closed
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1158 anyway upon GC, but that might be a ways away, esp. if
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1159 deleted-exited-processes is set to nil.) */
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1160 nt_finalize_process_data (p, 0);
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1161 }
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1162
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 * Send a signal number SIGNO to PROCESS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 * CURRENT_GROUP means send to the process group that currently owns
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 * the terminal being used to communicate with PROCESS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 * This is used for various commands in shell mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 * If NOMSG is zero, insert signal-announcements into process's buffers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 * right away.
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 * If we can, we try to signal PROCESS by sending control characters
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 * down the pty. This allows us to signal inferiors who have changed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 * their uid, for which killpg would return an EPERM error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 * The method signals an error if the given SIGNO is not valid
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 nt_kill_child_process (Lisp_Object proc, int signo,
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1204
diff changeset
1180 int UNUSED (current_group), int UNUSED (nomsg))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
1182 Lisp_Process *p = XPROCESS (proc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 /* Signal error if SIGNO cannot be sent */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 validate_signal_number (signo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 /* Send signal */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1188 if (!send_signal (NT_DATA (p), 0, signo))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1189 invalid_operation ("Cannot send signal to process", proc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 }
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 /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1193 * Kill any process in the system given its PID
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 * Returns zero if a signal successfully sent, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 * negative number upon failure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 nt_kill_process_by_pid (int pid, int signo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1201 struct Lisp_Process *p;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1202
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 /* Signal error if SIGNO cannot be sent */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 validate_signal_number (signo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1206 p = find_process_from_pid (pid);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1207 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
1208 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209
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 /* Sockets connections */
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 #ifdef HAVE_SOCKETS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 /* #### Hey MS, how long Winsock 2 for '95 will be in beta? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 #define SOCK_TIMER_ID 666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 #define XM_SOCKREPLY (WM_USER + 666)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1220 /* Return 0 for success, or error code */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1221
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 static int
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1223 get_internet_address (Lisp_Object host, struct sockaddr_in *address)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1225 CBinbyte buf[MAXGETHOSTSTRUCT];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 HWND hwnd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 HANDLE hasync;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1228 int errcode = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 address->sin_family = AF_INET;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 /* First check if HOST is already a numeric address */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 867
diff changeset
1234 Extbyte *hostext;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 867
diff changeset
1235 unsigned long inaddr;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 867
diff changeset
1236
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 867
diff changeset
1237 LISP_STRING_TO_EXTERNAL (host, hostext, Qmswindows_host_name_encoding);
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 867
diff changeset
1238 inaddr = inet_addr (hostext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 if (inaddr != INADDR_NONE)
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 address->sin_addr.s_addr = inaddr;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1242 return 0;
428
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 }
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 /* 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
1247 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
1248 NULL, NULL, NULL, NULL);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 assert (hwnd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 /* Post name resolution request */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1252 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1253 Extbyte *hostext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1254
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1255 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
1256
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1257 hasync = WSAAsyncGetHostByName (hwnd, XM_SOCKREPLY, hostext,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1258 buf, sizeof (buf));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1259 if (hasync == NULL)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1260 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1261 errcode = WSAGetLastError ();
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1262 goto done;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1263 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1264 }
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 /* Set a timer to poll for quit every 250 ms */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 MSG msg;
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 791
diff changeset
1272 qxeGetMessage (&msg, hwnd, 0, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 if (msg.message == XM_SOCKREPLY)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 /* Ok, got an answer */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1276 errcode = WSAGETASYNCERROR (msg.lParam);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 goto done;
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 else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 if (QUITP)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 WSACancelAsyncRequest (hasync);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 KillTimer (hwnd, SOCK_TIMER_ID);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 DestroyWindow (hwnd);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1286 QUIT;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 }
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 791
diff changeset
1289 qxeDispatchMessage (&msg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 }
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 done:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 KillTimer (hwnd, SOCK_TIMER_ID);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 DestroyWindow (hwnd);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1295 if (!errcode)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 /* BUF starts with struct hostent */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1298 struct hostent *he = (struct hostent *) buf;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1299 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
1300 }
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1301 return errcode;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 nt_canonicalize_host_name (Lisp_Object host)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 struct sockaddr_in address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1309 if (get_internet_address (host, &address)) /* error */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 return 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 (address.sin_family == AF_INET)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 return build_string (inet_ntoa (address.sin_addr));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 return host;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 /* open a TCP network connection to a given HOST/SERVICE. Treated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 exactly like a normal process when reading and writing. Only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 differences are in status display and process deletion. A network
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 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
1322 deactivate and close it via delete-process */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 static void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1325 nt_open_network_stream (Lisp_Object name, Lisp_Object host,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1326 Lisp_Object service,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1327 Lisp_Object protocol, void **vinfd, void **voutfd)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 struct sockaddr_in address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 SOCKET s;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 int port;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 int retval;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1333 int errnum;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 CHECK_STRING (host);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 if (!EQ (protocol, Qtcp))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1338 invalid_constant ("Unsupported protocol", protocol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 if (INTP (service))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 port = htons ((unsigned short) XINT (service));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 struct servent *svc_info;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1345 Extbyte *servext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1346
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 CHECK_STRING (service);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1348 LISP_STRING_TO_EXTERNAL (service, servext,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1349 Qmswindows_service_name_encoding);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1350
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1351 svc_info = getservbyname (servext, "tcp");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 if (svc_info == 0)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1353 invalid_argument ("Unknown service", service);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 port = svc_info->s_port;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1357 retval = get_internet_address (host, &address);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1358 if (retval)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1359 mswindows_report_winsock_error ("Getting IP address", host,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1360 retval);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 address.sin_port = port;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 s = socket (address.sin_family, SOCK_STREAM, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 if (s < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1365 mswindows_report_winsock_error ("Creating socket", name,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1366 WSAGetLastError ());
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 /* We don't want to be blocked on connect */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 unsigned long nonblock = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 ioctlsocket (s, FIONBIO, &nonblock);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 }
854
1d8fb2eee1bb [xemacs-hg @ 2002-05-28 16:06:58 by didierv]
didierv
parents: 853
diff changeset
1373
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 retval = connect (s, (struct sockaddr *) &address, sizeof (address));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 if (retval != NO_ERROR && WSAGetLastError() != WSAEWOULDBLOCK)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1376 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1377 errnum = WSAGetLastError ();
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1378 goto connect_failed;
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
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1381 #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
1382 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
1383 it was my own fault down below. Both versions should work. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 /* Wait while connection is established */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1385 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1386 HWND hwnd;
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 /* 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
1389 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
1390 NULL, NULL, NULL, NULL);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1391 assert (hwnd);
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 /* Post request */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1394 if (WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, FD_CONNECT))
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1395 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1396 errnum = WSAGetLastError ();
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1397 goto done;
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
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1400 /* 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
1401 SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1402
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1403 while (1)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1404 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1405 MSG msg;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1406 GetMessage (&msg, hwnd, 0, 0);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1407 if (msg.message == XM_SOCKREPLY)
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 /* Ok, got an answer */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1410 errnum = WSAGETASYNCERROR (msg.lParam);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1411 goto done;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1412 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1413
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1414 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
1415 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1416 if (QUITP)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1417 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1418 WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, 0);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1419 KillTimer (hwnd, SOCK_TIMER_ID);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1420 DestroyWindow (hwnd);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1421 QUIT;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1422 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1423 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1424 DispatchMessage (&msg);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1425 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1426
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1427 done:
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1428 WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, 0);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1429 KillTimer (hwnd, SOCK_TIMER_ID);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1430 DestroyWindow (hwnd);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1431 if (errnum)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1432 goto connect_failed;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1433 }
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 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1438 fd_set fdwriteset, fdexceptset;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 struct timeval tv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 int nsel;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 if (QUITP)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 closesocket (s);
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 851
diff changeset
1445 QUIT;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 /* Poll for quit every 250 ms */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 tv.tv_sec = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 tv.tv_usec = 250 * 1000;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1452 FD_ZERO (&fdwriteset);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1453 FD_SET (s, &fdwriteset);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1454 FD_ZERO (&fdexceptset);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1455 FD_SET (s, &fdexceptset);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1456 nsel = select (0, NULL, &fdwriteset, &fdexceptset, &tv);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1457
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1458 if (nsel == SOCKET_ERROR)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1459 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1460 errnum = WSAGetLastError ();
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1461 goto connect_failed;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1462 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 if (nsel > 0)
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 /* Check: was connection successful or not? */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1467 if (FD_ISSET (s, &fdwriteset))
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1468 break;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1469 else if (FD_ISSET (s, &fdexceptset))
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1470 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1471 int store_me_harder = sizeof (errnum);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1472 /* 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
1473 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
1474 indicate probable logic failure. */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1475 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
1476 &store_me_harder))
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1477 errnum = WSAGetLastError ();
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1478 goto connect_failed;
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 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1481 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1482 signal_error (Qinternal_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1483 "Porra, esse caralho de um sistema de operacao",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1484 Qunbound);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1485 break;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1486 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 }
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1489 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 /* We are connected at this point */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1492 *vinfd = (void *)s;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 DuplicateHandle (GetCurrentProcess(), (HANDLE)s,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 GetCurrentProcess(), (LPHANDLE)voutfd,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 0, FALSE, DUPLICATE_SAME_ACCESS);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1498 connect_failed:
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1499 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1500 closesocket (s);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1501 mswindows_report_winsock_error ("Connection failed",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1502 list3 (Qunbound, host, service),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1503 errnum);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1504 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 #endif
771
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
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1510 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
1511 Set the priority of PROCESS to PRIORITY.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1512 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
1513 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
1514 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
1515 any other symbol will be interpreted as normal.
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 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
1518 */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1519 (process, priority))
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 HANDLE proc_handle = GetCurrentProcess ();
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1522 DWORD priority_class = NORMAL_PRIORITY_CLASS;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1523 Lisp_Object result = Qnil;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1524
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1525 CHECK_SYMBOL (priority);
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 if (!NILP (process))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1528 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1529 DWORD pid;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1530 struct Lisp_Process *p = 0;
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 (PROCESSP (process))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1533 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1534 CHECK_LIVE_PROCESS (process);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1535 p = XPROCESS (process);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1536 pid = NT_DATA (p)->dwProcessId;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1537 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1538 else
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1539 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1540 CHECK_INT (process);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1541
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1542 /* 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
1543 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
1544 negative. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1545
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1546 pid = XINT (process);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1547 p = find_process_from_pid (pid);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1548 if (p != NULL)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1549 pid = NT_DATA (p)->dwProcessId;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1550 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1551
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1552 /* #### 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
1553 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
1554 proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1555 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1556
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1557 if (EQ (priority, Qhigh))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1558 priority_class = HIGH_PRIORITY_CLASS;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1559 else if (EQ (priority, Qlow))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1560 priority_class = IDLE_PRIORITY_CLASS;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1561
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1562 if (proc_handle != NULL)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1563 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1564 if (SetPriorityClass (proc_handle, priority_class))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1565 result = Qt;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1566 if (!NILP (process))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1567 CloseHandle (proc_handle);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1568 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1569
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1570 return result;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1571 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1572
428
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 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 /* Initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 process_type_create_nt (void)
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 PROCESS_HAS_METHOD (nt, alloc_process_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 PROCESS_HAS_METHOD (nt, finalize_process_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 PROCESS_HAS_METHOD (nt, init_process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 PROCESS_HAS_METHOD (nt, create_process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 PROCESS_HAS_METHOD (nt, update_status_if_terminated);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 PROCESS_HAS_METHOD (nt, send_process);
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
1587 PROCESS_HAS_METHOD (nt, deactivate_process);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 PROCESS_HAS_METHOD (nt, kill_child_process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 PROCESS_HAS_METHOD (nt, kill_process_by_pid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 #ifdef HAVE_SOCKETS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 PROCESS_HAS_METHOD (nt, canonicalize_host_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 PROCESS_HAS_METHOD (nt, open_network_stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 #ifdef HAVE_MULTICAST
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 #error I won't do this until '95 has winsock2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 PROCESS_HAS_METHOD (nt, open_multicast_group);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 syms_of_process_nt (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1603 DEFSUBR (Fmswindows_set_process_priority);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1604 DEFSYMBOL (Qmswindows_construct_process_command_line);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 vars_of_process_nt (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1610 DEFVAR_LISP ("mswindows-start-process-share-console",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1611 &Vmswindows_start_process_share_console /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1612 When nil, new child processes are given a new console.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1613 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
1614 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
1615 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1616 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
1617 otherwise respond to interrupts from Emacs.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1618 */ );
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1619 Vmswindows_start_process_share_console = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1620
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1621 DEFVAR_LISP ("mswindows-start-process-inherit-error-mode",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1622 &Vmswindows_start_process_inherit_error_mode /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1623 "When nil, new child processes revert to the default error mode.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1624 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
1625 them blocking when trying to access unmounted drives etc.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1626 */ );
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1627 Vmswindows_start_process_inherit_error_mode = Qt;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 }