Mercurial > hg > xemacs-beta

comparison lisp/prim/process.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; process.el --- commands for subprocesses; split out of simple.el
2
3 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Ben Wing.
5
6 ;; This file is part of XEmacs.
7
8 ;; XEmacs is free software; you can redistribute it and/or modify it
9 ;; under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 2, or (at your option)
11 ;; any later version.
12
13 ;; XEmacs is distributed in the hope that it will be useful, but
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 ;; General Public License for more details.
17
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with XEmacs; see the file COPYING. If not, write to the Free
20 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
21
22 ;;; Synched up with: FSF 19.30.
23
24 ;;; Code:
25
26
27 (defvar shell-command-switch "-c"
28 "Switch used to have the shell execute its command line argument.")
29
30 (defun start-process-shell-command (name buffer &rest args)
31 "Start a program in a subprocess. Return the process object for it.
32 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
33 NAME is name for process. It is modified if necessary to make it unique.
34 BUFFER is the buffer or (buffer-name) to associate with the process.
35 Process output goes at end of that buffer, unless you specify
36 an output stream or filter function to handle the output.
37 BUFFER may be also nil, meaning that this process is not associated
38 with any buffer
39 Third arg is command name, the name of a shell command.
40 Remaining arguments are the arguments for the command.
41 Wildcards and redirection are handled as usual in the shell."
42 (cond
43 ((eq system-type 'vax-vms)
44 (apply 'start-process name buffer args))
45 ;; We used to use `exec' to replace the shell with the command,
46 ;; but that failed to handle (...) and semicolon, etc.
47 (t
48 (start-process name buffer shell-file-name shell-command-switch
49 (mapconcat 'identity args " ")))))
50
51 (defun call-process (program &optional infile buffer displayp &rest args)
52 "Call PROGRAM synchronously in separate process.
53 The program's input comes from file INFILE (nil means `/dev/null').
54 Insert output in BUFFER before point; t means current buffer;
55 nil for BUFFER means discard it; 0 means discard and don't wait.
56 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
57 REAL-BUFFER says what to do with standard output, as above,
58 while STDERR-FILE says what to do with standard error in the child.
59 STDERR-FILE may be nil (discard standard error output),
60 t (mix it with ordinary output), or a file name string.
61
62 Fourth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
63 Remaining arguments are strings passed as command arguments to PROGRAM.
64
65 If BUFFER is 0, `call-process' returns immediately with value nil.
66 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
67 or a signal description string.
68 If you quit, the process is killed with SIGINT, or SIGKILL if you
69 quit again."
70 (apply 'call-process-internal program infile buffer displayp args))
71
72 (defun call-process-region (start end program
73 &optional deletep buffer displayp
74 &rest args)
75 "Send text from START to END to a synchronous process running PROGRAM.
76 Delete the text if fourth arg DELETEP is non-nil.
77
78 Insert output in BUFFER before point; t means current buffer;
79 nil for BUFFER means discard it; 0 means discard and don't wait.
80 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
81 REAL-BUFFER says what to do with standard output, as above,
82 while STDERR-FILE says what to do with standard error in the child.
83 STDERR-FILE may be nil (discard standard error output),
84 t (mix it with ordinary output), or a file name string.
85
86 Sixth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
87 Remaining args are passed to PROGRAM at startup as command args.
88
89 If BUFFER is 0, returns immediately with value nil.
90 Otherwise waits for PROGRAM to terminate
91 and returns a numeric exit status or a signal description string.
92 If you quit, the process is first killed with SIGINT, then with SIGKILL if
93 you quit again before the process exits."
94 (let ((temp (cond ((eq system-type 'vax-vms)
95 (make-temp-name "tmp:emacs"))
96 ((or (eq system-type 'ms-dos)
97 (eq system-type 'windowsnt))
98 (make-temp-name
99 (concat (file-name-as-directory
100 (or (getenv "TMP")
101 (getenv "TEMP")
102 ""))
103 "em")))
104 (t
105 (make-temp-name "/tmp/emacs")))))
106 (unwind-protect
107 (progn
108 (if (or (eq system-type 'ms-dos)
109 (eq system-type 'windowsnt))
110 (let ((buffer-file-type binary-process-output))
111 (write-region start end temp nil 'silent))
112 (write-region start end temp nil 'silent))
113 (if deletep (delete-region start end))
114 (apply #'call-process program temp buffer displayp args))
115 (condition-case ()
116 (delete-file temp)
117 (file-error nil)))))
118
119
120 (defun shell-command (command &optional output-buffer)
121 "Execute string COMMAND in inferior shell; display output, if any.
122
123 If COMMAND ends in ampersand, execute it asynchronously.
124 The output appears in the buffer `*Async Shell Command*'.
125 That buffer is in shell mode.
126
127 Otherwise, COMMAND is executed synchronously. The output appears in the
128 buffer `*Shell Command Output*'.
129 If the output is one line, it is displayed in the echo area *as well*,
130 but it is nonetheless available in buffer `*Shell Command Output*',
131 even though that buffer is not automatically displayed.
132 If there is no output, or if output is inserted in the current buffer,
133 then `*Shell Command Output*' is deleted.
134
135 The optional second argument OUTPUT-BUFFER, if non-nil,
136 says to put the output in some other buffer.
137 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
138 If OUTPUT-BUFFER is not a buffer and not nil,
139 insert output in current buffer. (This cannot be done asynchronously.)
140 In either case, the output is inserted after point (leaving mark after it)."
141 (interactive (list (read-shell-command "Shell command: ")
142 current-prefix-arg))
143 (if (and output-buffer
144 (not (or (bufferp output-buffer) (stringp output-buffer))))
145 (progn (barf-if-buffer-read-only)
146 (push-mark)
147 ;; We do not use -f for csh; we will not support broken use of
148 ;; .cshrcs. Even the BSD csh manual says to use
149 ;; "if ($?prompt) exit" before things which are not useful
150 ;; non-interactively. Besides, if someone wants their other
151 ;; aliases for shell commands then they can still have them.
152 (call-process shell-file-name nil t nil
153 shell-command-switch command)
154 (exchange-point-and-mark t))
155 ;; Preserve the match data in case called from a program.
156 (save-match-data
157 (if (string-match "[ \t]*&[ \t]*$" command)
158 ;; Command ending with ampersand means asynchronous.
159 (progn
160 (require 'background) ; whizzy comint background code
161 (background (substring command 0 (match-beginning 0))))
162 (shell-command-on-region (point) (point) command nil)))))
163
164 ;; We have a sentinel to prevent insertion of a termination message
165 ;; in the buffer itself.
166 (defun shell-command-sentinel (process signal)
167 (if (memq (process-status process) '(exit signal))
168 (message "%s: %s."
169 (car (cdr (cdr (process-command process))))
170 (substring signal 0 -1))))
171
172 (defun shell-command-on-region (start end command
173 &optional output-buffer replace)
174 "Execute string COMMAND in inferior shell with region as input.
175 Normally display output (if any) in temp buffer `*Shell Command Output*';
176 Prefix arg means replace the region with it.
177
178 The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE.
179 If REPLACE is non-nil, that means insert the output
180 in place of text from START to END, putting point and mark around it.
181
182 If the output is one line, it is displayed in the echo area,
183 but it is nonetheless available in buffer `*Shell Command Output*'
184 even though that buffer is not automatically displayed.
185 If there is no output, or if output is inserted in the current buffer,
186 then `*Shell Command Output*' is deleted.
187
188 If the optional fourth argument OUTPUT-BUFFER is non-nil,
189 that says to put the output in some other buffer.
190 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
191 If OUTPUT-BUFFER is not a buffer and not nil,
192 insert output in the current buffer.
193 In either case, the output is inserted after point (leaving mark after it)."
194 (interactive (if (not (region-exists-p))
195 (error "The region is not active now")
196 (let ((string
197 ;; Do this before calling region-beginning
198 ;; and region-end, in case subprocess output
199 ;; relocates them while we are in the minibuffer.
200 (read-shell-command "Shell command on region: ")))
201 ;; call-interactively recognizes region-beginning and
202 ;; region-end specially, leaving them in the history.
203 (list (region-beginning) (region-end)
204 string
205 current-prefix-arg
206 current-prefix-arg))))
207 (if (or replace
208 (and output-buffer
209 (not (or (bufferp output-buffer) (stringp output-buffer)))))
210 ;; Replace specified region with output from command.
211 (let ((swap (and replace (< start end))))
212 ;; Don't muck with mark unless REPLACE says we should.
213 (goto-char start)
214 (and replace (push-mark))
215 (call-process-region start end shell-file-name t t nil
216 shell-command-switch command)
217 (let ((shell-buffer (get-buffer "*Shell Command Output*")))
218 (and shell-buffer (not (eq shell-buffer (current-buffer)))
219 (kill-buffer shell-buffer)))
220 ;; Don't muck with mark unless REPLACE says we should.
221 (and replace swap (exchange-point-and-mark t)))
222 ;; No prefix argument: put the output in a temp buffer,
223 ;; replacing its entire contents.
224 (let ((buffer (get-buffer-create
225 (or output-buffer "*Shell Command Output*")))
226 (success nil)
227 (directory default-directory))
228 (unwind-protect
229 (if (eq buffer (current-buffer))
230 ;; If the input is the same buffer as the output,
231 ;; delete everything but the specified region,
232 ;; then replace that region with the output.
233 (progn (setq buffer-read-only nil)
234 (delete-region (max start end) (point-max))
235 (delete-region (point-min) (max start end))
236 (call-process-region (point-min) (point-max)
237 shell-file-name t t nil
238 shell-command-switch command)
239 (setq success t))
240 ;; Clear the output buffer,
241 ;; then run the command with output there.
242 (save-excursion
243 (set-buffer buffer)
244 (setq buffer-read-only nil)
245 ;; XEmacs change
246 (setq default-directory directory)
247 (erase-buffer))
248 (call-process-region start end shell-file-name
249 nil buffer nil
250 shell-command-switch command)
251 (setq success t))
252 ;; Report the amount of output.
253 (let ((lines (save-excursion
254 (set-buffer buffer)
255 (if (= (buffer-size) 0)
256 0
257 (count-lines (point-min) (point-max))))))
258 (cond ((= lines 0)
259 (if success
260 (message
261 "(Shell command completed with no output)"))
262 (kill-buffer buffer))
263 ((and success (= lines 1))
264 (message "%s"
265 (save-excursion
266 (set-buffer buffer)
267 (goto-char (point-min))
268 (buffer-substring (point)
269 (progn (end-of-line)
270 (point))))))
271 (t
272 (set-window-start (display-buffer buffer) 1))))))))
273
274
275 (defun start-process (name buffer program &rest program-args)
276 "Start a program in a subprocess. Return the process object for it.
277 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
278 NAME is name for process. It is modified if necessary to make it unique.
279 BUFFER is the buffer or (buffer-name) to associate with the process.
280 Process output goes at end of that buffer, unless you specify
281 an output stream or filter function to handle the output.
282 BUFFER may be also nil, meaning that this process is not associated
283 with any buffer
284 Third arg is program file name. It is searched for as in the shell.
285 Remaining arguments are strings to give program as arguments.
286 INCODE and OUTCODE specify the coding-system objects used in input/output
287 from/to the process."
288 (apply 'start-process-internal name buffer program program-args))
289
290 (defun open-network-stream (name buffer host service)
291 "Open a TCP connection for a service to a host.
292 Returns a subprocess-object to represent the connection.
293 Input and output work as for subprocesses; `delete-process' closes it.
294 Args are NAME BUFFER HOST SERVICE.
295 NAME is name for process. It is modified if necessary to make it unique.
296 BUFFER is the buffer (or buffer-name) to associate with the process.
297 Process output goes at end of that buffer, unless you specify
298 an output stream or filter function to handle the output.
299 BUFFER may be also nil, meaning that this process is not associated
300 with any buffer
301 Third arg is name of the host to connect to, or its IP address.
302 Fourth arg SERVICE is name of the service desired, or an integer
303 specifying a port number to connect to."
304 (open-network-stream-internal name buffer host service))
305
306 (defun shell-quote-argument (argument)
307 "Quote an argument for passing as argument to an inferior shell."
308 (if (eq system-type 'ms-dos)
309 ;; MS-DOS shells don't have quoting, so don't do any.
310 argument
311 (if (eq system-type 'windows-nt)
312 (concat "\"" argument "\"")
313 ;; Quote everything except POSIX filename characters.
314 ;; This should be safe enough even for really weird shells.
315 (let ((result "") (start 0) end)
316 (while (string-match "[^-0-9a-zA-Z_./]" argument start)
317 (setq end (match-beginning 0)
318 result (concat result (substring argument start end)
319 "\\" (substring argument end (1+ end)))
320 start (1+ end)))
321 (concat result (substring argument start))))))
322
323 (defun exec-to-string (command)
324 "Execute COMMAND as an external process and return the output of that
325 process as a string"
326 ;; by "William G. Dubuque" <wgd@zurich.ai.mit.edu>
327 (with-output-to-string
328 (call-process shell-file-name nil t nil "-c" command)))