Fix crash when using ffmpeg to play mp3 and ogg
[sxemacs] / lisp / process.el
1 ;;; process.el --- commands for subprocesses; split out of simple.el
2
3 ;; Copyright (C) 1985-7, 1993,4, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 2000 Ben Wing.
5
6 ;; Author: Ben Wing
7 ;; Maintainer: SXEmacs Development Team
8 ;; Keywords: internal, processes, dumped
9
10 ;; This file is part of SXEmacs.
11
12 ;; SXEmacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
16
17 ;; SXEmacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
24
25 ;;; Synched up with: FSF 19.30.
26
27 ;;; Authorship:
28
29 ;; Created 1995 by Ben Wing during Mule work -- some commands split out
30 ;; of simple.el and wrappers of *-internal functions created so they could
31 ;; be redefined in a Mule world.
32 ;; Lisp definition of call-process-internal added Mar. 2000 by Ben Wing.
33
34 ;;; Commentary:
35
36 ;; This file is dumped with SXEmacs.
37
38 ;;; Code:
39
40 \f
41 (defgroup processes nil
42   "Process, subshell, compilation, and job control support."
43   :group 'external
44   :group 'development)
45
46 (defgroup processes-basics nil
47   "Basic stuff dealing with processes."
48   :group 'processes)
49
50 (defgroup execute nil
51   "Executing external commands."
52   :group 'processes)
53
54 (defvar shell-command-switch "-c"
55   "Switch used to have the shell execute its command line argument.")
56
57 (defun start-process-shell-command (name buffer &rest args)
58   "Start a program in a subprocess.  Return the process object for it.
59 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
60 NAME is name for process.  It is modified if necessary to make it unique.
61 BUFFER is the buffer or (buffer-name) to associate with the process.
62  Process output goes at end of that buffer, unless you specify
63  an output stream or filter function to handle the output.
64  BUFFER may be also nil, meaning that this process is not associated
65  with any buffer
66 Third arg is command name, the name of a shell command.
67 Remaining arguments are the arguments for the command.
68 Wildcards and redirection are handled as usual in the shell."
69   ;; We used to use `exec' to replace the shell with the command,
70   ;; but that failed to handle (...) and semicolon, etc.
71   (start-process name buffer shell-file-name shell-command-switch
72                  (mapconcat #'identity args " ")))
73
74 (defun call-process-internal (program &optional infile buffer display &rest args)
75   "Call PROGRAM synchronously in separate process, with coding-system specified.
76 Arguments are
77  (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS).
78 The program's input comes from file INFILE (nil means `/dev/null').
79 Insert output in BUFFER before point; t means current buffer;
80  nil for BUFFER means discard it; 0 means discard and don't wait.
81 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
82 REAL-BUFFER says what to do with standard output, as above,
83 while STDERR-FILE says what to do with standard error in the child.
84 STDERR-FILE may be nil (discard standard error output),
85 t (mix it with ordinary output), or a file name string.
86
87 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
88 Remaining arguments are strings passed as command arguments to PROGRAM.
89
90 If BUFFER is 0, `call-process' returns immediately with value nil.
91 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
92  or a signal description string.
93 If you quit, the process is killed with SIGINT, or SIGKILL if you
94  quit again."
95   ;; #### remove windows-nt check when this is ready for prime time.
96   (if (or (noninteractive) t)
97       (apply 'old-call-process-internal program infile buffer display args)
98     (let (proc inbuf errbuf discard)
99       (unwind-protect
100           (progn
101             (when infile
102               (setq infile (expand-file-name infile))
103               (setq inbuf (generate-new-buffer "*call-process*"))
104               (with-current-buffer inbuf
105                ;; Make sure this works with jka-compr
106                (let ((file-name-handler-alist nil))
107                  (insert-file-contents-internal infile nil nil nil nil
108                                                 'binary))))
109             (let ((stderr (if (consp buffer) (second buffer) t)))
110               (if (consp buffer) (setq buffer (car buffer)))
111               (setq buffer
112                     (cond ((null buffer) nil)
113                           ((eq buffer t) (current-buffer))
114                           ;; use integerp for compatibility with existing
115                           ;; call-process rmsism.
116                           ((integerp buffer) (setq discard t) nil)
117                           (t (get-buffer-create buffer))))
118               (when (and stderr (not (eq t stderr)))
119                 (setq stderr (expand-file-name stderr))
120                 (setq errbuf (generate-new-buffer "*call-process*")))
121               ;; We read INFILE using the binary coding-system.
122               ;; We must feed the process using the same coding-system, so
123               ;; that it really receives the contents of INFILE.
124               (let ((coding-system-for-write 'binary))
125                 (setq proc
126                       (apply 'start-process-internal "*call-process*"
127                              buffer
128                              ;#### not implemented until my new process
129                              ;changes go in.
130                              ;(if (eq t stderr) buffer (list buffer errbuf))
131                              program args)))
132               (if buffer
133                   (set-marker (process-mark proc) (point buffer) buffer))
134               (unwind-protect
135                   (prog1
136                     (catch 'call-process-done
137                       (when (not discard)
138                         (set-process-sentinel
139                          proc
140                          #'(lambda (proc status)
141                              (cond ((eq 'exit (process-status proc))
142                                     (set-process-sentinel proc nil)
143                                     (throw 'call-process-done
144                                            (process-exit-status proc)))
145                                    ((eq 'signal (process-status proc))
146                                     (set-process-sentinel proc nil)
147                                     (throw 'call-process-done status))))))
148                       (when inbuf
149                         (process-send-region proc 1
150                                              (1+ (buffer-size inbuf)) inbuf))
151                       (process-send-eof proc)
152                       (when discard
153                         ;; we're trying really really hard to emulate
154                         ;; the old call-process.
155                         (if errbuf
156                             (set-process-sentinel
157                              proc
158                              `(lambda (proc status)
159                                 (write-region-internal
160                                  1 (1+ (buffer-size))
161                                  ,stderr
162                                  nil 'major-rms-kludge-city nil
163                                  coding-system-for-write))))
164                         (setq errbuf nil)
165                         (setq proc nil)
166                         (throw 'call-process-done nil))
167                       (while t
168                         (accept-process-output proc)
169                         (if display (sit-for 0))))
170                     (when errbuf
171                       (with-current-buffer errbuf
172                         (write-region-internal 1 (1+ (buffer-size)) stderr
173                                                nil 'major-rms-kludge-city nil
174                                                coding-system-for-write))))
175                 (if proc (set-process-sentinel proc nil)))))
176         (if inbuf (kill-buffer inbuf))
177         (if errbuf (kill-buffer errbuf))
178         (condition-case nil
179             (if (and proc (process-live-p proc)) (kill-process proc))
180           (error nil))))))
181
182 (defun call-process (program &optional infile buffer displayp &rest args)
183   "Call PROGRAM synchronously in separate process.
184 The program's input comes from file INFILE (nil means `/dev/null').
185 Insert output in BUFFER before point; t means current buffer;
186  nil for BUFFER means discard it; 0 means discard and don't wait.
187 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
188 REAL-BUFFER says what to do with standard output, as above,
189 while STDERR-FILE says what to do with standard error in the child.
190 STDERR-FILE may be nil (discard standard error output),
191 t (mix it with ordinary output), or a file name string.
192
193 Fourth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
194 Remaining arguments are strings passed as command arguments to PROGRAM.
195
196 If BUFFER is 0, `call-process' returns immediately with value nil.
197 Otherwise it waits for PROGRAM to terminate and returns a numeric exit status
198  or a signal description string.
199 If you quit, the process is killed with SIGINT, or SIGKILL if you
200  quit again."
201   (apply 'call-process-internal program infile buffer displayp args))
202
203 (defun call-process-region (start end program
204                             &optional deletep buffer displayp
205                             &rest args)
206   "Send text from START to END to a synchronous process running PROGRAM.
207 Delete the text if fourth arg DELETEP is non-nil.
208
209 Insert output in BUFFER before point; t means current buffer;
210  nil for BUFFER means discard it; 0 means discard and don't wait.
211 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
212 REAL-BUFFER says what to do with standard output, as above,
213 while STDERR-FILE says what to do with standard error in the child.
214 STDERR-FILE may be nil (discard standard error output),
215 t (mix it with ordinary output), or a file name string.
216
217 Sixth arg DISPLAYP non-nil means redisplay buffer as output is inserted.
218 Remaining args are passed to PROGRAM at startup as command args.
219
220 If BUFFER is 0, returns immediately with value nil.
221 Otherwise waits for PROGRAM to terminate
222 and returns a numeric exit status or a signal description string.
223 If you quit, the process is first killed with SIGINT, then with SIGKILL if
224 you quit again before the process exits."
225   (let ((temp
226          (make-temp-name
227           (concat (file-name-as-directory (temp-directory)) "emacs"))))
228     (unwind-protect
229         (progn
230           (write-region start end temp nil 'silent)
231           (if deletep (delete-region start end))
232           (apply #'call-process program temp buffer displayp args))
233       (ignore-file-errors (delete-file temp)))))
234
235 \f
236 (defun shell-command (command &optional output-buffer)
237   "Execute string COMMAND in inferior shell; display output, if any.
238
239 If COMMAND ends in ampersand, execute it asynchronously.
240 The output appears in the buffer `*Async Shell Command*'.
241 That buffer is in shell mode.
242
243 Otherwise, COMMAND is executed synchronously.  The output appears in the
244 buffer `*Shell Command Output*'.
245 If the output is one line, it is displayed in the echo area *as well*,
246 but it is nonetheless available in buffer `*Shell Command Output*',
247 even though that buffer is not automatically displayed.
248 If there is no output, or if output is inserted in the current buffer,
249 then `*Shell Command Output*' is deleted.
250
251 The optional second argument OUTPUT-BUFFER, if non-nil,
252 says to put the output in some other buffer.
253 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
254 If OUTPUT-BUFFER is not a buffer and not nil,
255 insert output in current buffer.  (This cannot be done asynchronously.)
256 In either case, the output is inserted after point (leaving mark after it)."
257   (interactive (list (read-shell-command "Shell command: ")
258                      current-prefix-arg))
259   (if (and output-buffer
260            (not (or (bufferp output-buffer)  (stringp output-buffer))))
261       (progn (barf-if-buffer-read-only)
262              (push-mark nil (not (interactive-p)))
263              ;; We do not use -f for csh; we will not support broken use of
264              ;; .cshrcs.  Even the BSD csh manual says to use
265              ;; "if ($?prompt) exit" before things which are not useful
266              ;; non-interactively.  Besides, if someone wants their other
267              ;; aliases for shell commands then they can still have them.
268              (call-process shell-file-name nil t nil
269                            shell-command-switch command)
270              (exchange-point-and-mark t))
271     ;; Preserve the match data in case called from a program.
272     (save-match-data
273       (if (string-match "[ \t]*&[ \t]*$" command)
274           ;; Command ending with ampersand means asynchronous.
275           (progn
276             (if-fboundp 'background
277                 (background (substring command 0 (match-beginning 0))
278                             output-buffer)
279               (error
280                'unimplemented
281                "backgrounding a shell command requires package `background'")))
282
283         (shell-command-on-region (point) (point) command output-buffer)))))
284
285 ;; We have a sentinel to prevent insertion of a termination message
286 ;; in the buffer itself.
287 (defun shell-command-sentinel (process signal)
288   (if (memq (process-status process) '(exit signal))
289       (message "%s: %s."
290                (car (cdr (cdr (process-command process))))
291                (substring signal 0 -1))))
292
293 (defun shell-command-on-region (start end command
294                                       &optional output-buffer replace)
295   "Execute string COMMAND in inferior shell with region as input.
296 Normally display output (if any) in temp buffer `*Shell Command Output*';
297 Prefix arg means replace the region with it.
298
299 The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE.
300 If REPLACE is non-nil, that means insert the output
301 in place of text from START to END, putting point and mark around it.
302
303 If the output is one line, it is displayed in the echo area,
304 but it is nonetheless available in buffer `*Shell Command Output*'
305 even though that buffer is not automatically displayed.
306 If there is no output, or if output is inserted in the current buffer,
307 then `*Shell Command Output*' is deleted.
308
309 If the optional fourth argument OUTPUT-BUFFER is non-nil,
310 that says to put the output in some other buffer.
311 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
312 If OUTPUT-BUFFER is not a buffer and not nil,
313 insert output in the current buffer.
314 In either case, the output is inserted after point (leaving mark after it)."
315   (interactive (let ((string
316                       ;; Do this before calling region-beginning
317                       ;; and region-end, in case subprocess output
318                       ;; relocates them while we are in the minibuffer.
319                       (read-shell-command "Shell command on region: ")))
320                  ;; call-interactively recognizes region-beginning and
321                  ;; region-end specially, leaving them in the history.
322                  (list (region-beginning) (region-end)
323                        string
324                        current-prefix-arg
325                        current-prefix-arg)))
326   (if (or replace
327           (and output-buffer
328                (not (or (bufferp output-buffer) (stringp output-buffer)))))
329       ;; Replace specified region with output from command.
330       (let ((swap (and replace (< start end))))
331         ;; Don't muck with mark unless REPLACE says we should.
332         (goto-char start)
333         (and replace (push-mark))
334         (call-process-region start end shell-file-name t t nil
335                              shell-command-switch command)
336         (let ((shell-buffer (get-buffer "*Shell Command Output*")))
337           (and shell-buffer (not (eq shell-buffer (current-buffer)))
338                (kill-buffer shell-buffer)))
339         ;; Don't muck with mark unless REPLACE says we should.
340         (and replace swap (exchange-point-and-mark t)))
341       ;; No prefix argument: put the output in a temp buffer,
342       ;; replacing its entire contents.
343     (let ((buffer (get-buffer-create
344                    (or output-buffer "*Shell Command Output*")))
345           (success nil)
346           (exit-status nil)
347           (directory default-directory))
348       (unwind-protect
349           (if (eq buffer (current-buffer))
350               ;; If the input is the same buffer as the output,
351               ;; delete everything but the specified region,
352               ;; then replace that region with the output.
353               (progn (setq buffer-read-only nil)
354                      (delete-region (max start end) (point-max))
355                      (delete-region (point-min) (min start end))
356                      (setq exit-status
357                            (call-process-region (point-min) (point-max)
358                                                 shell-file-name t t nil
359                                                 shell-command-switch command))
360                      (setq success t))
361             ;; Clear the output buffer,
362             ;; then run the command with output there.
363             (save-excursion
364               (set-buffer buffer)
365               (setq buffer-read-only nil)
366               ;; XEmacs change
367               (setq default-directory directory)
368               (erase-buffer))
369             (setq exit-status
370                   (call-process-region start end shell-file-name
371                                        nil buffer nil
372                                        shell-command-switch command))
373             (setq success t))
374         ;; Report the amount of output.
375         (let ((lines (save-excursion
376                        (set-buffer buffer)
377                        (if (= (buffer-size) 0)
378                            0
379                          (count-lines (point-min) (point-max))))))
380           (cond ((= lines 0)
381                  (if success
382                      (display-message
383                       'command
384                       (if (eql exit-status 0)
385                           "(Shell command succeeded with no output)"
386                         "(Shell command failed with no output)")))
387                  (kill-buffer buffer))
388                 ((and success (= lines 1))
389                  (message "%s"
390                           (save-excursion
391                             (set-buffer buffer)
392                             (goto-char (point-min))
393                             (buffer-substring (point)
394                                               (progn (end-of-line)
395                                                      (point))))))
396                 (t
397                  (set-window-start (display-buffer buffer) 1))))))))
398
399 \f
400 (defun start-process (name buffer program &rest program-args)
401   "Start a program in a subprocess.  Return the process object for it.
402 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
403 NAME is name for process.  It is modified if necessary to make it unique.
404 BUFFER is the buffer or (buffer-name) to associate with the process.
405  Process output goes at end of that buffer, unless you specify
406  an output stream or filter function to handle the output.
407  BUFFER may be also nil, meaning that this process is not associated
408  with any buffer
409 Third arg is program file name.  It is searched for as in the shell.
410 Remaining arguments are strings to give program as arguments."
411   (apply 'start-process-internal name buffer program program-args))
412
413 (defun open-network-stream (name buffer host service &optional protocol)
414   "Open a TCP connection for a service to a host.
415 Returns a process object to represent the connection.
416 Input and output work as for subprocesses; `delete-process' closes it.
417 Args are NAME BUFFER HOST SERVICE &optional PROTOCOL.
418 NAME is name for process.  It is modified if necessary to make it unique.
419 BUFFER is the buffer (or buffer-name) to associate with the process.
420  Process output goes at end of that buffer, unless you specify
421  an output stream or filter function to handle the output.
422  BUFFER may be also nil, meaning that this process is not associated
423  with any buffer
424 Third arg is name of the host to connect to, or its IP address.
425 Fourth arg SERVICE is name of the service desired, or an integer
426  specifying a port number to connect to.
427 Fifth argument PROTOCOL is a network protocol.  Currently 'tcp
428  (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
429  supported.  When omitted, 'tcp is assumed.
430
431 Output via `process-send-string' and input via buffer or filter (see
432 `set-process-filter') are stream-oriented.  That means UDP datagrams are
433 not guaranteed to be sent and received in discrete packets. (But small
434 datagrams around 500 bytes that are not truncated by `process-send-string'
435 are usually fine.)  Note further that UDP protocol does not guard against
436 lost packets."
437   (open-network-stream-internal name buffer host service protocol))
438
439 (defun open-network-server-stream
440   (name buffer host service &optional
441         protocol acceptor filter sentinel)
442   "Returns a process object to represent the listening connection. When a
443 new connection request arrives, it is automatically accepted. A
444 network-stream process is automatically created for that
445 connection. If needed a new buffer is also created. If given the
446 acceptor function is called. If defined filter and sentinel are set
447 for the new connection process .
448
449 Input and output work as for subprocesses; `delete-process' closes it.
450
451 Args are NAME BUFFER HOST SERVICE &optional PROTOCOL ACCEPTOR .
452
453 NAME is name for process.  It is modified if necessary to make it
454 unique.
455
456 BUFFER is the buffer (or buffer-name) to associate with the process.
457  Listening Process output goes at end of that buffer, unless you
458  specify an output stream or filter function to handle the output. No
459  real process output of listening process is expected. However the
460  name of this buffer will be used as a base for generating a new
461  buffer name for the accepted connections.
462  The BUFFER may be also nil, meaning that this process is not
463  associated with any buffer. In this case a filter should be specified
464  otherwise there will be no way to retrieve the process output.
465  BUFFER may also be 'auto in which case a buffer is automatically
466  created for the accepted connection.
467
468 Third arg HOST (a string) is the name of the IP to bind to, or its
469  IP address, If nil or ip_any will bind to all addresses on the
470  machine. When HOST is 'localhost listening connection will listen
471  to connections from the local machine only.
472 Fourth arg SERVICE is name of the service desired, or an integer
473  specifying a port number to connect to.
474 Fifth argument PROTOCOL is a network protocol.  Currently 'tcp
475  (Transmission Control Protocol) and 'udp (User Datagram Protocol) are
476  supported.  When omitted, 'tcp is assumed.
477 Sixt argument ACCEPTOR is a function which will be called upon connection
478  acceptance with the accepted connection process as the single argument.
479 Seventh argument FILTER is a function which will be set as filter for
480  the accepted connections automatically. See `set-process-filter' for
481  more details.
482 Eight argument SENTINEL is a function which will be set as sentinel
483  the accepted connections automatically. see `set-process-sentinel'
484  for more details.
485
486 Output via `process-send-string' and input via buffer or filter (see
487 `set-process-filter') are stream-oriented.  That means UDP datagrams are
488 not guaranteed to be sent and received in discrete packets. (But small
489 datagrams around 500 bytes that are not truncated by `process-send-string'
490 are usually fine.)  Note further that UDP protocol does not guard against
491 lost packets.
492
493 In the ACCEPTOR you can use `network-process-listener' to get the original
494 listen process, and `process-buffer' to retrieve the associated
495 buffers. If sentinels and/or filters are set in the ACCEPTOR they
496 will override the FILTER and SENTINEL args to this function.
497 "
498   (open-network-server-stream-internal name buffer host service
499                                        protocol acceptor filter sentinel))
500
501 (defun shell-quote-argument (argument)
502   "Quote an argument for passing as argument to an inferior shell."
503   (if (equal argument "")
504       "\"\""
505     ;; Quote everything except POSIX filename characters.
506     ;; This should be safe enough even for really weird shells.
507     (let ((result "") (start 0) end)
508       (while (string-match "[^-0-9a-zA-Z_./]" argument start)
509         (setq end (match-beginning 0)
510               result (concat result (substring argument start end)
511                              "\\" (substring argument end (1+ end)))
512               start (1+ end)))
513       (concat result (substring argument start)))))
514
515 (defun shell-command-to-string (command)
516   "Execute shell command COMMAND and return its output as a string."
517   (with-output-to-string
518     (with-current-buffer standard-output
519       (call-process shell-file-name nil t nil shell-command-switch command))))
520
521 (defalias 'exec-to-string 'shell-command-to-string)
522
523 ;;; process.el ends here