1 ;;; process.el --- commands for subprocesses; split out of simple.el
3 ;; Copyright (C) 1985-7, 1993,4, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 2000 Ben Wing.
7 ;; Maintainer: XEmacs Development Team
8 ;; Keywords: internal, processes, dumped
10 ;; This file is part of XEmacs.
12 ;; XEmacs is free software; you can redistribute it and/or modify it
13 ;; under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; XEmacs is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with XEmacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
27 ;;; Synched up with: FSF 19.30.
31 ;; Created 1995 by Ben Wing during Mule work -- some commands split out
32 ;; of simple.el and wrappers of *-internal functions created so they could
33 ;; be redefined in a Mule world.
34 ;; Lisp definition of call-process-internal added Mar. 2000 by Ben Wing.
38 ;; This file is dumped with XEmacs.
43 (defgroup processes nil
44 "Process, subshell, compilation, and job control support."
48 (defgroup processes-basics nil
49 "Basic stuff dealing with processes."
53 "Executing external commands."
57 (defvar shell-command-switch "-c"
58 "Switch used to have the shell execute its command line argument.")
60 (defun start-process-shell-command (name buffer &rest args)
61 "Start a program in a subprocess. Return the process object for it.
62 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
63 NAME is name for process. It is modified if necessary to make it unique.
64 BUFFER is the buffer or (buffer-name) to associate with the process.
65 Process output goes at end of that buffer, unless you specify
66 an output stream or filter function to handle the output.
67 BUFFER may be also nil, meaning that this process is not associated
69 Third arg is command name, the name of a shell command.
70 Remaining arguments are the arguments for the command.
71 Wildcards and redirection are handled as usual in the shell."
72 ;; We used to use `exec' to replace the shell with the command,
73 ;; but that failed to handle (...) and semicolon, etc.
74 (start-process name buffer shell-file-name shell-command-switch
75 (mapconcat #'identity args " ")))
77 (defun call-process-internal (program &optional infile buffer display &rest args)
78 "Call PROGRAM synchronously in separate process, with coding-system specified.
80 (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS).
81 The program's input comes from file INFILE (nil means `/dev/null').
82 Insert output in BUFFER before point; t means current buffer;
83 nil for BUFFER means discard it; 0 means discard and don't wait.
84 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
85 REAL-BUFFER says what to do with standard output, as above,
86 while STDERR-FILE says what to do with standard error in the child.
87 STDERR-FILE may be nil (discard standard error output),
88 t (mix it with ordinary output), or a file name string.
90 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
91 Remaining arguments are strings passed as command arguments to PROGRAM.
93 If BUFFER is 0, `call-process' returns immediately with value nil.
94 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
95 or a signal description string.
96 If you quit, the process is killed with SIGINT, or SIGKILL if you
98 ;; #### remove windows-nt check when this is ready for prime time.
99 (if (or (noninteractive) (not (eq 'windows-nt system-type)))
100 (apply 'old-call-process-internal program infile buffer display args)
101 (let (proc inbuf errbuf discard)
105 (setq infile (expand-file-name infile))
106 (setq inbuf (generate-new-buffer "*call-process*"))
107 (with-current-buffer inbuf
108 ;; Make sure this works with jka-compr
109 (let ((file-name-handler-alist nil))
110 (insert-file-contents-internal infile nil nil nil nil
112 (let ((stderr (if (consp buffer) (second buffer) t)))
113 (if (consp buffer) (setq buffer (car buffer)))
115 (cond ((null buffer) nil)
116 ((eq buffer t) (current-buffer))
117 ;; use integerp for compatibility with existing
118 ;; call-process rmsism.
119 ((integerp buffer) (setq discard t) nil)
120 (t (get-buffer-create buffer))))
121 (when (and stderr (not (eq t stderr)))
122 (setq stderr (expand-file-name stderr))
123 (setq errbuf (generate-new-buffer "*call-process*")))
125 (apply 'start-process-internal "*call-process*"
127 ;#### not implemented until my new process
129 ;(if (eq t stderr) buffer (list buffer errbuf))
132 (set-marker (process-mark proc) (point buffer) buffer))
135 (catch 'call-process-done
137 (set-process-sentinel
139 #'(lambda (proc status)
140 (cond ((eq 'exit (process-status proc))
141 (set-process-sentinel proc nil)
142 (throw 'call-process-done
143 (process-exit-status proc)))
144 ((eq 'signal (process-status proc))
145 (set-process-sentinel proc nil)
146 (throw 'call-process-done status))))))
148 (process-send-region proc 1
149 (1+ (buffer-size inbuf)) inbuf))
150 (process-send-eof proc)
152 ;; we're trying really really hard to emulate
153 ;; the old call-process.
155 (set-process-sentinel
157 `(lambda (proc status)
158 (write-region-internal
161 nil 'major-rms-kludge-city nil
162 coding-system-for-write))))
165 (throw 'call-process-done nil))
167 (accept-process-output proc)
168 (if display (sit-for 0))))
170 (with-current-buffer errbuf
171 (write-region-internal 1 (1+ (buffer-size)) stderr
172 nil 'major-rms-kludge-city nil
173 coding-system-for-write))))
174 (if proc (set-process-sentinel proc nil)))))
175 (if inbuf (kill-buffer inbuf))
176 (if errbuf (kill-buffer errbuf))
178 (if (and proc (process-live-p proc)) (kill-process proc))
181 (defun call-process (program &optional infile buffer displayp &rest args)
182 "Call PROGRAM synchronously in separate process.
183 The program's input comes from file INFILE (nil means `/dev/null').
184 Insert output in BUFFER before point; t means current buffer;
185 nil for BUFFER means discard it; 0 means discard and don't wait.
186 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
187 REAL-BUFFER says what to do with standard output, as above,
188 while STDERR-FILE says what to do with standard error in the child.
189 STDERR-FILE may be nil (discard standard error output),
190 t (mix it with ordinary output), or a file name string.
192 Fourth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
193 Remaining arguments are strings passed as command arguments to PROGRAM.
195 If BUFFER is 0, `call-process' returns immediately with value nil.
196 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
197 or a signal description string.
198 If you quit, the process is killed with SIGINT, or SIGKILL if you
200 (apply 'call-process-internal program infile buffer displayp args))
202 (defun call-process-region (start end program
203 &optional deletep buffer displayp
205 "Send text from START to END to a synchronous process running PROGRAM.
206 Delete the text if fourth arg DELETEP is non-nil.
208 Insert output in BUFFER before point; t means current buffer;
209 nil for BUFFER means discard it; 0 means discard and don't wait.
210 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
211 REAL-BUFFER says what to do with standard output, as above,
212 while STDERR-FILE says what to do with standard error in the child.
213 STDERR-FILE may be nil (discard standard error output),
214 t (mix it with ordinary output), or a file name string.
216 Sixth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
217 Remaining args are passed to PROGRAM at startup as command args.
219 If BUFFER is 0, returns immediately with value nil.
220 Otherwise waits for PROGRAM to terminate
221 and returns a numeric exit status or a signal description string.
222 If you quit, the process is first killed with SIGINT, then with SIGKILL if
223 you quit again before the process exits."
226 (concat (file-name-as-directory (temp-directory)) "emacs"))))
229 (write-region start end temp nil 'silent)
230 (if deletep (delete-region start end))
231 (apply #'call-process program temp buffer displayp args))
232 (ignore-file-errors (delete-file temp)))))
235 (defun shell-command (command &optional output-buffer)
236 "Execute string COMMAND in inferior shell; display output, if any.
238 If COMMAND ends in ampersand, execute it asynchronously.
239 The output appears in the buffer `*Async Shell Command*'.
240 That buffer is in shell mode.
242 Otherwise, COMMAND is executed synchronously. The output appears in the
243 buffer `*Shell Command Output*'.
244 If the output is one line, it is displayed in the echo area *as well*,
245 but it is nonetheless available in buffer `*Shell Command Output*',
246 even though that buffer is not automatically displayed.
247 If there is no output, or if output is inserted in the current buffer,
248 then `*Shell Command Output*' is deleted.
250 The optional second argument OUTPUT-BUFFER, if non-nil,
251 says to put the output in some other buffer.
252 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
253 If OUTPUT-BUFFER is not a buffer and not nil,
254 insert output in current buffer. (This cannot be done asynchronously.)
255 In either case, the output is inserted after point (leaving mark after it)."
256 (interactive (list (read-shell-command "Shell command: ")
258 (if (and output-buffer
259 (not (or (bufferp output-buffer) (stringp output-buffer))))
260 (progn (barf-if-buffer-read-only)
262 ;; We do not use -f for csh; we will not support broken use of
263 ;; .cshrcs. Even the BSD csh manual says to use
264 ;; "if ($?prompt) exit" before things which are not useful
265 ;; non-interactively. Besides, if someone wants their other
266 ;; aliases for shell commands then they can still have them.
267 (call-process shell-file-name nil t nil
268 shell-command-switch command)
269 (exchange-point-and-mark t))
270 ;; Preserve the match data in case called from a program.
272 (if (string-match "[ \t]*&[ \t]*$" command)
273 ;; Command ending with ampersand means asynchronous.
275 (background (substring command 0 (match-beginning 0))))
276 (shell-command-on-region (point) (point) command output-buffer)))))
278 ;; We have a sentinel to prevent insertion of a termination message
279 ;; in the buffer itself.
280 (defun shell-command-sentinel (process signal)
281 (if (memq (process-status process) '(exit signal))
283 (car (cdr (cdr (process-command process))))
284 (substring signal 0 -1))))
286 (defun shell-command-on-region (start end command
287 &optional output-buffer replace)
288 "Execute string COMMAND in inferior shell with region as input.
289 Normally display output (if any) in temp buffer `*Shell Command Output*';
290 Prefix arg means replace the region with it.
292 The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE.
293 If REPLACE is non-nil, that means insert the output
294 in place of text from START to END, putting point and mark around it.
296 If the output is one line, it is displayed in the echo area,
297 but it is nonetheless available in buffer `*Shell Command Output*'
298 even though that buffer is not automatically displayed.
299 If there is no output, or if output is inserted in the current buffer,
300 then `*Shell Command Output*' is deleted.
302 If the optional fourth argument OUTPUT-BUFFER is non-nil,
303 that says to put the output in some other buffer.
304 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
305 If OUTPUT-BUFFER is not a buffer and not nil,
306 insert output in the current buffer.
307 In either case, the output is inserted after point (leaving mark after it)."
308 (interactive (let ((string
309 ;; Do this before calling region-beginning
310 ;; and region-end, in case subprocess output
311 ;; relocates them while we are in the minibuffer.
312 (read-shell-command "Shell command on region: ")))
313 ;; call-interactively recognizes region-beginning and
314 ;; region-end specially, leaving them in the history.
315 (list (region-beginning) (region-end)
318 current-prefix-arg)))
321 (not (or (bufferp output-buffer) (stringp output-buffer)))))
322 ;; Replace specified region with output from command.
323 (let ((swap (and replace (< start end))))
324 ;; Don't muck with mark unless REPLACE says we should.
326 (and replace (push-mark))
327 (call-process-region start end shell-file-name t t nil
328 shell-command-switch command)
329 (let ((shell-buffer (get-buffer "*Shell Command Output*")))
330 (and shell-buffer (not (eq shell-buffer (current-buffer)))
331 (kill-buffer shell-buffer)))
332 ;; Don't muck with mark unless REPLACE says we should.
333 (and replace swap (exchange-point-and-mark t)))
334 ;; No prefix argument: put the output in a temp buffer,
335 ;; replacing its entire contents.
336 (let ((buffer (get-buffer-create
337 (or output-buffer "*Shell Command Output*")))
340 (directory default-directory))
342 (if (eq buffer (current-buffer))
343 ;; If the input is the same buffer as the output,
344 ;; delete everything but the specified region,
345 ;; then replace that region with the output.
346 (progn (setq buffer-read-only nil)
347 (delete-region (max start end) (point-max))
348 (delete-region (point-min) (max start end))
350 (call-process-region (point-min) (point-max)
351 shell-file-name t t nil
352 shell-command-switch command))
354 ;; Clear the output buffer,
355 ;; then run the command with output there.
358 (setq buffer-read-only nil)
360 (setq default-directory directory)
363 (call-process-region start end shell-file-name
365 shell-command-switch command))
367 ;; Report the amount of output.
368 (let ((lines (save-excursion
370 (if (= (buffer-size) 0)
372 (count-lines (point-min) (point-max))))))
377 (if (eql exit-status 0)
378 "(Shell command succeeded with no output)"
379 "(Shell command failed with no output)")))
380 (kill-buffer buffer))
381 ((and success (= lines 1))
385 (goto-char (point-min))
386 (buffer-substring (point)
390 (set-window-start (display-buffer buffer) 1))))))))
393 (defun start-process (name buffer program &rest program-args)
394 "Start a program in a subprocess. Return the process object for it.
395 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
396 NAME is name for process. It is modified if necessary to make it unique.
397 BUFFER is the buffer or (buffer-name) to associate with the process.
398 Process output goes at end of that buffer, unless you specify
399 an output stream or filter function to handle the output.
400 BUFFER may be also nil, meaning that this process is not associated
402 Third arg is program file name. It is searched for as in the shell.
403 Remaining arguments are strings to give program as arguments."
404 (apply 'start-process-internal name buffer program program-args))
406 (defun open-network-stream (name buffer host service &optional protocol)
407 "Open a TCP connection for a service to a host.
408 Returns a subprocess-object to represent the connection.
409 Input and output work as for subprocesses; `delete-process' closes it.
410 Args are NAME BUFFER HOST SERVICE.
411 NAME is name for process. It is modified if necessary to make it unique.
412 BUFFER is the buffer (or buffer-name) to associate with the process.
413 Process output goes at end of that buffer, unless you specify
414 an output stream or filter function to handle the output.
415 BUFFER may be also nil, meaning that this process is not associated
417 Third arg is name of the host to connect to, or its IP address.
418 Fourth arg SERVICE is name of the service desired, or an integer
419 specifying a port number to connect to.
420 Fifth argument PROTOCOL is a network protocol. Currently 'tcp
421 (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
422 supported. When omitted, 'tcp is assumed.
424 Output via `process-send-string' and input via buffer or filter (see
425 `set-process-filter') are stream-oriented. That means UDP datagrams are
426 not guaranteed to be sent and received in discrete packets. (But small
427 datagrams around 500 bytes that are not truncated by `process-send-string'
428 are usually fine.) Note further that UDP protocol does not guard against
430 (open-network-stream-internal name buffer host service protocol))
432 (defun shell-quote-argument (argument)
433 "Quote an argument for passing as argument to an inferior shell."
434 (if (and (eq system-type 'windows-nt)
435 (let ((progname (downcase (file-name-nondirectory
437 (or (equal progname "command.com")
438 (equal progname "cmd.exe"))))
439 ;; the expectation is that you can take the result of
440 ;; shell-quote-argument and pass it to as an arg to
441 ;; (start-process shell-quote-argument ...) and have it end
442 ;; up as-is in the program's argv[] array. to do this, we
443 ;; need to protect against both the shell's and the program's
444 ;; quoting conventions (and our own conventions in
445 ;; mswindows-construct-process-command-line!). Putting quotes
446 ;; around shell metachars gets through the last two, and applying
447 ;; the normal VC runtime quoting works with practically all apps.
448 (mswindows-quote-one-vc-runtime-arg argument t)
449 ;; Quote everything except POSIX filename characters.
450 ;; This should be safe enough even for really weird shells.
451 (let ((result "") (start 0) end)
452 (while (string-match "[^-0-9a-zA-Z_./]" argument start)
453 (setq end (match-beginning 0)
454 result (concat result (substring argument start end)
455 "\\" (substring argument end (1+ end)))
457 (concat result (substring argument start)))))
459 (defun shell-command-to-string (command)
460 "Execute shell command COMMAND and return its output as a string."
461 (with-output-to-string
462 (call-process shell-file-name nil t nil shell-command-switch command)))
464 (defalias 'exec-to-string 'shell-command-to-string)
466 ;;; process.el ends here
projects / chise / xemacs-chise.git.1 / blob