Mercurial > hg > xemacs-beta
annotate src/process.c @ 5724:ede80ef92a74
Make soft links in src for module source files, if built in to the executable.
This ensures that those files are built with the same compiler flags as all
other source files.
See these xemacs-beta messages:
<CAHCOHQn+q=Xuwq+y68dvqi7afAP9f-TdB7=8YiZ8VYO816sjHg@mail.gmail.com>
<f5by5ejqiyk.fsf@calexico.inf.ed.ac.uk>
author | Jerry James <james@xemacs.org> |
---|---|
date | Sat, 02 Mar 2013 14:32:37 -0700 |
parents | 2dbefd79b3d3 |
children | 3192994c49ca |
rev | line source |
---|---|
428 | 1 /* Asynchronous subprocess control for XEmacs. |
2 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995 | |
3 Free Software Foundation, Inc. | |
4 Copyright (C) 1995 Sun Microsystems, Inc. | |
5125 | 5 Copyright (C) 1995, 1996, 2001, 2002, 2004, 2005, 2010 Ben Wing. |
428 | 6 |
7 This file is part of XEmacs. | |
8 | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5255
diff
changeset
|
9 XEmacs is free software: you can redistribute it and/or modify it |
428 | 10 under the terms of the GNU General Public License as published by the |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5255
diff
changeset
|
11 Free Software Foundation, either version 3 of the License, or (at your |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5255
diff
changeset
|
12 option) any later version. |
428 | 13 |
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
17 for more details. | |
18 | |
19 You should have received a copy of the GNU General Public License | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5255
diff
changeset
|
20 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
428 | 21 |
814 | 22 /* This file has been Mule-ized. */ |
428 | 23 |
24 /* This file has been split into process.c and process-unix.c by | |
25 Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not | |
814 | 26 the original author(s). |
27 | |
28 Non-synch-subprocess stuff (mostly process environment) moved from | |
853 | 29 callproc.c, 4-3-02, Ben Wing. |
30 | |
31 callproc.c deleted entirely 5-23-02, Ben Wing. Good riddance! | |
32 */ | |
428 | 33 |
34 #include <config.h> | |
35 | |
36 #include "lisp.h" | |
37 | |
38 #include "buffer.h" | |
39 #include "commands.h" | |
800 | 40 #include "device.h" |
428 | 41 #include "events.h" |
800 | 42 #include "file-coding.h" |
428 | 43 #include "frame.h" |
44 #include "hash.h" | |
45 #include "insdel.h" | |
46 #include "lstream.h" | |
47 #include "opaque.h" | |
48 #include "process.h" | |
49 #include "procimpl.h" | |
816 | 50 #include "sysdep.h" |
428 | 51 #include "window.h" |
52 | |
53 #include "sysfile.h" | |
54 #include "sysproc.h" | |
859 | 55 #include "syssignal.h" |
428 | 56 #include "systime.h" |
57 #include "systty.h" | |
58 #include "syswait.h" | |
59 | |
2367 | 60 #ifdef WIN32_NATIVE |
61 #include "syswindows.h" | |
62 #endif | |
63 | |
863 | 64 Lisp_Object Qprocessp, Qprocess_live_p, Qprocess_readable_p; |
428 | 65 |
66 /* Process methods */ | |
67 struct process_methods the_process_methods; | |
68 | |
69 /* a process object is a network connection when its pid field a cons | |
70 (name of name of port we are connected to . foreign host name) */ | |
71 | |
72 /* Valid values of process->status_symbol */ | |
73 Lisp_Object Qrun, Qstop; | |
74 /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */ | |
75 Lisp_Object Qopen, Qclosed; | |
76 /* Protocol families */ | |
77 Lisp_Object Qtcp, Qudp; | |
78 | |
79 #ifdef HAVE_MULTICAST | |
80 Lisp_Object Qmulticast; /* Will be used for occasional warnings */ | |
81 #endif | |
82 | |
83 /* t means use pty, nil means use a pipe, | |
84 maybe other values to come. */ | |
85 Lisp_Object Vprocess_connection_type; | |
86 | |
87 /* Read comments to DEFVAR of this */ | |
88 int windowed_process_io; | |
89 | |
90 #ifdef PROCESS_IO_BLOCKING | |
91 /* List of port numbers or port names to set a blocking I/O mode. | |
92 Nil means set a non-blocking I/O mode [default]. */ | |
93 Lisp_Object network_stream_blocking_port_list; | |
94 #endif /* PROCESS_IO_BLOCKING */ | |
95 | |
96 /* Number of events of change of status of a process. */ | |
97 volatile int process_tick; | |
98 | |
99 /* Number of events for which the user or sentinel has been notified. */ | |
100 static int update_tick; | |
101 | |
102 /* Nonzero means delete a process right away if it exits. */ | |
103 int delete_exited_processes; | |
104 | |
853 | 105 /* Hash table which maps USIDs as returned by create_io_streams_cb to |
428 | 106 process objects. Processes are not GC-protected through this! */ |
107 struct hash_table *usid_to_process; | |
108 | |
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
109 /* Read-only to Lisp. See DEFUN Fprocess_list. */ |
428 | 110 Lisp_Object Vprocess_list; |
111 | |
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
112 /* Lisp variables; see docstrings below. */ |
442 | 113 Lisp_Object Vnull_device; |
771 | 114 Lisp_Object Vdefault_process_coding_system; |
853 | 115 Lisp_Object Vdefault_network_coding_system; |
563 | 116 Lisp_Object Qprocess_error; |
117 Lisp_Object Qnetwork_error; | |
771 | 118 Fixnum debug_process_io; |
814 | 119 Lisp_Object Vshell_file_name; |
120 Lisp_Object Vprocess_environment; | |
121 | |
122 /* Make sure egetenv() not called too soon */ | |
123 int env_initted; | |
124 | |
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
125 /* Internal Lisp variable. */ |
814 | 126 Lisp_Object Vlisp_EXEC_SUFFIXES; |
127 | |
428 | 128 |
129 | |
1204 | 130 static const struct memory_description process_description [] = { |
131 #define MARKED_SLOT(x) { XD_LISP_OBJECT, offsetof (Lisp_Process, x) }, | |
132 #include "process-slots.h" | |
934 | 133 { XD_END } |
134 }; | |
135 | |
428 | 136 static Lisp_Object |
444 | 137 mark_process (Lisp_Object object) |
428 | 138 { |
444 | 139 Lisp_Process *process = XPROCESS (object); |
1204 | 140 #define MARKED_SLOT(x) mark_object (process->x); |
141 #include "process-slots.h" | |
142 return Qnil; | |
428 | 143 } |
144 | |
145 static void | |
4846 | 146 print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
428 | 147 { |
4846 | 148 Lisp_Process *process = XPROCESS (obj); |
428 | 149 |
150 if (print_readably) | |
5142
f965e31a35f0
reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
151 printing_unreadable_lisp_object (obj, XSTRING_DATA (process->name)); |
428 | 152 |
153 if (!escapeflag) | |
154 { | |
444 | 155 print_internal (process->name, printcharfun, 0); |
428 | 156 } |
157 else | |
158 { | |
4846 | 159 int netp = network_connection_p (obj); |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
160 write_ascstring (printcharfun, |
826 | 161 netp ? GETTEXT ("#<network connection ") : |
162 GETTEXT ("#<process ")); | |
444 | 163 print_internal (process->name, printcharfun, 1); |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
164 write_ascstring (printcharfun, (netp ? " " : " pid ")); |
444 | 165 print_internal (process->pid, printcharfun, 1); |
800 | 166 write_fmt_string_lisp (printcharfun, " state:%S", 1, process->status_symbol); |
444 | 167 MAYBE_PROCMETH (print_process_data, (process, printcharfun)); |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
168 write_ascstring (printcharfun, ">"); |
428 | 169 } |
170 } | |
5255
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
171 /* Process plists are directly accessible, so we need to protect against |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
172 invalid property list structure */ |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
173 |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
174 static Lisp_Object |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
175 process_getprop (Lisp_Object process, Lisp_Object property) |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
176 { |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
177 return external_plist_get (&XPROCESS (process)->plist, property, 0, |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
178 ERROR_ME); |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
179 } |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
180 |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
181 static int |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
182 process_putprop (Lisp_Object process, Lisp_Object property, Lisp_Object value) |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
183 { |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
184 external_plist_put (&XPROCESS (process)->plist, property, value, 0, |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
185 ERROR_ME); |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
186 return 1; |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
187 } |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
188 |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
189 static int |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
190 process_remprop (Lisp_Object process, Lisp_Object property) |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
191 { |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
192 return external_remprop (&XPROCESS (process)->plist, property, 0, ERROR_ME); |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
193 } |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
194 |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
195 static Lisp_Object |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
196 process_plist (Lisp_Object process) |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
197 { |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
198 return XPROCESS (process)->plist; |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
199 } |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
200 |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
201 static Lisp_Object |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
202 process_setplist (Lisp_Object process, Lisp_Object newplist) |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
203 { |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
204 XPROCESS (process)->plist = newplist; |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
205 return newplist; |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
206 } |
428 | 207 |
208 #ifdef HAVE_WINDOW_SYSTEM | |
440 | 209 extern void debug_process_finalization (Lisp_Process *p); |
428 | 210 #endif /* HAVE_WINDOW_SYSTEM */ |
211 | |
212 static void | |
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
213 finalize_process (Lisp_Object obj) |
428 | 214 { |
215 /* #### this probably needs to be tied into the tty event loop */ | |
216 /* #### when there is one */ | |
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
217 Lisp_Process *p = XPROCESS (obj); |
428 | 218 #ifdef HAVE_WINDOW_SYSTEM |
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
219 debug_process_finalization (p); |
428 | 220 #endif /* HAVE_WINDOW_SYSTEM */ |
221 | |
222 if (p->process_data) | |
223 { | |
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
224 MAYBE_PROCMETH (finalize_process_data, (p)); |
5125 | 225 xfree (p->process_data); |
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
226 p->process_data = 0; |
428 | 227 } |
228 } | |
229 | |
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
230 DEFINE_NODUMP_LISP_OBJECT ("process", process, |
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
231 mark_process, print_process, finalize_process, |
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
232 0, 0, process_description, Lisp_Process); |
428 | 233 |
234 /************************************************************************/ | |
235 /* basic process accessors */ | |
236 /************************************************************************/ | |
237 | |
771 | 238 /* This function returns low-level streams, connected directly to the child |
239 process, rather than en/decoding streams */ | |
428 | 240 void |
853 | 241 get_process_streams (Lisp_Process *p, Lisp_Object *instr, Lisp_Object *outstr, |
242 Lisp_Object *errstr) | |
428 | 243 { |
244 assert (p); | |
853 | 245 assert (NILP (p->pipe_instream) || LSTREAMP (p->pipe_instream)); |
246 assert (NILP (p->pipe_outstream) || LSTREAMP (p->pipe_outstream)); | |
247 assert (NILP (p->pipe_errstream) || LSTREAMP (p->pipe_errstream)); | |
428 | 248 *instr = p->pipe_instream; |
249 *outstr = p->pipe_outstream; | |
853 | 250 *errstr = p->pipe_errstream; |
428 | 251 } |
252 | |
853 | 253 /* Given a USID referring to either a process's instream or errstream, |
254 return the associated process. */ | |
440 | 255 Lisp_Process * |
428 | 256 get_process_from_usid (USID usid) |
257 { | |
442 | 258 const void *vval; |
428 | 259 |
260 assert (usid != USID_ERROR && usid != USID_DONTHASH); | |
261 | |
442 | 262 if (gethash ((const void*)usid, usid_to_process, &vval)) |
428 | 263 { |
444 | 264 Lisp_Object process; |
5013 | 265 process = GET_LISP_FROM_VOID (vval); |
444 | 266 return XPROCESS (process); |
428 | 267 } |
268 else | |
269 return 0; | |
270 } | |
271 | |
272 int | |
853 | 273 get_process_selected_p (Lisp_Process *p, int do_err) |
428 | 274 { |
853 | 275 return do_err ? p->err_selected : p->in_selected; |
428 | 276 } |
277 | |
278 void | |
853 | 279 set_process_selected_p (Lisp_Process *p, int in_selected, int err_selected) |
428 | 280 { |
853 | 281 p->in_selected = !!in_selected; |
282 p->err_selected = !!err_selected; | |
428 | 283 } |
284 | |
285 int | |
440 | 286 connected_via_filedesc_p (Lisp_Process *p) |
428 | 287 { |
288 return MAYBE_INT_PROCMETH (tooltalk_connection_p, (p)); | |
289 } | |
290 | |
291 #ifdef HAVE_SOCKETS | |
292 int | |
293 network_connection_p (Lisp_Object process) | |
294 { | |
295 return CONSP (XPROCESS (process)->pid); | |
296 } | |
297 #endif | |
298 | |
299 DEFUN ("processp", Fprocessp, 1, 1, 0, /* | |
300 Return t if OBJECT is a process. | |
301 */ | |
444 | 302 (object)) |
428 | 303 { |
444 | 304 return PROCESSP (object) ? Qt : Qnil; |
428 | 305 } |
306 | |
440 | 307 DEFUN ("process-live-p", Fprocess_live_p, 1, 1, 0, /* |
308 Return t if OBJECT is a process that is alive. | |
309 */ | |
444 | 310 (object)) |
440 | 311 { |
444 | 312 return PROCESSP (object) && PROCESS_LIVE_P (XPROCESS (object)) |
313 ? Qt : Qnil; | |
440 | 314 } |
315 | |
863 | 316 #if 0 |
317 /* This is a reasonable definition for this new primitive. Kyle sez: | |
318 | |
319 "The patch looks OK to me except for the creation and exporting of the | |
320 Fprocess_readable_p function. I don't think a new Lisp function | |
321 should be created until we know something actually needs it. If | |
322 we later want to give process-readable-p different semantics it | |
323 may be hard to do it and stay compatible with what we hastily | |
324 create today." | |
325 | |
326 He's right, not yet. Let's discuss the semantics on XEmacs Design | |
327 before enabling this. | |
328 */ | |
329 DEFUN ("process-readable-p", Fprocess_readable_p, 1, 1, 0, /* | |
330 Return t if OBJECT is a process from which input may be available. | |
331 */ | |
332 (object)) | |
333 { | |
334 return PROCESSP (object) && PROCESS_READABLE_P (XPROCESS (object)) | |
335 ? Qt : Qnil; | |
336 } | |
337 #endif | |
338 | |
428 | 339 DEFUN ("process-list", Fprocess_list, 0, 0, 0, /* |
340 Return a list of all processes. | |
341 */ | |
342 ()) | |
343 { | |
344 return Fcopy_sequence (Vprocess_list); | |
345 } | |
346 | |
347 DEFUN ("get-process", Fget_process, 1, 1, 0, /* | |
444 | 348 Return the process named PROCESS-NAME (a string), or nil if there is none. |
349 PROCESS-NAME may also be a process; if so, the value is that process. | |
428 | 350 */ |
444 | 351 (process_name)) |
428 | 352 { |
444 | 353 if (PROCESSP (process_name)) |
354 return process_name; | |
428 | 355 |
356 if (!gc_in_progress) | |
357 /* this only gets called during GC when emacs is going away as a result | |
358 of a signal or crash. */ | |
444 | 359 CHECK_STRING (process_name); |
428 | 360 |
444 | 361 { |
362 LIST_LOOP_2 (process, Vprocess_list) | |
363 if (internal_equal (process_name, XPROCESS (process)->name, 0)) | |
364 return process; | |
365 } | |
428 | 366 return Qnil; |
367 } | |
368 | |
369 DEFUN ("get-buffer-process", Fget_buffer_process, 1, 1, 0, /* | |
370 Return the (or, a) process associated with BUFFER. | |
371 BUFFER may be a buffer or the name of one. | |
372 */ | |
444 | 373 (buffer)) |
428 | 374 { |
444 | 375 if (NILP (buffer)) return Qnil; |
376 buffer = Fget_buffer (buffer); | |
377 if (NILP (buffer)) return Qnil; | |
428 | 378 |
444 | 379 { |
380 LIST_LOOP_2 (process, Vprocess_list) | |
381 if (EQ (XPROCESS (process)->buffer, buffer)) | |
382 return process; | |
383 } | |
428 | 384 return Qnil; |
385 } | |
386 | |
387 /* This is how commands for the user decode process arguments. It | |
388 accepts a process, a process name, a buffer, a buffer name, or nil. | |
389 Buffers denote the first process in the buffer, and nil denotes the | |
390 current buffer. */ | |
391 | |
392 static Lisp_Object | |
393 get_process (Lisp_Object name) | |
394 { | |
444 | 395 Lisp_Object buffer; |
428 | 396 |
397 #ifdef I18N3 | |
398 /* #### Look more closely into translating process names. */ | |
399 #endif | |
400 | |
401 /* This may be called during a GC from process_send_signal() from | |
2500 | 402 kill_buffer_processes() if emacs decides to ABORT(). */ |
428 | 403 if (PROCESSP (name)) |
404 return name; | |
444 | 405 else if (STRINGP (name)) |
428 | 406 { |
444 | 407 Lisp_Object object = Fget_process (name); |
408 if (PROCESSP (object)) | |
409 return object; | |
410 | |
411 buffer = Fget_buffer (name); | |
412 if (BUFFERP (buffer)) | |
413 goto have_buffer_object; | |
414 | |
563 | 415 invalid_argument ("Process does not exist", name); |
428 | 416 } |
417 else if (NILP (name)) | |
444 | 418 { |
419 buffer = Fcurrent_buffer (); | |
420 goto have_buffer_object; | |
421 } | |
422 else if (BUFFERP (name)) | |
423 { | |
424 Lisp_Object process; | |
425 buffer = name; | |
428 | 426 |
444 | 427 have_buffer_object: |
428 process = Fget_buffer_process (buffer); | |
429 if (PROCESSP (process)) | |
430 return process; | |
431 | |
563 | 432 invalid_argument ("Buffer has no process", buffer); |
428 | 433 } |
434 else | |
444 | 435 return get_process (Fsignal (Qwrong_type_argument, |
771 | 436 (list2 (build_msg_string ("process or buffer or nil"), |
444 | 437 name)))); |
428 | 438 } |
439 | |
440 DEFUN ("process-id", Fprocess_id, 1, 1, 0, /* | |
441 Return the process id of PROCESS. | |
442 This is the pid of the Unix process which PROCESS uses or talks to. | |
443 For a network connection, this value is a cons of | |
444 (foreign-network-port . foreign-host-name). | |
445 */ | |
444 | 446 (process)) |
428 | 447 { |
448 Lisp_Object pid; | |
444 | 449 CHECK_PROCESS (process); |
428 | 450 |
444 | 451 pid = XPROCESS (process)->pid; |
452 if (network_connection_p (process)) | |
428 | 453 /* return Qnil; */ |
454 return Fcons (Fcar (pid), Fcdr (pid)); | |
455 else | |
456 return pid; | |
457 } | |
458 | |
459 DEFUN ("process-name", Fprocess_name, 1, 1, 0, /* | |
460 Return the name of PROCESS, as a string. | |
461 This is the name of the program invoked in PROCESS, | |
462 possibly modified to make it unique among process names. | |
463 */ | |
444 | 464 (process)) |
428 | 465 { |
444 | 466 CHECK_PROCESS (process); |
467 return XPROCESS (process)->name; | |
428 | 468 } |
469 | |
470 DEFUN ("process-command", Fprocess_command, 1, 1, 0, /* | |
471 Return the command that was executed to start PROCESS. | |
472 This is a list of strings, the first string being the program executed | |
473 and the rest of the strings being the arguments given to it. | |
474 */ | |
444 | 475 (process)) |
428 | 476 { |
444 | 477 CHECK_PROCESS (process); |
478 return XPROCESS (process)->command; | |
428 | 479 } |
480 | |
481 | |
482 /************************************************************************/ | |
483 /* creating a process */ | |
484 /************************************************************************/ | |
485 | |
563 | 486 DOESNT_RETURN |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
487 report_process_error (const Ascbyte *reason, Lisp_Object data) |
563 | 488 { |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
489 report_error_with_errno (Qprocess_error, reason, data); |
563 | 490 } |
491 | |
492 DOESNT_RETURN | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
493 report_network_error (const Ascbyte *reason, Lisp_Object data) |
563 | 494 { |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
495 report_error_with_errno (Qnetwork_error, reason, data); |
563 | 496 } |
497 | |
428 | 498 Lisp_Object |
499 make_process_internal (Lisp_Object name) | |
500 { | |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
501 Lisp_Object name1; |
428 | 502 int i; |
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
503 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (process); |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
504 Lisp_Process *p = XPROCESS (obj); |
428 | 505 |
1204 | 506 #define MARKED_SLOT(x) p->x = Qnil; |
507 #include "process-slots.h" | |
508 | |
428 | 509 /* If name is already in use, modify it until it is unused. */ |
510 name1 = name; | |
511 for (i = 1; ; i++) | |
512 { | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
513 Ascbyte suffix[10]; |
428 | 514 Lisp_Object tem = Fget_process (name1); |
515 if (NILP (tem)) | |
516 break; | |
517 sprintf (suffix, "<%d>", i); | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
518 name1 = concat2 (name, build_ascstring (suffix)); |
428 | 519 } |
520 name = name1; | |
521 p->name = name; | |
522 | |
523 p->mark = Fmake_marker (); | |
853 | 524 p->stderr_mark = Fmake_marker (); |
428 | 525 p->status_symbol = Qrun; |
526 | |
527 MAYBE_PROCMETH (alloc_process_data, (p)); | |
528 | |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
529 Vprocess_list = Fcons (obj, Vprocess_list); |
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
530 return obj; |
428 | 531 } |
532 | |
533 void | |
853 | 534 init_process_io_handles (Lisp_Process *p, void* in, void* out, void* err, |
535 int flags) | |
428 | 536 { |
853 | 537 USID in_usid, err_usid; |
771 | 538 Lisp_Object incode, outcode; |
539 | |
853 | 540 if (flags & STREAM_NETWORK_CONNECTION) |
541 { | |
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
542 if (!LISTP (Vdefault_network_coding_system) || |
853 | 543 NILP (incode = (find_coding_system_for_text_file |
544 (Fcar (Vdefault_network_coding_system), 1))) || | |
545 NILP (outcode = (find_coding_system_for_text_file | |
546 (Fcdr (Vdefault_network_coding_system), 0)))) | |
547 signal_error (Qinvalid_state, | |
548 "Bogus value for `default-network-coding-system'", | |
549 Vdefault_network_coding_system); | |
550 } | |
551 else | |
552 { | |
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
553 if (!LISTP (Vdefault_process_coding_system) || |
853 | 554 NILP (incode = (find_coding_system_for_text_file |
555 (Fcar (Vdefault_process_coding_system), 1))) || | |
556 NILP (outcode = (find_coding_system_for_text_file | |
557 (Fcdr (Vdefault_process_coding_system), 0)))) | |
558 signal_error (Qinvalid_state, | |
559 "Bogus value for `default-process-coding-system'", | |
560 Vdefault_process_coding_system); | |
561 } | |
771 | 562 |
784 | 563 if (!NILP (Vcoding_system_for_read) && |
564 NILP (incode = (find_coding_system_for_text_file | |
565 (Vcoding_system_for_read, 1)))) | |
566 signal_error (Qinvalid_state, | |
567 "Bogus value for `coding-system-for-read'", | |
568 Vcoding_system_for_read); | |
569 | |
570 if (!NILP (Vcoding_system_for_write) && | |
571 NILP (outcode = (find_coding_system_for_text_file | |
572 (Vcoding_system_for_write, 0)))) | |
573 signal_error (Qinvalid_state, | |
574 "Bogus value for `coding-system-for-write'", | |
575 Vcoding_system_for_write); | |
576 | |
853 | 577 event_stream_create_io_streams (in, out, err, |
578 &p->pipe_instream, | |
579 &p->pipe_outstream, | |
580 &p->pipe_errstream, | |
581 &in_usid, &err_usid, | |
582 flags); | |
428 | 583 |
853 | 584 if (in_usid == USID_ERROR || err_usid == USID_ERROR) |
563 | 585 signal_error (Qprocess_error, "Setting up communication with subprocess", |
853 | 586 wrap_process (p)); |
428 | 587 |
853 | 588 if (in_usid != USID_DONTHASH) |
428 | 589 { |
444 | 590 Lisp_Object process = Qnil; |
793 | 591 process = wrap_process (p); |
5013 | 592 puthash ((const void*) in_usid, STORE_LISP_IN_VOID (process), usid_to_process); |
428 | 593 } |
594 | |
853 | 595 if (err_usid != USID_DONTHASH) |
596 { | |
597 Lisp_Object process = Qnil; | |
598 process = wrap_process (p); | |
5013 | 599 puthash ((const void*) err_usid, STORE_LISP_IN_VOID (process), |
853 | 600 usid_to_process); |
601 } | |
602 | |
603 MAYBE_PROCMETH (init_process_io_handles, (p, in, out, err, flags)); | |
428 | 604 |
771 | 605 p->coding_instream = |
800 | 606 make_coding_input_stream (XLSTREAM (p->pipe_instream), incode, |
607 CODING_DECODE, 0); | |
853 | 608 if (!NILP (p->pipe_errstream)) |
609 p->coding_errstream = | |
610 make_coding_input_stream | |
611 (XLSTREAM (p->pipe_errstream), incode, CODING_DECODE, 0); | |
771 | 612 p->coding_outstream = |
800 | 613 make_coding_output_stream (XLSTREAM (p->pipe_outstream), outcode, |
614 CODING_ENCODE, 0); | |
428 | 615 } |
616 | |
617 static void | |
618 create_process (Lisp_Object process, Lisp_Object *argv, int nargv, | |
853 | 619 Lisp_Object program, Lisp_Object cur_dir, |
620 int separate_err) | |
428 | 621 { |
440 | 622 Lisp_Process *p = XPROCESS (process); |
428 | 623 int pid; |
624 | |
625 /* *_create_process may change status_symbol, if the process | |
626 is a kind of "fire-and-forget" (no I/O, unwaitable) */ | |
627 p->status_symbol = Qrun; | |
628 p->exit_code = 0; | |
629 | |
853 | 630 pid = PROCMETH (create_process, (p, argv, nargv, program, cur_dir, |
631 separate_err)); | |
428 | 632 |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
633 p->pid = make_fixnum (pid); |
863 | 634 if (PROCESS_READABLE_P (p)) |
853 | 635 event_stream_select_process (p, 1, 1); |
428 | 636 } |
637 | |
638 /* This function is the unwind_protect form for Fstart_process_internal. If | |
444 | 639 PROCESS doesn't have its pid set, then we know someone has signalled |
428 | 640 an error and the process wasn't started successfully, so we should |
641 remove it from the process list. */ | |
444 | 642 static void remove_process (Lisp_Object process); |
428 | 643 static Lisp_Object |
444 | 644 start_process_unwind (Lisp_Object process) |
428 | 645 { |
444 | 646 /* Was PROCESS started successfully? */ |
647 if (EQ (XPROCESS (process)->pid, Qnil)) | |
648 remove_process (process); | |
428 | 649 return Qnil; |
650 } | |
651 | |
652 DEFUN ("start-process-internal", Fstart_process_internal, 3, MANY, 0, /* | |
853 | 653 Internal function to start a program in a subprocess. |
654 Lisp callers should use `start-process' instead. | |
655 | |
656 Returns the process object for it. | |
428 | 657 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS |
658 NAME is name for process. It is modified if necessary to make it unique. | |
659 BUFFER is the buffer or (buffer-name) to associate with the process. | |
660 Process output goes at end of that buffer, unless you specify | |
661 an output stream or filter function to handle the output. | |
662 BUFFER may be also nil, meaning that this process is not associated | |
853 | 663 with any buffer. |
664 BUFFER can also have the form (REAL-BUFFER STDERR-BUFFER); in that case, | |
665 REAL-BUFFER says what to do with standard output, as above, | |
666 while STDERR-BUFFER says what to do with standard error in the child. | |
667 STDERR-BUFFER may be nil (discard standard error output, unless a stderr | |
668 filter is set). Note that if you do not use this form at process creation, | |
669 stdout and stderr will be mixed in the output buffer, and this cannot be | |
670 changed, even by setting a stderr filter. | |
428 | 671 Third arg is program file name. It is searched for as in the shell. |
672 Remaining arguments are strings to give program as arguments. | |
853 | 673 |
674 Read and write coding systems for the process are determined from | |
675 `coding-system-for-read' and `coding-system-for-write' (intended as | |
676 overriding coding systems to be *bound* by Lisp code, not set), or | |
677 from `default-process-coding-system' if either or both are nil. You can | |
678 change the coding systems later on using `set-process-coding-system', | |
679 `set-process-input-coding-system', or `set-process-output-coding-system'. | |
680 | |
681 See also `set-process-filter' and `set-process-stderr-filter'. | |
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3025
diff
changeset
|
682 |
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3025
diff
changeset
|
683 arguments: (NAME BUFFER PROGRAM &rest PROGRAM-ARGS) |
428 | 684 */ |
685 (int nargs, Lisp_Object *args)) | |
686 { | |
687 /* This function can call lisp */ | |
853 | 688 Lisp_Object buffer, stderr_buffer, name, program, process, current_dir; |
689 int separate_stderr; | |
428 | 690 Lisp_Object tem; |
910 | 691 int i; |
428 | 692 int speccount = specpdl_depth (); |
693 struct gcpro gcpro1, gcpro2, gcpro3; | |
694 | |
695 name = args[0]; | |
696 buffer = args[1]; | |
697 program = args[2]; | |
698 current_dir = Qnil; | |
699 | |
700 /* Protect against various file handlers doing GCs below. */ | |
701 GCPRO3 (buffer, program, current_dir); | |
702 | |
853 | 703 if (CONSP (buffer)) |
704 { | |
705 if (!CONSP (XCDR (buffer))) | |
706 invalid_argument ("Invalid BUFFER argument to `start-process'", | |
707 buffer); | |
708 if (!NILP (XCDR (XCDR (buffer)))) | |
709 invalid_argument ("Invalid BUFFER argument to `start-process'", | |
710 buffer); | |
711 stderr_buffer = XCAR (XCDR (buffer)); | |
712 buffer = XCAR (buffer); | |
713 separate_stderr = 1; | |
714 } | |
715 else | |
716 { | |
717 stderr_buffer = Qnil; | |
718 separate_stderr = 0; | |
719 } | |
720 | |
428 | 721 if (!NILP (buffer)) |
722 buffer = Fget_buffer_create (buffer); | |
853 | 723 if (!NILP (stderr_buffer)) |
724 stderr_buffer = Fget_buffer_create (stderr_buffer); | |
428 | 725 |
726 CHECK_STRING (name); | |
727 CHECK_STRING (program); | |
910 | 728 for (i = 3; i < nargs; ++i) |
729 CHECK_STRING (args[i]); | |
428 | 730 |
731 /* Make sure that the child will be able to chdir to the current | |
502 | 732 buffer's current directory, or its unhandled equivalent. [[ We |
428 | 733 can't just have the child check for an error when it does the |
502 | 734 chdir, since it's in a vfork. ]] -- not any more, we don't use |
735 vfork. -ben | |
428 | 736 |
502 | 737 Note: These calls are spread out to insure that the return values |
738 of the calls (which may be newly-created strings) are properly | |
739 GC-protected. */ | |
428 | 740 current_dir = current_buffer->directory; |
502 | 741 /* If the current dir has no terminating slash, we'll get undesirable |
742 results, so put the slash back. */ | |
743 current_dir = Ffile_name_as_directory (current_dir); | |
428 | 744 current_dir = Funhandled_file_name_directory (current_dir); |
745 current_dir = expand_and_dir_to_file (current_dir, Qnil); | |
746 | |
747 #if 0 /* This loser breaks ange-ftp */ | |
748 /* dmoore - if you re-enable this code, you have to gcprotect | |
749 current_buffer through the above calls. */ | |
750 if (NILP (Ffile_accessible_directory_p (current_dir))) | |
563 | 751 signal_error (Qprocess_error, "Setting current directory", |
752 current_buffer->directory); | |
428 | 753 #endif /* 0 */ |
754 | |
755 /* If program file name is not absolute, search our path for it */ | |
826 | 756 if (!IS_DIRECTORY_SEP (string_byte (program, 0)) |
428 | 757 && !(XSTRING_LENGTH (program) > 1 |
826 | 758 && IS_DEVICE_SEP (string_byte (program, 1)))) |
428 | 759 { |
760 struct gcpro ngcpro1; | |
761 | |
762 tem = Qnil; | |
763 NGCPRO1 (tem); | |
764 locate_file (Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem, X_OK); | |
765 if (NILP (tem)) | |
563 | 766 signal_error (Qprocess_error, "Searching for program", program); |
428 | 767 program = Fexpand_file_name (tem, Qnil); |
768 NUNGCPRO; | |
769 } | |
770 else | |
771 { | |
442 | 772 /* we still need to canonicalize it and ensure it has the proper |
773 ending, e.g. .exe */ | |
774 struct gcpro ngcpro1; | |
775 | |
776 tem = Qnil; | |
777 NGCPRO1 (tem); | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
778 locate_file (list1 (build_ascstring ("")), program, Vlisp_EXEC_SUFFIXES, |
442 | 779 &tem, X_OK); |
780 if (NILP (tem)) | |
563 | 781 signal_error (Qprocess_error, "Searching for program", program); |
442 | 782 program = tem; |
783 NUNGCPRO; | |
428 | 784 } |
785 | |
442 | 786 if (!NILP (Ffile_directory_p (program))) |
787 invalid_operation ("Specified program for new process is a directory", | |
788 program); | |
789 | |
444 | 790 process = make_process_internal (name); |
428 | 791 |
444 | 792 XPROCESS (process)->buffer = buffer; |
853 | 793 XPROCESS (process)->stderr_buffer = stderr_buffer; |
794 XPROCESS (process)->separate_stderr = separate_stderr; | |
814 | 795 XPROCESS (process)->command = Flist (nargs - 2, args + 2); |
428 | 796 |
797 /* Make the process marker point into the process buffer (if any). */ | |
798 if (!NILP (buffer)) | |
444 | 799 Fset_marker (XPROCESS (process)->mark, |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
800 make_fixnum (BUF_ZV (XBUFFER (buffer))), buffer); |
853 | 801 if (!NILP (stderr_buffer)) |
802 Fset_marker (XPROCESS (process)->stderr_mark, | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
803 make_fixnum (BUF_ZV (XBUFFER (stderr_buffer))), stderr_buffer); |
428 | 804 |
805 /* If an error occurs and we can't start the process, we want to | |
806 remove it from the process list. This means that each error | |
807 check in create_process doesn't need to call remove_process | |
808 itself; it's all taken care of here. */ | |
444 | 809 record_unwind_protect (start_process_unwind, process); |
428 | 810 |
853 | 811 create_process (process, args + 3, nargs - 3, program, current_dir, |
812 separate_stderr); | |
428 | 813 |
814 UNGCPRO; | |
771 | 815 return unbind_to_1 (speccount, process); |
428 | 816 } |
817 | |
818 | |
819 #ifdef HAVE_SOCKETS | |
820 | |
821 | |
822 /* #### The network support is fairly synthetical. What we actually | |
823 need is a single function, which supports all datagram, stream and | |
824 packet stream connections, arbitrary protocol families should they | |
825 be supported by the target system, multicast groups, in both data | |
826 and control rooted/nonrooted flavors, service quality etc whatever | |
827 is supported by the underlying network. | |
828 | |
829 It must accept a property list describing the connection. The current | |
830 functions must then go to lisp and provide a suitable list for the | |
831 generalized connection function. | |
832 | |
833 Both UNIX and Win32 support BSD sockets, and there are many extensions | |
834 available (Sockets 2 spec). | |
835 | |
836 A todo is define a consistent set of properties abstracting a | |
837 network connection. -kkm | |
838 */ | |
839 | |
840 | |
841 /* open a TCP network connection to a given HOST/SERVICE. Treated | |
842 exactly like a normal process when reading and writing. Only | |
843 differences are in status display and process deletion. A network | |
844 connection has no PID; you cannot signal it. All you can do is | |
845 deactivate and close it via delete-process */ | |
846 | |
442 | 847 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, |
848 0, /* | |
428 | 849 Open a TCP connection for a service to a host. |
444 | 850 Return a process object to represent the connection. |
428 | 851 Input and output work as for subprocesses; `delete-process' closes it. |
852 | |
853 NAME is name for process. It is modified if necessary to make it unique. | |
854 BUFFER is the buffer (or buffer-name) to associate with the process. | |
855 Process output goes at end of that buffer, unless you specify | |
856 an output stream or filter function to handle the output. | |
857 BUFFER may also be nil, meaning that this process is not associated | |
858 with any buffer. | |
444 | 859 Third arg HOST (a string) is the name of the host to connect to, |
860 or its IP address. | |
861 Fourth arg SERVICE is the name of the service desired (a string), | |
862 or an integer specifying a port number to connect to. | |
3025 | 863 Optional fifth arg PROTOCOL is a network protocol. Currently only `tcp' |
864 (Transmission Control Protocol) and `udp' (User Datagram Protocol) are | |
865 supported. When omitted, `tcp' is assumed. | |
428 | 866 |
442 | 867 Output via `process-send-string' and input via buffer or filter (see |
428 | 868 `set-process-filter') are stream-oriented. That means UDP datagrams are |
869 not guaranteed to be sent and received in discrete packets. (But small | |
870 datagrams around 500 bytes that are not truncated by `process-send-string' | |
444 | 871 are usually fine.) Note further that the UDP protocol does not guard |
872 against lost packets. | |
428 | 873 */ |
874 (name, buffer, host, service, protocol)) | |
875 { | |
876 /* This function can GC */ | |
444 | 877 Lisp_Object process = Qnil; |
428 | 878 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1; |
879 void *inch, *outch; | |
880 | |
881 GCPRO5 (name, buffer, host, service, protocol); | |
882 CHECK_STRING (name); | |
883 | |
771 | 884 if (NILP (protocol)) |
428 | 885 protocol = Qtcp; |
886 else | |
887 CHECK_SYMBOL (protocol); | |
888 | |
889 /* Since this code is inside HAVE_SOCKETS, existence of | |
890 open_network_stream is mandatory */ | |
891 PROCMETH (open_network_stream, (name, host, service, protocol, | |
892 &inch, &outch)); | |
893 | |
894 if (!NILP (buffer)) | |
895 buffer = Fget_buffer_create (buffer); | |
444 | 896 process = make_process_internal (name); |
897 NGCPRO1 (process); | |
428 | 898 |
444 | 899 XPROCESS (process)->pid = Fcons (service, host); |
900 XPROCESS (process)->buffer = buffer; | |
771 | 901 init_process_io_handles (XPROCESS (process), (void *) inch, (void *) outch, |
853 | 902 (void *) -1, |
428 | 903 STREAM_NETWORK_CONNECTION); |
904 | |
853 | 905 event_stream_select_process (XPROCESS (process), 1, 1); |
428 | 906 |
1204 | 907 NUNGCPRO; |
428 | 908 UNGCPRO; |
444 | 909 return process; |
428 | 910 } |
911 | |
912 #ifdef HAVE_MULTICAST | |
913 | |
914 DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /* | |
915 Open a multicast connection on the specified dest/port/ttl. | |
444 | 916 Return a process object to represent the connection. |
428 | 917 Input and output work as for subprocesses; `delete-process' closes it. |
918 | |
919 NAME is name for process. It is modified if necessary to make it unique. | |
920 BUFFER is the buffer (or buffer-name) to associate with the process. | |
921 Process output goes at end of that buffer, unless you specify | |
922 an output stream or filter function to handle the output. | |
923 BUFFER may also be nil, meaning that this process is not associated | |
924 with any buffer. | |
925 Third, fourth and fifth args are the multicast destination group, port and ttl. | |
926 dest must be an internet address between 224.0.0.0 and 239.255.255.255 | |
927 port is a communication port like in traditional unicast | |
928 ttl is the time-to-live (15 for site, 63 for region and 127 for world) | |
929 */ | |
930 (name, buffer, dest, port, ttl)) | |
931 { | |
932 /* This function can GC */ | |
444 | 933 Lisp_Object process = Qnil; |
428 | 934 struct gcpro gcpro1; |
935 void *inch, *outch; | |
936 | |
937 CHECK_STRING (name); | |
938 | |
939 /* Since this code is inside HAVE_MULTICAST, existence of | |
771 | 940 open_multicast_group is mandatory */ |
428 | 941 PROCMETH (open_multicast_group, (name, dest, port, ttl, |
942 &inch, &outch)); | |
943 | |
944 if (!NILP (buffer)) | |
945 buffer = Fget_buffer_create (buffer); | |
946 | |
444 | 947 process = make_process_internal (name); |
948 GCPRO1 (process); | |
428 | 949 |
444 | 950 XPROCESS (process)->pid = Fcons (port, dest); |
951 XPROCESS (process)->buffer = buffer; | |
853 | 952 init_process_io_handles (XPROCESS (process), (void *) inch, (void *) outch, |
953 (void *) -1, | |
428 | 954 STREAM_NETWORK_CONNECTION); |
955 | |
853 | 956 event_stream_select_process (XPROCESS (process), 1, 1); |
428 | 957 |
958 UNGCPRO; | |
444 | 959 return process; |
428 | 960 } |
961 #endif /* HAVE_MULTICAST */ | |
962 | |
963 #endif /* HAVE_SOCKETS */ | |
964 | |
965 Lisp_Object | |
966 canonicalize_host_name (Lisp_Object host) | |
967 { | |
968 return PROCMETH_OR_GIVEN (canonicalize_host_name, (host), host); | |
969 } | |
970 | |
971 | |
972 DEFUN ("set-process-window-size", Fset_process_window_size, 3, 3, 0, /* | |
973 Tell PROCESS that it has logical window size HEIGHT and WIDTH. | |
974 */ | |
444 | 975 (process, height, width)) |
428 | 976 { |
444 | 977 CHECK_PROCESS (process); |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
978 check_integer_range (height, Qzero, make_integer (MOST_POSITIVE_FIXNUM)); |
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
979 check_integer_range (width, Qzero, make_integer (MOST_POSITIVE_FIXNUM)); |
428 | 980 return |
444 | 981 MAYBE_INT_PROCMETH (set_window_size, |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
982 (XPROCESS (process), XFIXNUM (height), XFIXNUM (width))) <= 0 |
428 | 983 ? Qnil : Qt; |
984 } | |
985 | |
986 | |
987 /************************************************************************/ | |
988 /* Process I/O */ | |
989 /************************************************************************/ | |
990 | |
844 | 991 /* Set up PROCESS's buffer for insertion of process data at PROCESS's |
992 mark. | |
993 | |
994 Sets the current buffer to PROCESS's buffer, inhibits read only, | |
995 remembers current point, sets point to PROCESS'S mark, widens if | |
996 necessary. | |
997 */ | |
998 static int | |
853 | 999 process_setup_for_insertion (Lisp_Object process, int read_stderr) |
844 | 1000 { |
1001 Lisp_Process *p = XPROCESS (process); | |
1002 int spec = specpdl_depth (); | |
853 | 1003 Lisp_Object buffer = read_stderr ? p->stderr_buffer : p->buffer; |
1004 Lisp_Object mark = read_stderr ? p->stderr_mark : p->mark; | |
1005 struct buffer *buf = XBUFFER (buffer); | |
844 | 1006 Charbpos output_pt; |
1007 | |
1008 if (buf != current_buffer) | |
1009 { | |
1010 record_unwind_protect (save_current_buffer_restore, | |
1011 Fcurrent_buffer ()); | |
1012 set_buffer_internal (buf); | |
1013 } | |
1014 | |
1015 record_unwind_protect (save_excursion_restore, save_excursion_save ()); | |
1016 specbind (Qinhibit_read_only, Qt); | |
854 | 1017 |
844 | 1018 /* Insert new output into buffer |
1019 at the current end-of-output marker, | |
1020 thus preserving logical ordering of input and output. */ | |
853 | 1021 if (XMARKER (mark)->buffer) |
1022 output_pt = marker_position (mark); | |
844 | 1023 else |
1024 output_pt = BUF_ZV (buf); | |
1025 | |
1026 /* If the output marker is outside of the visible region, save | |
1027 the restriction and widen. */ | |
1028 if (! (BUF_BEGV (buf) <= output_pt && output_pt <= BUF_ZV (buf))) | |
1029 { | |
1030 record_unwind_protect (save_restriction_restore, | |
1031 save_restriction_save (buf)); | |
1032 Fwiden (wrap_buffer (buf)); | |
1033 } | |
1034 | |
1035 BUF_SET_PT (buf, output_pt); | |
1036 return spec; | |
1037 } | |
1038 | |
428 | 1039 /* Read pending output from the process channel, |
1040 starting with our buffered-ahead character if we have one. | |
1041 Yield number of characters read. | |
1042 | |
1043 This function reads at most 1024 bytes. | |
1044 If you want to read all available subprocess output, | |
1045 you must call it repeatedly until it returns zero. */ | |
1046 | |
1047 Charcount | |
853 | 1048 read_process_output (Lisp_Object process, int read_stderr) |
428 | 1049 { |
1050 /* This function can GC */ | |
1051 Bytecount nbytes, nchars; | |
867 | 1052 Ibyte chars[1025]; |
428 | 1053 Lisp_Object outstream; |
444 | 1054 Lisp_Process *p = XPROCESS (process); |
853 | 1055 Lisp_Object filter = read_stderr ? p->stderr_filter : p->filter; |
1056 Lisp_Object buffer = read_stderr ? p->stderr_buffer : p->buffer; | |
1057 Lisp_Object mark = read_stderr ? p->stderr_mark : p->mark; | |
428 | 1058 |
1059 /* If there is a lot of output from the subprocess, the loop in | |
1060 execute_internal_event() might call read_process_output() more | |
1061 than once. If the filter that was executed from one of these | |
1062 calls set the filter to t, we have to stop now. Return -1 rather | |
1063 than 0 so execute_internal_event() doesn't close the process. | |
1064 Really, the loop in execute_internal_event() should check itself | |
1065 for a process-filter change, like in status_notify(); but the | |
1066 struct Lisp_Process is not exported outside of this file. */ | |
863 | 1067 if (!PROCESS_READABLE_P (p)) |
853 | 1068 { |
1069 errno = 0; | |
1070 return -1; /* already closed */ | |
1071 } | |
428 | 1072 |
853 | 1073 if (!NILP (filter) && (p->filter_does_read)) |
428 | 1074 { |
1075 Lisp_Object filter_result; | |
1076 | |
1077 /* Some weird FSFmacs crap here with | |
853 | 1078 Vdeactivate_mark and current_buffer->keymap. |
1079 Some FSF junk with running_asynch_code, to preserve the match | |
1080 data. Not necessary because we don't call process filters | |
1081 asynchronously (i.e. from within QUIT). */ | |
1082 /* Don't catch errors here; we're not in any critical code. */ | |
1083 filter_result = call2 (filter, process, Qnil); | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
1084 CHECK_FIXNUM (filter_result); |
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
1085 return XFIXNUM (filter_result); |
428 | 1086 } |
1087 | |
853 | 1088 nbytes = Lstream_read (read_stderr ? XLSTREAM (DATA_ERRSTREAM (p)) : |
1089 XLSTREAM (DATA_INSTREAM (p)), chars, | |
771 | 1090 sizeof (chars) - 1); |
428 | 1091 if (nbytes <= 0) return nbytes; |
1092 | |
771 | 1093 if (debug_process_io) |
1094 { | |
1095 chars[nbytes] = '\0'; | |
1096 stderr_out ("Read: %s\n", chars); | |
1097 } | |
1098 | |
1099 /* !!#### if the coding system changed as a result of reading, we | |
1100 need to change the output coding system accordingly. */ | |
428 | 1101 nchars = bytecount_to_charcount (chars, nbytes); |
853 | 1102 outstream = filter; |
428 | 1103 if (!NILP (outstream)) |
1104 { | |
853 | 1105 /* Some FSF junk with running_asynch_code, to preserve the match |
1106 data. Not necessary because we don't call process filters | |
1107 asynchronously (i.e. from within QUIT). */ | |
1108 /* Don't catch errors here; we're not in any critical code. */ | |
1109 call2 (outstream, process, make_string (chars, nbytes)); | |
428 | 1110 return nchars; |
1111 } | |
1112 | |
1113 /* If no filter, write into buffer if it isn't dead. */ | |
853 | 1114 if (!NILP (buffer) && BUFFER_LIVE_P (XBUFFER (buffer))) |
428 | 1115 { |
844 | 1116 struct gcpro gcpro1; |
853 | 1117 struct buffer *buf = XBUFFER (buffer); |
1118 int spec = process_setup_for_insertion (process, read_stderr); | |
428 | 1119 |
844 | 1120 GCPRO1 (process); |
428 | 1121 |
1122 #if 0 | |
1123 /* This screws up initial display of the window. jla */ | |
1124 | |
1125 /* Insert before markers in case we are inserting where | |
1126 the buffer's mark is, and the user's next command is Meta-y. */ | |
1127 buffer_insert_raw_string_1 (buf, -1, chars, | |
1128 nbytes, INSDEL_BEFORE_MARKERS); | |
1129 #else | |
1130 buffer_insert_raw_string (buf, chars, nbytes); | |
1131 #endif | |
1132 | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
1133 Fset_marker (mark, make_fixnum (BUF_PT (buf)), buffer); |
853 | 1134 |
428 | 1135 MARK_MODELINE_CHANGED; |
844 | 1136 unbind_to (spec); |
428 | 1137 UNGCPRO; |
1138 } | |
1139 return nchars; | |
1140 } | |
853 | 1141 |
1142 int | |
1143 process_has_separate_stderr (Lisp_Object process) | |
1144 { | |
1145 return XPROCESS (process)->separate_stderr; | |
1146 } | |
1147 | |
859 | 1148 DEFUN ("process-has-separate-stderr-p", Fprocess_has_separate_stderr_p, 1, 1, |
1149 0, /* | |
1150 Return non-nil if process has stderr separate from stdout. | |
1151 */ | |
1152 (process)) | |
1153 { | |
1154 CHECK_PROCESS (process); | |
1155 return process_has_separate_stderr (process) ? Qt : Qnil; | |
1156 } | |
1157 | |
428 | 1158 |
1159 /* Sending data to subprocess */ | |
1160 | |
444 | 1161 /* send some data to process PROCESS. If NONRELOCATABLE is non-NULL, it |
428 | 1162 specifies the address of the data. Otherwise, the data comes from the |
1163 object RELOCATABLE (either a string or a buffer). START and LEN | |
1164 specify the offset and length of the data to send. | |
1165 | |
665 | 1166 Note that START and LEN are in Charbpos's if RELOCATABLE is a buffer, |
428 | 1167 and in Bytecounts otherwise. */ |
1168 | |
1169 void | |
444 | 1170 send_process (Lisp_Object process, |
867 | 1171 Lisp_Object relocatable, const Ibyte *nonrelocatable, |
428 | 1172 int start, int len) |
1173 { | |
1174 /* This function can GC */ | |
1175 struct gcpro gcpro1, gcpro2; | |
1176 Lisp_Object lstream = Qnil; | |
1177 | |
444 | 1178 GCPRO2 (process, lstream); |
428 | 1179 |
444 | 1180 if (NILP (DATA_OUTSTREAM (XPROCESS (process)))) |
563 | 1181 invalid_operation ("Process not open for writing", process); |
428 | 1182 |
1183 if (nonrelocatable) | |
1184 lstream = | |
1185 make_fixed_buffer_input_stream (nonrelocatable + start, len); | |
1186 else if (BUFFERP (relocatable)) | |
1187 lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable), | |
1188 start, start + len, 0); | |
1189 else | |
1190 lstream = make_lisp_string_input_stream (relocatable, start, len); | |
1191 | |
771 | 1192 if (debug_process_io) |
1193 { | |
1194 if (nonrelocatable) | |
1195 stderr_out ("Writing: %s\n", nonrelocatable); | |
1196 else | |
1197 { | |
1198 stderr_out ("Writing: "); | |
1199 print_internal (relocatable, Qexternal_debugging_output, 0); | |
1200 } | |
1201 } | |
1202 | |
444 | 1203 PROCMETH (send_process, (process, XLSTREAM (lstream))); |
428 | 1204 |
1205 UNGCPRO; | |
1206 Lstream_delete (XLSTREAM (lstream)); | |
1207 } | |
1208 | |
1209 DEFUN ("process-tty-name", Fprocess_tty_name, 1, 1, 0, /* | |
1210 Return the name of the terminal PROCESS uses, or nil if none. | |
1211 This is the terminal that the process itself reads and writes on, | |
1212 not the name of the pty that Emacs uses to talk with that terminal. | |
1213 */ | |
444 | 1214 (process)) |
428 | 1215 { |
444 | 1216 CHECK_PROCESS (process); |
1204 | 1217 return XPROCESS (process)->tty_name; |
428 | 1218 } |
1219 | |
1220 DEFUN ("set-process-buffer", Fset_process_buffer, 2, 2, 0, /* | |
1221 Set buffer associated with PROCESS to BUFFER (a buffer, or nil). | |
2297 | 1222 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. |
428 | 1223 */ |
444 | 1224 (process, buffer)) |
428 | 1225 { |
444 | 1226 CHECK_PROCESS (process); |
428 | 1227 if (!NILP (buffer)) |
1228 CHECK_BUFFER (buffer); | |
444 | 1229 XPROCESS (process)->buffer = buffer; |
428 | 1230 return buffer; |
1231 } | |
1232 | |
1233 DEFUN ("process-buffer", Fprocess_buffer, 1, 1, 0, /* | |
1234 Return the buffer PROCESS is associated with. | |
2297 | 1235 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. |
1236 Set the buffer with `set-process-buffer'. | |
428 | 1237 */ |
444 | 1238 (process)) |
428 | 1239 { |
444 | 1240 CHECK_PROCESS (process); |
1241 return XPROCESS (process)->buffer; | |
428 | 1242 } |
1243 | |
853 | 1244 DEFUN ("set-process-stderr-buffer", Fset_process_stderr_buffer, 2, 2, 0, /* |
2297 | 1245 Output from the stderr of PROCESS is inserted in this buffer unless |
1246 PROCESS has a stderr filter. | |
853 | 1247 Set stderr buffer associated with PROCESS to BUFFER (a buffer, or nil). |
1248 */ | |
1249 (process, buffer)) | |
1250 { | |
1251 CHECK_PROCESS (process); | |
1252 if (!XPROCESS (process)->separate_stderr) | |
1253 invalid_change ("stdout and stderr not separate", process); | |
1254 if (!NILP (buffer)) | |
1255 CHECK_BUFFER (buffer); | |
1256 XPROCESS (process)->stderr_buffer = buffer; | |
1257 return buffer; | |
1258 } | |
1259 | |
1260 DEFUN ("process-stderr-buffer", Fprocess_stderr_buffer, 1, 1, 0, /* | |
1261 Return the stderr buffer PROCESS is associated with. | |
2297 | 1262 Output from the stderr of PROCESS is inserted in this buffer unless PROCESS |
1263 has a stderr filter. Set the buffer with `set-process-stderr-buffer'. | |
853 | 1264 */ |
1265 (process)) | |
1266 { | |
1267 CHECK_PROCESS (process); | |
1268 if (!XPROCESS (process)->separate_stderr) | |
1269 invalid_change ("stdout and stderr not separate", process); | |
1270 return XPROCESS (process)->stderr_buffer; | |
1271 } | |
1272 | |
428 | 1273 DEFUN ("process-mark", Fprocess_mark, 1, 1, 0, /* |
1274 Return the marker for the end of the last output from PROCESS. | |
1275 */ | |
444 | 1276 (process)) |
428 | 1277 { |
444 | 1278 CHECK_PROCESS (process); |
1279 return XPROCESS (process)->mark; | |
428 | 1280 } |
1281 | |
853 | 1282 DEFUN ("process-stderr-mark", Fprocess_stderr_mark, 1, 1, 0, /* |
1283 Return the marker for the end of the last stderr output from PROCESS. | |
1284 */ | |
1285 (process)) | |
1286 { | |
1287 CHECK_PROCESS (process); | |
1288 if (!XPROCESS (process)->separate_stderr) | |
1289 invalid_operation ("stdout and stderr not separate", process); | |
1290 return XPROCESS (process)->stderr_mark; | |
1291 } | |
1292 | |
428 | 1293 void |
853 | 1294 set_process_filter (Lisp_Object process, Lisp_Object filter, |
1295 int filter_does_read, int set_stderr) | |
428 | 1296 { |
444 | 1297 CHECK_PROCESS (process); |
853 | 1298 if (set_stderr && !XPROCESS (process)->separate_stderr) |
1299 invalid_change ("stdout and stderr not separate", process); | |
863 | 1300 if (PROCESS_READABLE_P (XPROCESS (process))) |
853 | 1301 { |
1302 if (EQ (filter, Qt)) | |
1303 event_stream_unselect_process (XPROCESS (process), !set_stderr, | |
1304 set_stderr); | |
1305 else | |
1306 event_stream_select_process (XPROCESS (process), !set_stderr, | |
1307 set_stderr); | |
1308 } | |
428 | 1309 |
853 | 1310 if (set_stderr) |
1311 XPROCESS (process)->stderr_filter = filter; | |
1312 else | |
1313 XPROCESS (process)->filter = filter; | |
444 | 1314 XPROCESS (process)->filter_does_read = filter_does_read; |
428 | 1315 } |
1316 | |
1317 DEFUN ("set-process-filter", Fset_process_filter, 2, 2, 0, /* | |
1318 Give PROCESS the filter function FILTER; nil means no filter. | |
853 | 1319 t means stop accepting output from the process. (If process was created |
854 | 1320 with |
853 | 1321 When a process has a filter, each time it does output |
1322 the entire string of output is passed to the filter. | |
1323 The filter gets two arguments: the process and the string of output. | |
1324 If the process has a filter, its buffer is not used for output. | |
1325 */ | |
1326 (process, filter)) | |
1327 { | |
1328 set_process_filter (process, filter, 0, 0); | |
1329 return filter; | |
1330 } | |
1331 | |
1332 DEFUN ("set-process-stderr-filter", Fset_process_stderr_filter, 2, 2, 0, /* | |
1333 Give PROCESS the stderr filter function FILTER; nil means no filter. | |
428 | 1334 t means stop accepting output from the process. |
1335 When a process has a filter, each time it does output | |
1336 the entire string of output is passed to the filter. | |
1337 The filter gets two arguments: the process and the string of output. | |
1338 If the process has a filter, its buffer is not used for output. | |
1339 */ | |
444 | 1340 (process, filter)) |
428 | 1341 { |
853 | 1342 set_process_filter (process, filter, 0, 1); |
428 | 1343 return filter; |
1344 } | |
1345 | |
1346 DEFUN ("process-filter", Fprocess_filter, 1, 1, 0, /* | |
1347 Return the filter function of PROCESS; nil if none. | |
1348 See `set-process-filter' for more info on filter functions. | |
1349 */ | |
444 | 1350 (process)) |
428 | 1351 { |
444 | 1352 CHECK_PROCESS (process); |
1353 return XPROCESS (process)->filter; | |
428 | 1354 } |
1355 | |
853 | 1356 DEFUN ("process-stderr-filter", Fprocess_stderr_filter, 1, 1, 0, /* |
1357 Return the filter function of PROCESS; nil if none. | |
1358 See `set-process-stderr-filter' for more info on filter functions. | |
1359 */ | |
1360 (process)) | |
1361 { | |
1362 CHECK_PROCESS (process); | |
1363 if (!XPROCESS (process)->separate_stderr) | |
1364 invalid_operation ("stdout and stderr not separate", process); | |
1365 return XPROCESS (process)->stderr_filter; | |
1366 } | |
1367 | |
442 | 1368 DEFUN ("process-send-region", Fprocess_send_region, 3, 4, 0, /* |
1369 Send current contents of the region between START and END as input to PROCESS. | |
444 | 1370 PROCESS may be a process or the name of a process, or a buffer or the |
1371 name of a buffer, in which case the buffer's process is used. If it | |
1372 is nil, the current buffer's process is used. | |
442 | 1373 BUFFER specifies the buffer to look in; if nil, the current buffer is used. |
853 | 1374 If the region is more than 100 or so characters long, it may be sent in |
1375 several chunks. This may happen even for shorter regions. Output | |
444 | 1376 from processes can arrive in between chunks. |
428 | 1377 */ |
442 | 1378 (process, start, end, buffer)) |
428 | 1379 { |
1380 /* This function can GC */ | |
665 | 1381 Charbpos bstart, bend; |
442 | 1382 struct buffer *buf = decode_buffer (buffer, 0); |
428 | 1383 |
793 | 1384 buffer = wrap_buffer (buf); |
444 | 1385 process = get_process (process); |
1386 get_buffer_range_char (buf, start, end, &bstart, &bend, 0); | |
442 | 1387 |
444 | 1388 send_process (process, buffer, 0, bstart, bend - bstart); |
428 | 1389 return Qnil; |
1390 } | |
1391 | |
1392 DEFUN ("process-send-string", Fprocess_send_string, 2, 4, 0, /* | |
1393 Send PROCESS the contents of STRING as input. | |
444 | 1394 PROCESS may be a process or the name of a process, or a buffer or the |
1395 name of a buffer, in which case the buffer's process is used. If it | |
1396 is nil, the current buffer's process is used. | |
1397 Optional arguments START and END specify part of STRING; see `substring'. | |
1398 If STRING is more than 100 or so characters long, it may be sent in | |
1399 several chunks. This may happen even for shorter strings. Output | |
1400 from processes can arrive in between chunks. | |
428 | 1401 */ |
444 | 1402 (process, string, start, end)) |
428 | 1403 { |
1404 /* This function can GC */ | |
444 | 1405 Bytecount bstart, bend; |
428 | 1406 |
444 | 1407 process = get_process (process); |
428 | 1408 CHECK_STRING (string); |
444 | 1409 get_string_range_byte (string, start, end, &bstart, &bend, |
428 | 1410 GB_HISTORICAL_STRING_BEHAVIOR); |
1411 | |
444 | 1412 send_process (process, string, 0, bstart, bend - bstart); |
428 | 1413 return Qnil; |
1414 } | |
1415 | |
1416 | |
1417 DEFUN ("process-input-coding-system", Fprocess_input_coding_system, 1, 1, 0, /* | |
1418 Return PROCESS's input coding system. | |
1419 */ | |
1420 (process)) | |
1421 { | |
1422 process = get_process (process); | |
863 | 1423 CHECK_READABLE_PROCESS (process); |
771 | 1424 return (coding_stream_detected_coding_system |
1425 (XLSTREAM (XPROCESS (process)->coding_instream))); | |
428 | 1426 } |
1427 | |
1428 DEFUN ("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /* | |
1429 Return PROCESS's output coding system. | |
1430 */ | |
1431 (process)) | |
1432 { | |
1433 process = get_process (process); | |
440 | 1434 CHECK_LIVE_PROCESS (process); |
771 | 1435 return (coding_stream_coding_system |
1436 (XLSTREAM (XPROCESS (process)->coding_outstream))); | |
428 | 1437 } |
1438 | |
1439 DEFUN ("process-coding-system", Fprocess_coding_system, 1, 1, 0, /* | |
1440 Return a pair of coding-system for decoding and encoding of PROCESS. | |
1441 */ | |
1442 (process)) | |
1443 { | |
1444 process = get_process (process); | |
863 | 1445 CHECK_READABLE_PROCESS (process); |
771 | 1446 return Fcons (coding_stream_detected_coding_system |
428 | 1447 (XLSTREAM (XPROCESS (process)->coding_instream)), |
771 | 1448 coding_stream_coding_system |
428 | 1449 (XLSTREAM (XPROCESS (process)->coding_outstream))); |
1450 } | |
1451 | |
1452 DEFUN ("set-process-input-coding-system", Fset_process_input_coding_system, | |
1453 2, 2, 0, /* | |
1454 Set PROCESS's input coding system to CODESYS. | |
771 | 1455 This is used for reading data from PROCESS. |
428 | 1456 */ |
1457 (process, codesys)) | |
1458 { | |
771 | 1459 codesys = get_coding_system_for_text_file (codesys, 1); |
428 | 1460 process = get_process (process); |
863 | 1461 CHECK_READABLE_PROCESS (process); |
440 | 1462 |
771 | 1463 set_coding_stream_coding_system |
428 | 1464 (XLSTREAM (XPROCESS (process)->coding_instream), codesys); |
1465 return Qnil; | |
1466 } | |
1467 | |
1468 DEFUN ("set-process-output-coding-system", Fset_process_output_coding_system, | |
1469 2, 2, 0, /* | |
1470 Set PROCESS's output coding system to CODESYS. | |
771 | 1471 This is used for writing data to PROCESS. |
428 | 1472 */ |
1473 (process, codesys)) | |
1474 { | |
771 | 1475 codesys = get_coding_system_for_text_file (codesys, 0); |
428 | 1476 process = get_process (process); |
440 | 1477 CHECK_LIVE_PROCESS (process); |
1478 | |
771 | 1479 set_coding_stream_coding_system |
428 | 1480 (XLSTREAM (XPROCESS (process)->coding_outstream), codesys); |
1481 return Qnil; | |
1482 } | |
1483 | |
1484 DEFUN ("set-process-coding-system", Fset_process_coding_system, | |
1485 1, 3, 0, /* | |
1486 Set coding-systems of PROCESS to DECODING and ENCODING. | |
440 | 1487 DECODING will be used to decode subprocess output and ENCODING to |
1488 encode subprocess input. | |
428 | 1489 */ |
1490 (process, decoding, encoding)) | |
1491 { | |
1492 if (!NILP (decoding)) | |
1493 Fset_process_input_coding_system (process, decoding); | |
1494 | |
1495 if (!NILP (encoding)) | |
1496 Fset_process_output_coding_system (process, encoding); | |
1497 | |
1498 return Qnil; | |
1499 } | |
1500 | |
1501 | |
1502 /************************************************************************/ | |
1503 /* process status */ | |
1504 /************************************************************************/ | |
1505 | |
1506 static Lisp_Object | |
1507 exec_sentinel_unwind (Lisp_Object datum) | |
1508 { | |
853 | 1509 XPROCESS (XCAR (datum))->sentinel = XCDR (datum); |
1510 free_cons (datum); | |
428 | 1511 return Qnil; |
1512 } | |
1513 | |
1514 static void | |
444 | 1515 exec_sentinel (Lisp_Object process, Lisp_Object reason) |
428 | 1516 { |
1517 /* This function can GC */ | |
1518 int speccount = specpdl_depth (); | |
444 | 1519 Lisp_Process *p = XPROCESS (process); |
428 | 1520 Lisp_Object sentinel = p->sentinel; |
1521 | |
1522 if (NILP (sentinel)) | |
1523 return; | |
1524 | |
1525 /* Some weird FSFmacs crap here with | |
1526 Vdeactivate_mark and current_buffer->keymap */ | |
1527 | |
853 | 1528 /* Some FSF junk with running_asynch_code, to preserve the match |
1529 data. Not necessary because we don't call process filters | |
1530 asynchronously (i.e. from within QUIT). */ | |
1531 | |
428 | 1532 /* Zilch the sentinel while it's running, to avoid recursive invocations; |
853 | 1533 assure that it gets restored no matter how the sentinel exits. |
1534 | |
1535 (#### Why is this necessary? Probably another relic of asynchronous | |
1536 calling of process filters/sentinels.) */ | |
428 | 1537 p->sentinel = Qnil; |
853 | 1538 record_unwind_protect (exec_sentinel_unwind, |
1539 noseeum_cons (process, sentinel)); | |
1540 /* Don't catch errors here; we're not in any critical code. */ | |
1541 call2 (sentinel, process, reason); | |
771 | 1542 unbind_to (speccount); |
428 | 1543 } |
1544 | |
1545 DEFUN ("set-process-sentinel", Fset_process_sentinel, 2, 2, 0, /* | |
1546 Give PROCESS the sentinel SENTINEL; nil for none. | |
1547 The sentinel is called as a function when the process changes state. | |
1548 It gets two arguments: the process, and a string describing the change. | |
1549 */ | |
444 | 1550 (process, sentinel)) |
428 | 1551 { |
444 | 1552 CHECK_PROCESS (process); |
1553 XPROCESS (process)->sentinel = sentinel; | |
428 | 1554 return sentinel; |
1555 } | |
1556 | |
1557 DEFUN ("process-sentinel", Fprocess_sentinel, 1, 1, 0, /* | |
1558 Return the sentinel of PROCESS; nil if none. | |
1559 See `set-process-sentinel' for more info on sentinels. | |
1560 */ | |
444 | 1561 (process)) |
428 | 1562 { |
444 | 1563 CHECK_PROCESS (process); |
1564 return XPROCESS (process)->sentinel; | |
428 | 1565 } |
1566 | |
1567 | |
442 | 1568 const char * |
428 | 1569 signal_name (int signum) |
1570 { | |
1571 if (signum >= 0 && signum < NSIG) | |
442 | 1572 return (const char *) sys_siglist[signum]; |
428 | 1573 |
442 | 1574 return (const char *) GETTEXT ("unknown signal"); |
428 | 1575 } |
1576 | |
1577 void | |
1578 update_process_status (Lisp_Object p, | |
1579 Lisp_Object status_symbol, | |
1580 int exit_code, | |
1581 int core_dumped) | |
1582 { | |
1583 XPROCESS (p)->tick++; | |
1584 process_tick++; | |
1585 XPROCESS (p)->status_symbol = status_symbol; | |
1586 XPROCESS (p)->exit_code = exit_code; | |
1587 XPROCESS (p)->core_dumped = core_dumped; | |
1588 } | |
1589 | |
1590 /* Return a string describing a process status list. */ | |
1591 | |
1592 static Lisp_Object | |
440 | 1593 status_message (Lisp_Process *p) |
428 | 1594 { |
1595 Lisp_Object symbol = p->status_symbol; | |
1596 int code = p->exit_code; | |
1597 int coredump = p->core_dumped; | |
1598 Lisp_Object string, string2; | |
1599 | |
1600 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop)) | |
1601 { | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1602 string = build_cistring (signal_name (code)); |
428 | 1603 if (coredump) |
771 | 1604 string2 = build_msg_string (" (core dumped)\n"); |
428 | 1605 else |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
1606 string2 = build_ascstring ("\n"); |
793 | 1607 set_string_char (string, 0, |
867 | 1608 DOWNCASE (0, string_ichar (string, 0))); |
428 | 1609 return concat2 (string, string2); |
1610 } | |
1611 else if (EQ (symbol, Qexit)) | |
1612 { | |
1613 if (code == 0) | |
771 | 1614 return build_msg_string ("finished\n"); |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
1615 string = Fnumber_to_string (make_fixnum (code)); |
428 | 1616 if (coredump) |
771 | 1617 string2 = build_msg_string (" (core dumped)\n"); |
428 | 1618 else |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
1619 string2 = build_ascstring ("\n"); |
771 | 1620 return concat2 (build_msg_string ("exited abnormally with code "), |
428 | 1621 concat2 (string, string2)); |
1622 } | |
1623 else | |
1624 return Fcopy_sequence (Fsymbol_name (symbol)); | |
1625 } | |
1626 | |
1627 /* Tell status_notify() to check for terminated processes. We do this | |
1628 because on some systems we sometimes miss SIGCHLD calls. (Not sure | |
853 | 1629 why.) This is also used under Mswin. */ |
428 | 1630 |
1631 void | |
1632 kick_status_notify (void) | |
1633 { | |
1634 process_tick++; | |
1635 } | |
1636 | |
1637 | |
1638 /* Report all recent events of a change in process status | |
1639 (either run the sentinel or output a message). | |
1640 This is done while Emacs is waiting for keyboard input. */ | |
1641 | |
1642 void | |
1643 status_notify (void) | |
1644 { | |
1645 /* This function can GC */ | |
1646 Lisp_Object tail = Qnil; | |
1647 Lisp_Object symbol = Qnil; | |
1648 Lisp_Object msg = Qnil; | |
1649 struct gcpro gcpro1, gcpro2, gcpro3; | |
1650 /* process_tick is volatile, so we have to remember it now. | |
444 | 1651 Otherwise, we get a race condition if SIGCHLD happens during |
428 | 1652 this function. |
1653 | |
1654 (Actually, this is not the case anymore. The code to | |
1655 update the process structures has been moved out of the | |
1656 SIGCHLD handler. But for the moment I'm leaving this | |
1657 stuff in -- it can't hurt.) */ | |
1658 int temp_process_tick; | |
1659 | |
1660 MAYBE_PROCMETH (reap_exited_processes, ()); | |
1661 | |
1662 temp_process_tick = process_tick; | |
1663 | |
1664 if (update_tick == temp_process_tick) | |
1665 return; | |
1666 | |
1667 /* We need to gcpro tail; if read_process_output calls a filter | |
1668 which deletes a process and removes the cons to which tail points | |
1669 from Vprocess_alist, and then causes a GC, tail is an unprotected | |
1670 reference. */ | |
1671 GCPRO3 (tail, symbol, msg); | |
1672 | |
1673 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) | |
1674 { | |
444 | 1675 Lisp_Object process = XCAR (tail); |
1676 Lisp_Process *p = XPROCESS (process); | |
428 | 1677 /* p->tick is also volatile. Same thing as above applies. */ |
1678 int this_process_tick; | |
1679 | |
1680 /* #### extra check for terminated processes, in case a SIGCHLD | |
1681 got missed (this seems to happen sometimes, I'm not sure why). | |
1682 */ | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
1683 if (FIXNUMP (p->pid)) |
428 | 1684 MAYBE_PROCMETH (update_status_if_terminated, (p)); |
1685 | |
1686 this_process_tick = p->tick; | |
1687 if (this_process_tick != p->update_tick) | |
1688 { | |
1689 p->update_tick = this_process_tick; | |
1690 | |
1691 /* If process is still active, read any output that remains. */ | |
1692 while (!EQ (p->filter, Qt) | |
853 | 1693 && read_process_output (process, 0) > 0) |
1694 ; | |
1695 while (p->separate_stderr && !EQ (p->stderr_filter, Qt) | |
1696 && read_process_output (process, 1) > 0) | |
428 | 1697 ; |
1698 | |
1699 /* Get the text to use for the message. */ | |
1700 msg = status_message (p); | |
1701 | |
1702 /* If process is terminated, deactivate it or delete it. */ | |
1703 symbol = p->status_symbol; | |
1704 | |
1705 if (EQ (symbol, Qsignal) | |
1706 || EQ (symbol, Qexit)) | |
1707 { | |
1708 if (delete_exited_processes) | |
444 | 1709 remove_process (process); |
428 | 1710 else |
444 | 1711 deactivate_process (process); |
428 | 1712 } |
1713 | |
1714 /* Now output the message suitably. */ | |
1715 if (!NILP (p->sentinel)) | |
444 | 1716 exec_sentinel (process, msg); |
428 | 1717 /* Don't bother with a message in the buffer |
1718 when a process becomes runnable. */ | |
844 | 1719 else if (!EQ (symbol, Qrun) && !NILP (p->buffer) && |
1720 /* Avoid error if buffer is deleted | |
1721 (probably that's why the process is dead, too) */ | |
1722 BUFFER_LIVE_P (XBUFFER (p->buffer))) | |
428 | 1723 { |
844 | 1724 struct gcpro ngcpro1; |
853 | 1725 int spec = process_setup_for_insertion (process, 0); |
428 | 1726 |
844 | 1727 NGCPRO1 (process); |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1728 buffer_insert_ascstring (current_buffer, "\nProcess "); |
428 | 1729 Finsert (1, &p->name); |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1730 buffer_insert_ascstring (current_buffer, " "); |
428 | 1731 Finsert (1, &msg); |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
1732 Fset_marker (p->mark, make_fixnum (BUF_PT (current_buffer)), |
428 | 1733 p->buffer); |
1734 | |
844 | 1735 unbind_to (spec); |
428 | 1736 NUNGCPRO; |
1737 } | |
1738 } | |
1739 } /* end for */ | |
1740 | |
1741 /* in case buffers use %s in modeline-format */ | |
1742 MARK_MODELINE_CHANGED; | |
1743 redisplay (); | |
1744 | |
1745 update_tick = temp_process_tick; | |
1746 | |
1747 UNGCPRO; | |
1748 } | |
1749 | |
1750 DEFUN ("process-status", Fprocess_status, 1, 1, 0, /* | |
1751 Return the status of PROCESS. | |
1752 This is a symbol, one of these: | |
1753 | |
1754 run -- for a process that is running. | |
1755 stop -- for a process stopped but continuable. | |
1756 exit -- for a process that has exited. | |
1757 signal -- for a process that has got a fatal signal. | |
1758 open -- for a network stream connection that is open. | |
1759 closed -- for a network stream connection that is closed. | |
1760 nil -- if arg is a process name and no such process exists. | |
1761 | |
1762 PROCESS may be a process, a buffer, the name of a process or buffer, or | |
1763 nil, indicating the current buffer's process. | |
1764 */ | |
444 | 1765 (process)) |
428 | 1766 { |
1767 Lisp_Object status_symbol; | |
1768 | |
444 | 1769 if (STRINGP (process)) |
1770 process = Fget_process (process); | |
428 | 1771 else |
444 | 1772 process = get_process (process); |
428 | 1773 |
444 | 1774 if (NILP (process)) |
428 | 1775 return Qnil; |
1776 | |
444 | 1777 status_symbol = XPROCESS (process)->status_symbol; |
1778 if (network_connection_p (process)) | |
428 | 1779 { |
1780 if (EQ (status_symbol, Qrun)) | |
1781 status_symbol = Qopen; | |
1782 else if (EQ (status_symbol, Qexit)) | |
1783 status_symbol = Qclosed; | |
1784 } | |
1785 return status_symbol; | |
1786 } | |
1787 | |
1788 DEFUN ("process-exit-status", Fprocess_exit_status, 1, 1, 0, /* | |
1789 Return the exit status of PROCESS or the signal number that killed it. | |
1790 If PROCESS has not yet exited or died, return 0. | |
1791 */ | |
444 | 1792 (process)) |
428 | 1793 { |
444 | 1794 CHECK_PROCESS (process); |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
1795 return make_fixnum (XPROCESS (process)->exit_code); |
428 | 1796 } |
1797 | |
1798 | |
1799 | |
442 | 1800 static int |
1801 decode_signal (Lisp_Object signal_) | |
428 | 1802 { |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
1803 if (FIXNUMP (signal_)) |
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
1804 return XFIXNUM (signal_); |
428 | 1805 else |
1806 { | |
867 | 1807 Ibyte *name; |
428 | 1808 |
442 | 1809 CHECK_SYMBOL (signal_); |
793 | 1810 name = XSTRING_DATA (XSYMBOL (signal_)->name); |
428 | 1811 |
793 | 1812 #define handle_signal(sym) do { \ |
2367 | 1813 if (!qxestrcmp_ascii ( name, #sym)) \ |
793 | 1814 return sym; \ |
442 | 1815 } while (0) |
428 | 1816 |
1817 handle_signal (SIGINT); /* ANSI */ | |
1818 handle_signal (SIGILL); /* ANSI */ | |
1819 handle_signal (SIGABRT); /* ANSI */ | |
1820 handle_signal (SIGFPE); /* ANSI */ | |
1821 handle_signal (SIGSEGV); /* ANSI */ | |
1822 handle_signal (SIGTERM); /* ANSI */ | |
1823 | |
1824 #ifdef SIGHUP | |
1825 handle_signal (SIGHUP); /* POSIX */ | |
1826 #endif | |
1827 #ifdef SIGQUIT | |
1828 handle_signal (SIGQUIT); /* POSIX */ | |
1829 #endif | |
1830 #ifdef SIGTRAP | |
1831 handle_signal (SIGTRAP); /* POSIX */ | |
1832 #endif | |
1833 #ifdef SIGKILL | |
1834 handle_signal (SIGKILL); /* POSIX */ | |
1835 #endif | |
1836 #ifdef SIGUSR1 | |
1837 handle_signal (SIGUSR1); /* POSIX */ | |
1838 #endif | |
1839 #ifdef SIGUSR2 | |
1840 handle_signal (SIGUSR2); /* POSIX */ | |
1841 #endif | |
1842 #ifdef SIGPIPE | |
1843 handle_signal (SIGPIPE); /* POSIX */ | |
1844 #endif | |
1845 #ifdef SIGALRM | |
1846 handle_signal (SIGALRM); /* POSIX */ | |
1847 #endif | |
1848 #ifdef SIGCHLD | |
1849 handle_signal (SIGCHLD); /* POSIX */ | |
1850 #endif | |
1851 #ifdef SIGCONT | |
1852 handle_signal (SIGCONT); /* POSIX */ | |
1853 #endif | |
1854 #ifdef SIGSTOP | |
1855 handle_signal (SIGSTOP); /* POSIX */ | |
1856 #endif | |
1857 #ifdef SIGTSTP | |
1858 handle_signal (SIGTSTP); /* POSIX */ | |
1859 #endif | |
1860 #ifdef SIGTTIN | |
1861 handle_signal (SIGTTIN); /* POSIX */ | |
1862 #endif | |
1863 #ifdef SIGTTOU | |
1864 handle_signal (SIGTTOU); /* POSIX */ | |
1865 #endif | |
1866 | |
1867 #ifdef SIGBUS | |
1868 handle_signal (SIGBUS); /* XPG5 */ | |
1869 #endif | |
1870 #ifdef SIGPOLL | |
1871 handle_signal (SIGPOLL); /* XPG5 */ | |
1872 #endif | |
1873 #ifdef SIGPROF | |
1874 handle_signal (SIGPROF); /* XPG5 */ | |
1875 #endif | |
1876 #ifdef SIGSYS | |
1877 handle_signal (SIGSYS); /* XPG5 */ | |
1878 #endif | |
1879 #ifdef SIGURG | |
1880 handle_signal (SIGURG); /* XPG5 */ | |
1881 #endif | |
1882 #ifdef SIGXCPU | |
1883 handle_signal (SIGXCPU); /* XPG5 */ | |
1884 #endif | |
1885 #ifdef SIGXFSZ | |
1886 handle_signal (SIGXFSZ); /* XPG5 */ | |
1887 #endif | |
1888 #ifdef SIGVTALRM | |
1889 handle_signal (SIGVTALRM); /* XPG5 */ | |
1890 #endif | |
1891 | |
1892 #ifdef SIGIO | |
1893 handle_signal (SIGIO); /* BSD 4.2 */ | |
1894 #endif | |
1895 #ifdef SIGWINCH | |
1896 handle_signal (SIGWINCH); /* BSD 4.3 */ | |
1897 #endif | |
1898 | |
1899 #ifdef SIGEMT | |
1900 handle_signal (SIGEMT); | |
1901 #endif | |
1902 #ifdef SIGINFO | |
1903 handle_signal (SIGINFO); | |
1904 #endif | |
1905 #ifdef SIGHWE | |
1906 handle_signal (SIGHWE); | |
1907 #endif | |
1908 #ifdef SIGPRE | |
1909 handle_signal (SIGPRE); | |
1910 #endif | |
1911 #ifdef SIGUME | |
1912 handle_signal (SIGUME); | |
1913 #endif | |
1914 #ifdef SIGDLK | |
1915 handle_signal (SIGDLK); | |
1916 #endif | |
1917 #ifdef SIGCPULIM | |
1918 handle_signal (SIGCPULIM); | |
1919 #endif | |
1920 #ifdef SIGIOT | |
1921 handle_signal (SIGIOT); | |
1922 #endif | |
1923 #ifdef SIGLOST | |
1924 handle_signal (SIGLOST); | |
1925 #endif | |
1926 #ifdef SIGSTKFLT | |
1927 handle_signal (SIGSTKFLT); | |
1928 #endif | |
1929 #ifdef SIGUNUSED | |
1930 handle_signal (SIGUNUSED); | |
1931 #endif | |
1932 #ifdef SIGDANGER | |
1933 handle_signal (SIGDANGER); /* AIX */ | |
1934 #endif | |
1935 #ifdef SIGMSG | |
1936 handle_signal (SIGMSG); | |
1937 #endif | |
1938 #ifdef SIGSOUND | |
1939 handle_signal (SIGSOUND); | |
1940 #endif | |
1941 #ifdef SIGRETRACT | |
1942 handle_signal (SIGRETRACT); | |
1943 #endif | |
1944 #ifdef SIGGRANT | |
1945 handle_signal (SIGGRANT); | |
1946 #endif | |
1947 #ifdef SIGPWR | |
1948 handle_signal (SIGPWR); | |
1949 #endif | |
1950 | |
1951 #undef handle_signal | |
1952 | |
563 | 1953 invalid_constant ("Undefined signal name", signal_); |
1204 | 1954 RETURN_NOT_REACHED (0); |
442 | 1955 } |
1956 } | |
1957 | |
1958 /* Send signal number SIGNO to PROCESS. | |
1959 CURRENT-GROUP non-nil means send signal to the current | |
1960 foreground process group of the process's controlling terminal rather | |
1961 than to the process's own process group. | |
1962 This is used for various commands in shell mode. | |
1963 If NOMSG is zero, insert signal-announcements into process's buffers | |
1964 right away. | |
1965 | |
1966 If we can, we try to signal PROCESS by sending control characters | |
1967 down the pty. This allows us to signal inferiors who have changed | |
1968 their uid, for which kill() would return an EPERM error, or to | |
1969 processes running on another computer through a remote login. */ | |
1970 | |
1971 static void | |
1972 process_send_signal (Lisp_Object process, int signo, | |
1973 int current_group, int nomsg) | |
1974 { | |
1975 /* This function can GC */ | |
444 | 1976 process = get_process (process); |
442 | 1977 |
444 | 1978 if (network_connection_p (process)) |
563 | 1979 invalid_operation ("Network connection is not a subprocess", process); |
444 | 1980 CHECK_LIVE_PROCESS (process); |
442 | 1981 |
444 | 1982 MAYBE_PROCMETH (kill_child_process, (process, signo, current_group, nomsg)); |
442 | 1983 } |
1984 | |
1985 DEFUN ("process-send-signal", Fprocess_send_signal, 1, 3, 0, /* | |
1986 Send signal SIGNAL to process PROCESS. | |
1987 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'. | |
1988 PROCESS may be a process, a buffer, the name of a process or buffer, or | |
1989 nil, indicating the current buffer's process. | |
1990 Third arg CURRENT-GROUP non-nil means send signal to the current | |
1991 foreground process group of the process's controlling terminal rather | |
1992 than to the process's own process group. | |
1993 If the process is a shell that supports job control, this means | |
1994 send the signal to the current subjob rather than the shell. | |
1995 */ | |
1996 (signal_, process, current_group)) | |
1997 { | |
1998 /* This function can GC */ | |
1999 process_send_signal (process, decode_signal (signal_), | |
2000 !NILP (current_group), 0); | |
2001 return process; | |
2002 } | |
2003 | |
2004 DEFUN ("interrupt-process", Finterrupt_process, 0, 2, 0, /* | |
2005 Interrupt process PROCESS. | |
2006 See function `process-send-signal' for more details on usage. | |
2007 */ | |
2008 (process, current_group)) | |
2009 { | |
2010 /* This function can GC */ | |
2011 process_send_signal (process, SIGINT, !NILP (current_group), 0); | |
2012 return process; | |
2013 } | |
2014 | |
2015 DEFUN ("kill-process", Fkill_process, 0, 2, 0, /* | |
2016 Kill process PROCESS. | |
2017 See function `process-send-signal' for more details on usage. | |
2018 */ | |
2019 (process, current_group)) | |
2020 { | |
2021 /* This function can GC */ | |
2022 #ifdef SIGKILL | |
2023 process_send_signal (process, SIGKILL, !NILP (current_group), 0); | |
2024 #else | |
563 | 2025 signal_error (Qunimplemented, |
2026 "kill-process: Not supported on this system", | |
2027 Qunbound); | |
442 | 2028 #endif |
2029 return process; | |
2030 } | |
2031 | |
2032 DEFUN ("quit-process", Fquit_process, 0, 2, 0, /* | |
2033 Send QUIT signal to process PROCESS. | |
2034 See function `process-send-signal' for more details on usage. | |
2035 */ | |
2036 (process, current_group)) | |
2037 { | |
2038 /* This function can GC */ | |
2039 #ifdef SIGQUIT | |
2040 process_send_signal (process, SIGQUIT, !NILP (current_group), 0); | |
2041 #else | |
563 | 2042 signal_error (Qunimplemented, |
2043 "quit-process: Not supported on this system", | |
2044 Qunbound); | |
442 | 2045 #endif |
2046 return process; | |
2047 } | |
2048 | |
2049 DEFUN ("stop-process", Fstop_process, 0, 2, 0, /* | |
2050 Stop process PROCESS. | |
2051 See function `process-send-signal' for more details on usage. | |
2052 */ | |
2053 (process, current_group)) | |
2054 { | |
2055 /* This function can GC */ | |
2056 #ifdef SIGTSTP | |
2057 process_send_signal (process, SIGTSTP, !NILP (current_group), 0); | |
2058 #else | |
563 | 2059 signal_error (Qunimplemented, |
2060 "stop-process: Not supported on this system", | |
2061 Qunbound); | |
442 | 2062 #endif |
2063 return process; | |
2064 } | |
2065 | |
2066 DEFUN ("continue-process", Fcontinue_process, 0, 2, 0, /* | |
2067 Continue process PROCESS. | |
2068 See function `process-send-signal' for more details on usage. | |
2069 */ | |
2070 (process, current_group)) | |
2071 { | |
2072 /* This function can GC */ | |
2073 #ifdef SIGCONT | |
2074 process_send_signal (process, SIGCONT, !NILP (current_group), 0); | |
2075 #else | |
563 | 2076 signal_error (Qunimplemented, |
2077 "continue-process: Not supported on this system", | |
2078 Qunbound); | |
442 | 2079 #endif |
2080 return process; | |
2081 } | |
2082 | |
2083 DEFUN ("signal-process", Fsignal_process, 2, 2, | |
2084 "nProcess number: \nnSignal code: ", /* | |
2085 Send the process with process id PID the signal with code SIGNAL. | |
2086 PID must be an integer. The process need not be a child of this Emacs. | |
2087 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'. | |
2088 */ | |
2089 (pid, signal_)) | |
2090 { | |
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
2091 CHECK_FIXNUM (pid); |
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
2092 |
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
2093 return make_fixnum (PROCMETH_OR_GIVEN (kill_process_by_pid, |
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
2094 (XFIXNUM (pid), decode_signal (signal_)), |
442 | 2095 -1)); |
428 | 2096 } |
2097 | |
2098 DEFUN ("process-send-eof", Fprocess_send_eof, 0, 1, 0, /* | |
2099 Make PROCESS see end-of-file in its input. | |
2100 PROCESS may be a process, a buffer, the name of a process or buffer, or | |
2101 nil, indicating the current buffer's process. | |
2102 If PROCESS is a network connection, or is a process communicating | |
2103 through a pipe (as opposed to a pty), then you cannot send any more | |
2104 text to PROCESS after you call this function. | |
2105 */ | |
2106 (process)) | |
2107 { | |
2108 /* This function can GC */ | |
444 | 2109 process = get_process (process); |
428 | 2110 |
2111 /* Make sure the process is really alive. */ | |
444 | 2112 if (! EQ (XPROCESS (process)->status_symbol, Qrun)) |
563 | 2113 invalid_operation ("Process not running", process); |
428 | 2114 |
444 | 2115 if (!MAYBE_INT_PROCMETH (process_send_eof, (process))) |
428 | 2116 { |
444 | 2117 if (!NILP (DATA_OUTSTREAM (XPROCESS (process)))) |
428 | 2118 { |
853 | 2119 USID humpty, dumpty; |
444 | 2120 Lstream_close (XLSTREAM (DATA_OUTSTREAM (XPROCESS (process)))); |
853 | 2121 event_stream_delete_io_streams (Qnil, |
2122 XPROCESS (process)->pipe_outstream, | |
2123 Qnil, &humpty, &dumpty); | |
444 | 2124 XPROCESS (process)->pipe_outstream = Qnil; |
2125 XPROCESS (process)->coding_outstream = Qnil; | |
428 | 2126 } |
2127 } | |
2128 | |
2129 return process; | |
2130 } | |
2131 | |
2132 | |
2133 /************************************************************************/ | |
2134 /* deleting a process */ | |
2135 /************************************************************************/ | |
2136 | |
2137 void | |
444 | 2138 deactivate_process (Lisp_Object process) |
428 | 2139 { |
444 | 2140 Lisp_Process *p = XPROCESS (process); |
853 | 2141 USID in_usid, err_usid; |
428 | 2142 |
2143 /* It's possible that we got as far in the process-creation | |
2144 process as creating the descriptors but didn't get so | |
2145 far as selecting the process for input. In this | |
2146 case, p->pid is nil: p->pid is set at the same time that | |
2147 the process is selected for input. */ | |
2148 /* #### The comment does not look correct. event_stream_unselect_process | |
853 | 2149 is guarded by process->*_selected, so this is not a problem. - kkm*/ |
428 | 2150 /* Must call this before setting the streams to nil */ |
853 | 2151 event_stream_unselect_process (p, 1, 1); |
428 | 2152 |
5588
2dbefd79b3d3
Prevent SIGPIPEs in deactivate_process().
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5581
diff
changeset
|
2153 /* We can get here in case of a crash in the external process, and then |
2dbefd79b3d3
Prevent SIGPIPEs in deactivate_process().
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5581
diff
changeset
|
2154 the Lstream_close on output will cause a SIGPIPE, which we're not ready |
2dbefd79b3d3
Prevent SIGPIPEs in deactivate_process().
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5581
diff
changeset
|
2155 for here. It looks to me like all cases where this function is called |
2dbefd79b3d3
Prevent SIGPIPEs in deactivate_process().
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5581
diff
changeset
|
2156 we know the process has exited (but I'm not 100% sure for the call in |
2dbefd79b3d3
Prevent SIGPIPEs in deactivate_process().
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5581
diff
changeset
|
2157 execute_internal_event (event-stream.c)), so it should be OK to use |
2dbefd79b3d3
Prevent SIGPIPEs in deactivate_process().
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5581
diff
changeset
|
2158 Lstream_close_noflush. |
2dbefd79b3d3
Prevent SIGPIPEs in deactivate_process().
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5581
diff
changeset
|
2159 |
2dbefd79b3d3
Prevent SIGPIPEs in deactivate_process().
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5581
diff
changeset
|
2160 #### The layering here needs a rethink. We should just be able |
2dbefd79b3d3
Prevent SIGPIPEs in deactivate_process().
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5581
diff
changeset
|
2161 to call Lstream_close, and let the Lstream's implementation decide |
2dbefd79b3d3
Prevent SIGPIPEs in deactivate_process().
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5581
diff
changeset
|
2162 if it can flush safely or not. The immediate problem is that the |
2dbefd79b3d3
Prevent SIGPIPEs in deactivate_process().
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5581
diff
changeset
|
2163 Lstream needs to know the process's status, but I don't think it has |
2dbefd79b3d3
Prevent SIGPIPEs in deactivate_process().
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5581
diff
changeset
|
2164 a handle to the process. */ |
428 | 2165 if (!NILP (DATA_OUTSTREAM (p))) |
5588
2dbefd79b3d3
Prevent SIGPIPEs in deactivate_process().
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5581
diff
changeset
|
2166 Lstream_close_noflush (XLSTREAM (DATA_OUTSTREAM (p))); |
428 | 2167 if (!NILP (DATA_INSTREAM (p))) |
2168 Lstream_close (XLSTREAM (DATA_INSTREAM (p))); | |
853 | 2169 if (!NILP (DATA_ERRSTREAM (p))) |
2170 Lstream_close (XLSTREAM (DATA_ERRSTREAM (p))); | |
428 | 2171 |
2172 /* Provide minimal implementation for deactivate_process | |
2173 if there's no process-specific one */ | |
2174 if (HAS_PROCMETH_P (deactivate_process)) | |
853 | 2175 PROCMETH (deactivate_process, (p, &in_usid, &err_usid)); |
428 | 2176 else |
853 | 2177 event_stream_delete_io_streams (p->pipe_instream, |
2178 p->pipe_outstream, | |
2179 p->pipe_errstream, | |
2180 &in_usid, &err_usid); | |
428 | 2181 |
853 | 2182 if (in_usid != USID_DONTHASH) |
2367 | 2183 remhash ((const void *) in_usid, usid_to_process); |
853 | 2184 if (err_usid != USID_DONTHASH) |
2367 | 2185 remhash ((const void *) err_usid, usid_to_process); |
428 | 2186 |
2187 p->pipe_instream = Qnil; | |
2188 p->pipe_outstream = Qnil; | |
853 | 2189 p->pipe_errstream = Qnil; |
428 | 2190 p->coding_instream = Qnil; |
2191 p->coding_outstream = Qnil; | |
853 | 2192 p->coding_errstream = Qnil; |
428 | 2193 } |
2194 | |
2195 static void | |
444 | 2196 remove_process (Lisp_Object process) |
428 | 2197 { |
444 | 2198 Vprocess_list = delq_no_quit (process, Vprocess_list); |
428 | 2199 |
444 | 2200 deactivate_process (process); |
428 | 2201 } |
2202 | |
2203 DEFUN ("delete-process", Fdelete_process, 1, 1, 0, /* | |
2204 Delete PROCESS: kill it and forget about it immediately. | |
2205 PROCESS may be a process or the name of one, or a buffer name. | |
2206 */ | |
444 | 2207 (process)) |
428 | 2208 { |
2209 /* This function can GC */ | |
440 | 2210 Lisp_Process *p; |
444 | 2211 process = get_process (process); |
2212 p = XPROCESS (process); | |
2213 if (network_connection_p (process)) | |
428 | 2214 { |
2215 p->status_symbol = Qexit; | |
2216 p->exit_code = 0; | |
2217 p->core_dumped = 0; | |
2218 p->tick++; | |
2219 process_tick++; | |
2220 } | |
440 | 2221 else if (PROCESS_LIVE_P (p)) |
428 | 2222 { |
444 | 2223 Fkill_process (process, Qnil); |
428 | 2224 /* Do this now, since remove_process will make sigchld_handler do nothing. */ |
2225 p->status_symbol = Qsignal; | |
2226 p->exit_code = SIGKILL; | |
2227 p->core_dumped = 0; | |
2228 p->tick++; | |
2229 process_tick++; | |
2230 status_notify (); | |
2231 } | |
444 | 2232 remove_process (process); |
428 | 2233 return Qnil; |
2234 } | |
2235 | |
2236 /* Kill all processes associated with `buffer'. | |
2237 If `buffer' is nil, kill all processes */ | |
2238 | |
2239 void | |
2240 kill_buffer_processes (Lisp_Object buffer) | |
2241 { | |
444 | 2242 LIST_LOOP_2 (process, Vprocess_list) |
2243 if ((NILP (buffer) || EQ (XPROCESS (process)->buffer, buffer))) | |
2244 { | |
2245 if (network_connection_p (process)) | |
2246 Fdelete_process (process); | |
2247 else if (PROCESS_LIVE_P (XPROCESS (process))) | |
2248 process_send_signal (process, SIGHUP, 0, 1); | |
2249 } | |
428 | 2250 } |
2251 | |
2252 DEFUN ("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /* | |
2253 Say no query needed if PROCESS is running when Emacs is exited. | |
2254 Optional second argument if non-nil says to require a query. | |
2255 Value is t if a query was formerly required. | |
2256 */ | |
444 | 2257 (process, require_query_p)) |
428 | 2258 { |
2259 int tem; | |
2260 | |
444 | 2261 CHECK_PROCESS (process); |
2262 tem = XPROCESS (process)->kill_without_query; | |
2263 XPROCESS (process)->kill_without_query = NILP (require_query_p); | |
428 | 2264 |
2265 return tem ? Qnil : Qt; | |
2266 } | |
2267 | |
2268 DEFUN ("process-kill-without-query-p", Fprocess_kill_without_query_p, 1, 1, 0, /* | |
444 | 2269 Return t if PROCESS will be killed without query when emacs is exited. |
428 | 2270 */ |
444 | 2271 (process)) |
428 | 2272 { |
444 | 2273 CHECK_PROCESS (process); |
2274 return XPROCESS (process)->kill_without_query ? Qt : Qnil; | |
428 | 2275 } |
2276 | |
2277 | |
2278 #if 0 | |
2279 | |
826 | 2280 DEFUN ("process-connection", Fprocess_connection, 0, 1, 0, /* |
428 | 2281 Return the connection type of `PROCESS'. This can be nil (pipe), |
2282 t or pty (pty) or stream (socket connection). | |
2283 */ | |
2284 (process)) | |
2285 { | |
2286 return XPROCESS (process)->type; | |
2287 } | |
2288 | |
2289 #endif /* 0 */ | |
2290 | |
814 | 2291 |
2292 static int | |
867 | 2293 getenv_internal (const Ibyte *var, |
814 | 2294 Bytecount varlen, |
867 | 2295 Ibyte **value, |
814 | 2296 Bytecount *valuelen) |
2297 { | |
2298 Lisp_Object scan; | |
2299 | |
2300 assert (env_initted); | |
2301 | |
2302 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan)) | |
2303 { | |
2304 Lisp_Object entry = XCAR (scan); | |
2305 | |
2306 if (STRINGP (entry) | |
2307 && XSTRING_LENGTH (entry) > varlen | |
826 | 2308 && string_byte (entry, varlen) == '=' |
814 | 2309 #ifdef WIN32_NATIVE |
2310 /* NT environment variables are case insensitive. */ | |
2311 && ! memicmp (XSTRING_DATA (entry), var, varlen) | |
2312 #else /* not WIN32_NATIVE */ | |
2313 && ! memcmp (XSTRING_DATA (entry), var, varlen) | |
2314 #endif /* not WIN32_NATIVE */ | |
2315 ) | |
2316 { | |
2317 *value = XSTRING_DATA (entry) + (varlen + 1); | |
2318 *valuelen = XSTRING_LENGTH (entry) - (varlen + 1); | |
2319 return 1; | |
2320 } | |
2321 } | |
2322 | |
2323 return 0; | |
2324 } | |
2325 | |
2326 static void | |
867 | 2327 putenv_internal (const Ibyte *var, |
814 | 2328 Bytecount varlen, |
867 | 2329 const Ibyte *value, |
814 | 2330 Bytecount valuelen) |
2331 { | |
2332 Lisp_Object scan; | |
2333 | |
2334 assert (env_initted); | |
2335 | |
2336 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan)) | |
2337 { | |
2338 Lisp_Object entry = XCAR (scan); | |
2339 | |
2340 if (STRINGP (entry) | |
2341 && XSTRING_LENGTH (entry) > varlen | |
826 | 2342 && string_byte (entry, varlen) == '=' |
814 | 2343 #ifdef WIN32_NATIVE |
2344 /* NT environment variables are case insensitive. */ | |
2345 && ! memicmp (XSTRING_DATA (entry), var, varlen) | |
2346 #else /* not WIN32_NATIVE */ | |
2347 && ! memcmp (XSTRING_DATA (entry), var, varlen) | |
2348 #endif /* not WIN32_NATIVE */ | |
2349 ) | |
2350 { | |
2351 XCAR (scan) = concat3 (make_string (var, varlen), | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
2352 build_ascstring ("="), |
814 | 2353 make_string (value, valuelen)); |
2354 return; | |
2355 } | |
2356 } | |
2357 | |
2358 Vprocess_environment = Fcons (concat3 (make_string (var, varlen), | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
2359 build_ascstring ("="), |
814 | 2360 make_string (value, valuelen)), |
2361 Vprocess_environment); | |
2362 } | |
2363 | |
2364 /* NOTE: | |
2365 | |
2366 FSF has this as a Lisp function, as follows. Generally moving things | |
2367 out of C and into Lisp is a good idea, but in this case the Lisp | |
2368 function is used so early in the startup sequence that it would be ugly | |
2369 to rearrange the early dumped code to accommodate this. | |
854 | 2370 |
814 | 2371 (defun getenv (variable) |
2372 "Get the value of environment variable VARIABLE. | |
2373 VARIABLE should be a string. Value is nil if VARIABLE is undefined in | |
2374 the environment. Otherwise, value is a string. | |
2375 | |
2376 This function consults the variable `process-environment' | |
2377 for its value." | |
2378 (interactive (list (read-envvar-name "Get environment variable: " t))) | |
2379 (let ((value (getenv-internal variable))) | |
2380 (when (interactive-p) | |
2381 (message "%s" (if value value "Not set"))) | |
2382 value)) | |
2383 */ | |
2384 | |
2385 DEFUN ("getenv", Fgetenv, 1, 2, "sEnvironment variable: \np", /* | |
2386 Return the value of environment variable VAR, as a string. | |
2387 VAR is a string, the name of the variable. | |
2388 When invoked interactively, prints the value in the echo area. | |
2389 */ | |
2390 (var, interactivep)) | |
2391 { | |
4932 | 2392 Ibyte *value = NULL; |
814 | 2393 Bytecount valuelen; |
2394 Lisp_Object v = Qnil; | |
2395 struct gcpro gcpro1; | |
2396 | |
2397 CHECK_STRING (var); | |
2398 GCPRO1 (v); | |
2399 if (getenv_internal (XSTRING_DATA (var), XSTRING_LENGTH (var), | |
2400 &value, &valuelen)) | |
2401 v = make_string (value, valuelen); | |
2402 if (!NILP (interactivep)) | |
2403 { | |
2404 if (NILP (v)) | |
2405 message ("%s not defined in environment", XSTRING_DATA (var)); | |
2406 else | |
2407 /* #### Should use Fprin1_to_string or Fprin1 to handle string | |
2408 containing quotes correctly. */ | |
2409 message ("\"%s\"", value); | |
2410 } | |
2411 RETURN_UNGCPRO (v); | |
2412 } | |
2413 | |
2414 /* A version of getenv that consults Vprocess_environment, easily | |
2415 callable from C. | |
2416 | |
2417 (At init time, Vprocess_environment is initialized from the | |
2418 environment, stored in the global variable environ. [Note that | |
2419 at startup time, `environ' should be the same as the envp parameter | |
2420 passed to main(); however, later calls to putenv() may change | |
2421 `environ', making the envp parameter inaccurate.] Calls to getenv() | |
2422 and putenv() consult and modify `environ'. However, once | |
2423 Vprocess_environment is initted, XEmacs C code should *NEVER* call | |
2424 getenv() or putenv() directly, because (1) Lisp code that modifies | |
2425 the environment only modifies Vprocess_environment, not `environ'; | |
2426 and (2) Vprocess_environment is in internal format but `environ' | |
2427 is in some external format, and getenv()/putenv() are not Mule- | |
2428 encapsulated. | |
2429 | |
2430 WARNING: This value points into Lisp string data and thus will become | |
2431 invalid after a GC. */ | |
2432 | |
867 | 2433 Ibyte * |
2434 egetenv (const CIbyte *var) | |
814 | 2435 { |
2436 /* This cannot GC -- 7-28-00 ben */ | |
867 | 2437 Ibyte *value; |
814 | 2438 Bytecount valuelen; |
2439 | |
867 | 2440 if (getenv_internal ((const Ibyte *) var, strlen (var), &value, &valuelen)) |
814 | 2441 return value; |
2442 else | |
2443 return 0; | |
2444 } | |
2445 | |
2446 void | |
867 | 2447 eputenv (const CIbyte *var, const CIbyte *value) |
814 | 2448 { |
867 | 2449 putenv_internal ((Ibyte *) var, strlen (var), (Ibyte *) value, |
814 | 2450 strlen (value)); |
2451 } | |
2452 | |
2453 | |
5255
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2454 void |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2455 reinit_process_early (void) |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2456 { |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2457 OBJECT_HAS_METHOD (process, getprop); |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2458 OBJECT_HAS_METHOD (process, putprop); |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2459 OBJECT_HAS_METHOD (process, remprop); |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2460 OBJECT_HAS_METHOD (process, plist); |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2461 OBJECT_HAS_METHOD (process, setplist); |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2462 } |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2463 |
814 | 2464 /* This is not named init_process in order to avoid a conflict with NS 3.3 */ |
2465 void | |
2466 init_xemacs_process (void) | |
2467 { | |
2468 /* This function can GC */ | |
2469 | |
2470 MAYBE_PROCMETH (init_process, ()); | |
2471 | |
2472 Vprocess_list = Qnil; | |
2473 | |
2474 if (usid_to_process) | |
2475 clrhash (usid_to_process); | |
2476 else | |
2477 usid_to_process = make_hash_table (32); | |
854 | 2478 |
814 | 2479 { |
2480 /* jwz: always initialize Vprocess_environment, so that egetenv() | |
2481 works in temacs. */ | |
2367 | 2482 Extbyte **envp; |
814 | 2483 Vprocess_environment = Qnil; |
2367 | 2484 #ifdef WIN32_NATIVE |
2485 _wgetenv (L""); /* force initialization of _wenviron */ | |
2486 for (envp = (Extbyte **) _wenviron; envp && *envp; envp++) | |
2487 Vprocess_environment = | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2488 Fcons (build_extstring (*envp, Qmswindows_unicode), |
2367 | 2489 Vprocess_environment); |
2490 #else | |
814 | 2491 for (envp = environ; envp && *envp; envp++) |
2492 Vprocess_environment = | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2493 Fcons (build_extstring (*envp, Qenvironment_variable_encoding), |
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
2494 Vprocess_environment); |
2367 | 2495 #endif |
814 | 2496 /* This gets set back to 0 in disksave_object_finalization() */ |
2497 env_initted = 1; | |
2498 } | |
2499 | |
2500 { | |
2501 /* Initialize shell-file-name from environment variables or best guess. */ | |
2502 #ifdef WIN32_NATIVE | |
867 | 2503 const Ibyte *shell = egetenv ("SHELL"); |
814 | 2504 if (!shell) shell = egetenv ("COMSPEC"); |
2505 /* Should never happen! */ | |
2506 if (!shell) shell = | |
867 | 2507 (Ibyte *) (GetVersion () & 0x80000000 ? "command" : "cmd"); |
814 | 2508 #else /* not WIN32_NATIVE */ |
867 | 2509 const Ibyte *shell = egetenv ("SHELL"); |
2510 if (!shell) shell = (Ibyte *) "/bin/sh"; | |
814 | 2511 #endif |
2512 | |
2513 #if 0 /* defined (WIN32_NATIVE) */ | |
2514 /* BAD BAD BAD. We do not wanting to be passing an XEmacs-created | |
2515 SHELL var down to some inferior Cygwin process, which might get | |
2516 screwed up. | |
854 | 2517 |
814 | 2518 There are a few broken apps (eterm/term.el, eterm/tshell.el, |
2519 os-utils/terminal.el, texinfo/tex-mode.el) where this will | |
2520 cause problems. Those broken apps don't look at | |
2521 shell-file-name, instead just at explicit-shell-file-name, | |
2522 ESHELL and SHELL. They are apparently attempting to borrow | |
2523 what `M-x shell' uses, but that latter also looks at | |
2524 shell-file-name. What we want is for all of these apps to look | |
2525 at shell-file-name, so that the user can change the value of | |
2526 shell-file-name and everything will work out hunky-dorey. | |
2527 */ | |
854 | 2528 |
814 | 2529 if (!egetenv ("SHELL")) |
2530 { | |
2367 | 2531 Ibyte *faux_var = alloca_ibytes (7 + qxestrlen (shell)); |
814 | 2532 qxesprintf (faux_var, "SHELL=%s", shell); |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2533 Vprocess_environment = Fcons (build_istring (faux_var), |
814 | 2534 Vprocess_environment); |
2535 } | |
2536 #endif /* 0 */ | |
2537 | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2538 Vshell_file_name = build_istring (shell); |
814 | 2539 } |
5255
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2540 |
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2541 reinit_process_early (); |
814 | 2542 } |
2543 | |
428 | 2544 void |
2545 syms_of_process (void) | |
2546 { | |
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
2547 INIT_LISP_OBJECT (process); |
442 | 2548 |
563 | 2549 DEFSYMBOL (Qprocessp); |
2550 DEFSYMBOL (Qprocess_live_p); | |
2551 DEFSYMBOL (Qrun); | |
2552 DEFSYMBOL (Qstop); | |
2553 DEFSYMBOL (Qopen); | |
2554 DEFSYMBOL (Qclosed); | |
863 | 2555 #if 0 |
2556 /* see comment at Fprocess_readable_p */ | |
2557 DEFSYMBOL (&Qprocess_readable_p); | |
2558 #endif | |
563 | 2559 DEFSYMBOL (Qtcp); |
2560 DEFSYMBOL (Qudp); | |
428 | 2561 |
2562 #ifdef HAVE_MULTICAST | |
563 | 2563 DEFSYMBOL (Qmulticast); /* Used for occasional warnings */ |
428 | 2564 #endif |
2565 | |
563 | 2566 DEFERROR_STANDARD (Qprocess_error, Qio_error); |
2567 DEFERROR_STANDARD (Qnetwork_error, Qio_error); | |
2568 | |
428 | 2569 DEFSUBR (Fprocessp); |
440 | 2570 DEFSUBR (Fprocess_live_p); |
863 | 2571 #if 0 |
2572 /* see comment at Fprocess_readable_p */ | |
2573 DEFSUBR (Fprocess_readable_p); | |
2574 #endif | |
428 | 2575 DEFSUBR (Fget_process); |
2576 DEFSUBR (Fget_buffer_process); | |
2577 DEFSUBR (Fdelete_process); | |
2578 DEFSUBR (Fprocess_status); | |
2579 DEFSUBR (Fprocess_exit_status); | |
2580 DEFSUBR (Fprocess_id); | |
2581 DEFSUBR (Fprocess_name); | |
2582 DEFSUBR (Fprocess_tty_name); | |
2583 DEFSUBR (Fprocess_command); | |
859 | 2584 DEFSUBR (Fprocess_has_separate_stderr_p); |
428 | 2585 DEFSUBR (Fset_process_buffer); |
853 | 2586 DEFSUBR (Fset_process_stderr_buffer); |
428 | 2587 DEFSUBR (Fprocess_buffer); |
2588 DEFSUBR (Fprocess_mark); | |
853 | 2589 DEFSUBR (Fprocess_stderr_buffer); |
2590 DEFSUBR (Fprocess_stderr_mark); | |
428 | 2591 DEFSUBR (Fset_process_filter); |
2592 DEFSUBR (Fprocess_filter); | |
853 | 2593 DEFSUBR (Fset_process_stderr_filter); |
2594 DEFSUBR (Fprocess_stderr_filter); | |
428 | 2595 DEFSUBR (Fset_process_window_size); |
2596 DEFSUBR (Fset_process_sentinel); | |
2597 DEFSUBR (Fprocess_sentinel); | |
2598 DEFSUBR (Fprocess_kill_without_query); | |
2599 DEFSUBR (Fprocess_kill_without_query_p); | |
2600 DEFSUBR (Fprocess_list); | |
2601 DEFSUBR (Fstart_process_internal); | |
2602 #ifdef HAVE_SOCKETS | |
2603 DEFSUBR (Fopen_network_stream_internal); | |
2604 #ifdef HAVE_MULTICAST | |
2605 DEFSUBR (Fopen_multicast_group_internal); | |
2606 #endif /* HAVE_MULTICAST */ | |
2607 #endif /* HAVE_SOCKETS */ | |
2608 DEFSUBR (Fprocess_send_region); | |
2609 DEFSUBR (Fprocess_send_string); | |
442 | 2610 DEFSUBR (Fprocess_send_signal); |
428 | 2611 DEFSUBR (Finterrupt_process); |
2612 DEFSUBR (Fkill_process); | |
2613 DEFSUBR (Fquit_process); | |
2614 DEFSUBR (Fstop_process); | |
2615 DEFSUBR (Fcontinue_process); | |
2616 DEFSUBR (Fprocess_send_eof); | |
2617 DEFSUBR (Fsignal_process); | |
2618 /* DEFSUBR (Fprocess_connection); */ | |
2619 DEFSUBR (Fprocess_input_coding_system); | |
2620 DEFSUBR (Fprocess_output_coding_system); | |
2621 DEFSUBR (Fset_process_input_coding_system); | |
2622 DEFSUBR (Fset_process_output_coding_system); | |
2623 DEFSUBR (Fprocess_coding_system); | |
2624 DEFSUBR (Fset_process_coding_system); | |
814 | 2625 DEFSUBR (Fgetenv); |
428 | 2626 } |
2627 | |
2628 void | |
2629 vars_of_process (void) | |
2630 { | |
2631 Fprovide (intern ("subprocesses")); | |
2632 #ifdef HAVE_SOCKETS | |
2633 Fprovide (intern ("network-streams")); | |
2634 #ifdef HAVE_MULTICAST | |
2635 Fprovide (intern ("multicast")); | |
2636 #endif /* HAVE_MULTICAST */ | |
2637 #endif /* HAVE_SOCKETS */ | |
2638 staticpro (&Vprocess_list); | |
2639 | |
2640 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes /* | |
2641 *Non-nil means delete processes immediately when they exit. | |
2642 nil means don't delete them until `list-processes' is run. | |
2643 */ ); | |
2644 | |
2645 delete_exited_processes = 1; | |
2646 | |
442 | 2647 DEFVAR_CONST_LISP ("null-device", &Vnull_device /* |
2648 Name of the null device, which differs from system to system. | |
2649 The null device is a filename that acts as a sink for arbitrary amounts of | |
2650 data, which is discarded, or as a source for a zero-length file. | |
2651 It is available on all the systems that we currently support, but with | |
2652 different names (typically either `/dev/null' or `nul'). | |
2653 | |
2654 Note that there is also a /dev/zero on most modern Unix versions (including | |
2655 Cygwin), which acts like /dev/null when used as a sink, but as a source | |
2656 it sends a non-ending stream of zero bytes. It's used most often along | |
2657 with memory-mapping. We don't provide a Lisp variable for this because | |
2658 the operations needing this are lower level than what ELisp programs | |
2659 typically do, and in any case no equivalent exists under native MS Windows. | |
2660 */ ); | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
2661 Vnull_device = build_ascstring (NULL_DEVICE); |
442 | 2662 |
428 | 2663 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type /* |
2664 Control type of device used to communicate with subprocesses. | |
2665 Values are nil to use a pipe, or t or `pty' to use a pty. | |
2666 The value has no effect if the system has no ptys or if all ptys are busy: | |
2667 then a pipe is used in any case. | |
2668 The value takes effect when `start-process' is called. | |
2669 */ ); | |
2670 Vprocess_connection_type = Qt; | |
2671 | |
2672 DEFVAR_BOOL ("windowed-process-io", &windowed_process_io /* | |
2673 Enables input/output on standard handles of a windowed process. | |
2674 When this variable is nil (the default), XEmacs does not attempt to read | |
2675 standard output handle of a windowed process. Instead, the process is | |
2676 immediately marked as exited immediately upon successful launching. This is | |
2677 done because normal windowed processes do not use standard I/O, as they are | |
2678 not connected to any console. | |
2679 | |
2680 When launching a specially crafted windowed process, which expects to be | |
2681 launched by XEmacs, or by other program which pipes its standard input and | |
2682 output, this variable must be set to non-nil, in which case XEmacs will | |
2683 treat this process just like a console process. | |
2684 | |
2685 NOTE: You should never set this variable, only bind it. | |
2686 | |
2687 Only Windows processes can be "windowed" or "console". This variable has no | |
2688 effect on UNIX processes, because all UNIX processes are "console". | |
2689 */ ); | |
2690 windowed_process_io = 0; | |
2691 | |
771 | 2692 DEFVAR_INT ("debug-process-io", &debug_process_io /* |
2693 If non-zero, display data sent to or received from a process. | |
2694 */ ); | |
2695 debug_process_io = 0; | |
2696 | |
2697 DEFVAR_LISP ("default-process-coding-system", | |
2698 &Vdefault_process_coding_system /* | |
2699 Cons of coding systems used for process I/O by default. | |
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2700 May also be nil, interpreted as (nil . nil). |
771 | 2701 The car part is used for reading (decoding) data from a process, and |
2702 the cdr part is used for writing (encoding) data to a process. | |
2703 */ ); | |
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2704 /* Better, system-dependent defaults are set in code-init.el. */ |
771 | 2705 Vdefault_process_coding_system = Fcons (Qundecided, Qnil); |
2706 | |
853 | 2707 DEFVAR_LISP ("default-network-coding-system", |
2708 &Vdefault_network_coding_system /* | |
2709 Cons of coding systems used for network I/O by default. | |
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2710 May also be nil, interpreted as (nil . nil). |
853 | 2711 The car part is used for reading (decoding) data from a process, and |
2712 the cdr part is used for writing (encoding) data to a process. | |
2713 */ ); | |
2714 Vdefault_network_coding_system = Fcons (Qundecided, Qnil); | |
2715 | |
428 | 2716 #ifdef PROCESS_IO_BLOCKING |
2717 DEFVAR_LISP ("network-stream-blocking-port-list", &network_stream_blocking_port_list /* | |
2718 List of port numbers or port names to set a blocking I/O mode with connection. | |
862 | 2719 Nil value means to set a default (non-blocking) I/O mode. |
428 | 2720 The value takes effect when `open-network-stream-internal' is called. |
2721 */ ); | |
2722 network_stream_blocking_port_list = Qnil; | |
2723 #endif /* PROCESS_IO_BLOCKING */ | |
814 | 2724 |
2725 /* This function can GC */ | |
2726 DEFVAR_LISP ("shell-file-name", &Vshell_file_name /* | |
2727 *File name to load inferior shells from. | |
2728 Initialized from the SHELL environment variable. | |
2729 */ ); | |
428 | 2730 |
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2731 /* ben? thinks the format of this variable is "semi-bogus". |
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2732 sjt doesn't agree, since it captures a restriction that is |
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2733 present in POSIX shells, after all. */ |
814 | 2734 DEFVAR_LISP ("process-environment", &Vprocess_environment /* |
2735 List of environment variables for subprocesses to inherit. | |
2736 Each element should be a string of the form ENVVARNAME=VALUE. | |
2737 The environment which Emacs inherits is placed in this variable | |
2738 when Emacs starts. | |
2739 */ ); | |
2740 | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
2741 Vlisp_EXEC_SUFFIXES = build_ascstring (EXEC_SUFFIXES); |
814 | 2742 staticpro (&Vlisp_EXEC_SUFFIXES); |
2743 } |