Mercurial > hg > xemacs-beta

comparison lisp/process.el @ 406:b8cc9ab3f761 r21-2-33

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-33
author cvs
date Mon, 13 Aug 2007 11:17:09 +0200
parents 74fd4e045ea6
children 501cfd01ee6d
comparison
equal deleted inserted replaced
405:0e08f63c74d2 406:b8cc9ab3f761
1 ;;; process.el --- commands for subprocesses; split out of simple.el 1 ;;; process.el --- commands for subprocesses; split out of simple.el
2 2
3 ;; Copyright (C) 1985-7, 1993,4, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985-7, 1993,4, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Ben Wing. 4 ;; Copyright (C) 1995, 2000 Ben Wing.
5 5
6 ;; Author: Ben Wing 6 ;; Author: Ben Wing
7 ;; Maintainer: XEmacs Development Team 7 ;; Maintainer: XEmacs Development Team
8 ;; Keywords: internal, processes, dumped 8 ;; Keywords: internal, processes, dumped
9 9
23 ;; along with XEmacs; see the file COPYING. If not, write to the 23 ;; along with XEmacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, 59 Temple Place - Suite 330, 24 ;; Free Software Foundation, 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA. 25 ;; Boston, MA 02111-1307, USA.
26 26
27 ;;; Synched up with: FSF 19.30. 27 ;;; Synched up with: FSF 19.30.
28
29 ;;; Authorship:
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.
28 35
29 ;;; Commentary: 36 ;;; Commentary:
30 37
31 ;; This file is dumped with XEmacs. 38 ;; This file is dumped with XEmacs.
32 39
64 Wildcards and redirection are handled as usual in the shell." 71 Wildcards and redirection are handled as usual in the shell."
65 ;; We used to use `exec' to replace the shell with the command, 72 ;; We used to use `exec' to replace the shell with the command,
66 ;; but that failed to handle (...) and semicolon, etc. 73 ;; but that failed to handle (...) and semicolon, etc.
67 (start-process name buffer shell-file-name shell-command-switch 74 (start-process name buffer shell-file-name shell-command-switch
68 (mapconcat #'identity args " "))) 75 (mapconcat #'identity args " ")))
76
77 (defun call-process-internal (program &optional infile buffer display &rest args)
78 "Call PROGRAM synchronously in separate process, with coding-system specified.
79 Arguments are
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.
89
90 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
91 Remaining arguments are strings passed as command arguments to PROGRAM.
92
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
97 quit again."
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)
102 (unwind-protect
103 (progn
104 (when infile
105 (setq infile (expand-file-name infile))
106 (setq inbuf (generate-new-buffer "*call-process*"))
107 (with-current-buffer inbuf
108 (insert-file-contents-internal infile nil nil nil nil
109 coding-system-for-read)))
110 (let ((stderr (if (consp buffer) (second buffer) t)))
111 (if (consp buffer) (setq buffer (car buffer)))
112 (setq buffer
113 (cond ((null buffer) nil)
114 ((eq buffer t) (current-buffer))
115 ;; use integerp for compatibility with existing
116 ;; call-process rmsism.
117 ((integerp buffer) (setq discard t) nil)
118 (t (get-buffer-create buffer))))
119 (when (and stderr (not (eq t stderr)))
120 (setq stderr (expand-file-name stderr))
121 (setq errbuf (generate-new-buffer "*call-process*")))
122 (setq proc
123 (apply 'start-process-internal "*call-process*"
124 buffer
125 ;#### not implemented until my new process
126 ;changes go in.
127 ;(if (eq t stderr) buffer (list buffer errbuf))
128 program args))
129 (if buffer
130 (set-marker (process-mark proc) (point buffer) buffer))
131 (unwind-protect
132 (progn
133 (catch 'call-process-done
134 (when (not discard)
135 (set-process-sentinel
136 proc
137 #'(lambda (proc status)
138 (cond ((eq 'exit (process-status proc))
139 (set-process-sentinel proc nil)
140 (throw 'call-process-done
141 (process-exit-status proc)))
142 ((eq 'signal (process-status proc))
143 (set-process-sentinel proc nil)
144 (throw 'call-process-done status))))))
145 (when inbuf
146 (process-send-region proc 1
147 (1+ (buffer-size inbuf)) inbuf))
148 (process-send-eof proc)
149 (when discard
150 ;; we're trying really really hard to emulate
151 ;; the old call-process.
152 (if errbuf
153 (set-process-sentinel
154 proc
155 `(lambda (proc status)
156 (write-region-internal
157 1 (1+ (buffer-size))
158 ,stderr
159 nil 'major-rms-kludge-city nil
160 coding-system-for-write))))
161 (setq errbuf nil)
162 (setq proc nil)
163 (throw 'call-process-done nil))
164 (while t
165 (accept-process-output proc)
166 (if display (sit-for 0))))
167 (when errbuf
168 (with-current-buffer errbuf
169 (write-region-internal 1 (1+ (buffer-size)) stderr
170 nil 'major-rms-kludge-city nil
171 coding-system-for-write))))
172 (if proc (set-process-sentinel proc nil)))))
173 (if inbuf (kill-buffer inbuf))
174 (if errbuf (kill-buffer errbuf))
175 (condition-case nil
176 (if (and proc (process-live-p proc)) (kill-process proc))
177 (error nil))))))
69 178
70 (defun call-process (program &optional infile buffer displayp &rest args) 179 (defun call-process (program &optional infile buffer displayp &rest args)
71 "Call PROGRAM synchronously in separate process. 180 "Call PROGRAM synchronously in separate process.
72 The program's input comes from file INFILE (nil means `/dev/null'). 181 The program's input comes from file INFILE (nil means `/dev/null').
73 Insert output in BUFFER before point; t means current buffer; 182 Insert output in BUFFER before point; t means current buffer;