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