Mercurial > hg > xemacs-beta

comparison lisp/code-process.el @ 380:8626e4521993 r21-2-5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-5
author cvs
date Mon, 13 Aug 2007 11:07:10 +0200
parents cc15677e0335
children 74fd4e045ea6
comparison
equal deleted inserted replaced
379:76b7d63099ad 380:8626e4521993
27 ;; along with XEmacs; see the file COPYING. If not, write to the Free 27 ;; along with XEmacs; see the file COPYING. If not, write to the Free
28 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 28 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
29 ;; 02111-1307, USA. 29 ;; 02111-1307, USA.
30 30
31 ;;; Code: 31 ;;; Code:
32
33 (eval-when-compile
34 (defvar buffer-file-type)
35 (defvar binary-process-output))
32 36
33 (defvar process-coding-system-alist nil 37 (defvar process-coding-system-alist nil
34 "Alist to decide a coding system to use for a process I/O operation. 38 "Alist to decide a coding system to use for a process I/O operation.
35 The format is ((PATTERN . VAL) ...), 39 The format is ((PATTERN . VAL) ...),
36 where PATTERN is a regular expression matching a program name, 40 where PATTERN is a regular expression matching a program name,
64 (let* ((coding-system-for-read 68 (let* ((coding-system-for-read
65 (or coding-system-for-read 69 (or coding-system-for-read
66 (let (ret) 70 (let (ret)
67 (catch 'found 71 (catch 'found
68 (let ((alist process-coding-system-alist) 72 (let ((alist process-coding-system-alist)
69 (case-fold-search (eq system-type 'vax-vms))) 73 (case-fold-search nil))
70 (while alist 74 (while alist
71 (if (string-match (car (car alist)) program) 75 (if (string-match (car (car alist)) program)
72 (throw 'found (setq ret (cdr (car alist)))) 76 (throw 'found (setq ret (cdr (car alist))))
73 ) 77 )
74 (setq alist (cdr alist)) 78 (setq alist (cdr alist))
104 If BUFFER is 0, returns immediately with value nil. 108 If BUFFER is 0, returns immediately with value nil.
105 Otherwise waits for PROGRAM to terminate 109 Otherwise waits for PROGRAM to terminate
106 and returns a numeric exit status or a signal description string. 110 and returns a numeric exit status or a signal description string.
107 If you quit, the process is first killed with SIGINT, then with SIGKILL if 111 If you quit, the process is first killed with SIGINT, then with SIGKILL if
108 you quit again before the process exits." 112 you quit again before the process exits."
109 (let ((temp (cond ((eq system-type 'vax-vms) 113 (let ((temp
110 (make-temp-name "tmp:emacs")) 114 (make-temp-name
111 ((or (eq system-type 'ms-dos) 115 (concat (file-name-as-directory (temp-directory))
112 (eq system-type 'windows-nt)) 116 (if (memq system-type '(ms-dos windows-nt)) "em" "emacs")))))
113 (make-temp-name
114 (concat (file-name-as-directory
115 (temp-directory))
116 "em")))
117 (t
118 (make-temp-name
119 (concat (file-name-as-directory
120 (temp-directory))
121 "emacs"))))))
122 (unwind-protect 117 (unwind-protect
123 (let (cs-r cs-w) 118 (let (cs-r cs-w)
124 (let (ret) 119 (let (ret)
125 (catch 'found 120 (catch 'found
126 (let ((alist process-coding-system-alist) 121 (let ((alist process-coding-system-alist)
127 (case-fold-search (eq system-type 'vax-vms))) 122 (case-fold-search nil))
128 (while alist 123 (while alist
129 (if (string-match (car (car alist)) program) 124 (if (string-match (car (car alist)) program)
130 (throw 'found (setq ret (cdr (car alist))))) 125 (throw 'found (setq ret (cdr (car alist)))))
131 (setq alist (cdr alist)) 126 (setq alist (cdr alist))
132 ))) 127 )))
140 cs-w ret)))) 135 cs-w ret))))
141 (let ((coding-system-for-read 136 (let ((coding-system-for-read
142 (or coding-system-for-read cs-r)) 137 (or coding-system-for-read cs-r))
143 (coding-system-for-write 138 (coding-system-for-write
144 (or coding-system-for-write cs-w))) 139 (or coding-system-for-write cs-w)))
145 (if (or (eq system-type 'ms-dos) 140 (if (memq system-type '(ms-dos windows-nt))
146 (eq system-type 'windows-nt))
147 (let ((buffer-file-type binary-process-output)) 141 (let ((buffer-file-type binary-process-output))
148 (write-region start end temp nil 'silent)) 142 (write-region start end temp nil 'silent))
149 (write-region start end temp nil 'silent)) 143 (write-region start end temp nil 'silent))
150 (if deletep (delete-region start end)) 144 (if deletep (delete-region start end))
151 (apply #'call-process program temp buffer displayp args))) 145 (apply #'call-process program temp buffer displayp args)))
152 (condition-case () 146 (ignore-file-errors (delete-file temp)))))
153 (delete-file temp)
154 (file-error nil)))))
155 147
156 (defun start-process (name buffer program &rest program-args) 148 (defun start-process (name buffer program &rest program-args)
157 "Start a program in a subprocess. Return the process object for it. 149 "Start a program in a subprocess. Return the process object for it.
158 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS 150 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
159 NAME is name for process. It is modified if necessary to make it unique. 151 NAME is name for process. It is modified if necessary to make it unique.
168 from/to the process." 160 from/to the process."
169 (let (cs-r cs-w) 161 (let (cs-r cs-w)
170 (let (ret) 162 (let (ret)
171 (catch 'found 163 (catch 'found
172 (let ((alist process-coding-system-alist) 164 (let ((alist process-coding-system-alist)
173 (case-fold-search (eq system-type 'vax-vms))) 165 (case-fold-search nil))
174 (while alist 166 (while alist
175 (if (string-match (car (car alist)) program) 167 (if (string-match (car (car alist)) program)
176 (throw 'found (setq ret (cdr (car alist))))) 168 (throw 'found (setq ret (cdr (car alist)))))
177 (setq alist (cdr alist)) 169 (setq alist (cdr alist))
178 ))) 170 )))
222 specifying a port number to connect to." 214 specifying a port number to connect to."
223 (let (cs-r cs-w) 215 (let (cs-r cs-w)
224 (let (ret) 216 (let (ret)
225 (catch 'found 217 (catch 'found
226 (let ((alist network-coding-system-alist) 218 (let ((alist network-coding-system-alist)
227 (case-fold-search (eq system-type 'vax-vms)) 219 (case-fold-search nil)
228 pattern) 220 pattern)
229 (while alist 221 (while alist
230 (setq pattern (car (car alist))) 222 (setq pattern (car (car alist)))
231 (and 223 (and
232 (cond ((numberp pattern) 224 (cond ((numberp pattern)