Mercurial > hg > xemacs-beta

comparison lisp/process.el @ 5738:f6af091ac654

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use new language features in #'call-process-internal now they're available. lisp/ChangeLog addition: 2013-06-17 Aidan Kehoe <kehoea@parhasard.net> * process.el (process-synchronize-point): Moved to a label. * process.el (call-process-internal): Now we have better language features, use them rather than creating a closure ourselves or exposing a utility function when there is no need for that with a well-implemented labels function.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 17 Jun 2013 20:37:47 +0100
parents 965a9ddc915a
children bbe4146603db
comparison
equal deleted inserted replaced
5737:165315eae1ab 5738:f6af091ac654
107 (call-process shell-file-name 107 (call-process shell-file-name
108 infile buffer display 108 infile buffer display
109 shell-command-switch 109 shell-command-switch
110 (mapconcat 'identity (cons command args) " "))) 110 (mapconcat 'identity (cons command args) " ")))
111 111
112 (defun process-synchronize-point (proc)
113 "Set the point(s) in buffer and stderr-buffer according to the process mark."
114 ;; We need this because the documentation says to insert *BEFORE* point,
115 ;; but we end up inserting after because only the process mark moves
116 ;; forward, not point. We synchronize after every place output might
117 ;; happen, in sentinels, and in an unwind-protect, to make *SURE* that
118 ;; point is correct. (We could do this more easily and perhaps more
119 ;; safely using a process filter, but that would create a LOT of garbage
120 ;; since all the data would get sent in strings.) We make this a separate
121 ;; function, not an flet, due to dynamic binding problems -- the flet may
122 ;; not still be in scope when the sentinel is called.
123 (let ((pb (process-buffer proc))
124 (pm (process-mark proc)))
125 (if (and pb (buffer-live-p pb) (marker-buffer pm))
126 (goto-char pm pb))
127 (if (process-has-separate-stderr-p proc)
128 (let ((pseb (process-stderr-buffer proc))
129 (psem (process-stderr-mark proc)))
130 (if (and pseb (not (eq pb pseb))
131 (buffer-live-p pseb)
132 (marker-buffer psem))
133 (goto-char psem pseb))))))
134
135 (defun call-process-internal (program &optional infile buffer display 112 (defun call-process-internal (program &optional infile buffer display
136 &rest args) 113 &rest args)
137 "Internal function to call PROGRAM synchronously in separate process. 114 "Internal function to call PROGRAM synchronously in separate process.
138 Lisp callers should use `call-process' or `call-process-region'. 115 Lisp callers should use `call-process' or `call-process-region'.
139 116
177 ;; KILL-INBUF/KILL-ERRBUF tell us if we should do so. 154 ;; KILL-INBUF/KILL-ERRBUF tell us if we should do so.
178 ;; 155 ;;
179 ;; note that we need to be *very* careful in this code to handle C-g 156 ;; note that we need to be *very* careful in this code to handle C-g
180 ;; at any point. 157 ;; at any point.
181 (unwind-protect 158 (unwind-protect
182 (progn 159 (labels
160 ((process-synchronize-point (proc)
161 ;; Set the point(s) in buffer and stderr-buffer according to
162 ;; the process mark.
163 ;;
164 ;; We need this because the documentation says to insert
165 ;; *BEFORE* point, but we end up inserting after because only
166 ;; the process mark moves forward, not point. We synchronize
167 ;; after every place output might happen, in sentinels, and
168 ;; in an unwind-protect, to make *SURE* that point is
169 ;; correct. (We could do this more easily and perhaps more
170 ;; safely using a process filter, but that would create a LOT
171 ;; of garbage since all the data would get sent in strings.)
172 ;; We make this a label, not an flet, due to dynamic binding
173 ;; problems -- the flet may not still be in scope when the
174 ;; sentinel is called.
175 (let ((pb (process-buffer proc))
176 (pm (process-mark proc)))
177 (if (and pb (buffer-live-p pb) (marker-buffer pm))
178 (goto-char pm pb))
179 (if (process-has-separate-stderr-p proc)
180 (let ((pseb (process-stderr-buffer proc))
181 (psem (process-stderr-mark proc)))
182 (if (and pseb (not (eq pb pseb))
183 (buffer-live-p pseb)
184 (marker-buffer psem))
185 (goto-char psem pseb)))))))
183 ;; first handle INFILE. 186 ;; first handle INFILE.
184 (cond ((stringp infile) 187 (cond ((stringp infile)
185 (setq infile (expand-file-name infile)) 188 (setq infile (expand-file-name infile))
186 (setq kill-inbuf t) 189 (setq kill-inbuf t)
187 (setq inbuf (generate-new-buffer "*call-process*")) 190 (setq inbuf (generate-new-buffer "*call-process*"))
261 ;; stderr to a file even if discarding output. so 264 ;; stderr to a file even if discarding output. so
262 ;; we set a sentinel to save the output when 265 ;; we set a sentinel to save the output when
263 ;; we finish. 266 ;; we finish.
264 ;; 267 ;;
265 ;; #### not clear if we should be doing this. 268 ;; #### not clear if we should be doing this.
266 ;; 269 (apply-partially
267 ;; NOTE NOTE NOTE: Due to the total bogosity of 270 #'(lambda (errbuf stderr proc status)
268 ;; dynamic scoping, and the lack of closures, we 271 (set-process-sentinel proc nil)
269 ;; have to be careful how we write the first 272 (process-synchronize-point proc)
270 ;; sentinel below since it may be executed after 273 (with-current-buffer errbuf
271 ;; this function has returned -- thus we fake a 274 (write-region-internal
272 ;; closure. (This doesn't apply to the second one, 275 1 (1+ (buffer-size))
273 ;; which only gets executed within the 276 stderr
274 ;; unwind-protect.) 277 nil 'major-rms-kludge-city nil
275 `(lambda (proc status) 278 coding-system-for-write))
276 (set-process-sentinel proc nil) 279 (kill-buffer errbuf))
277 (process-synchronize-point proc) 280 ;; Close around these two variables, the lambda may be
278 (with-current-buffer ,errbuf 281 ;; called outside this enclosing unwind-protect.
279 (write-region-internal 282 errbuf stderr))
280 1 (1+ (buffer-size))
281 ,stderr
282 nil 'major-rms-kludge-city nil
283 coding-system-for-write))
284 (kill-buffer ,errbuf)))
285 (no-wait nil) 283 (no-wait nil)
286 (t 284 (t
287 ;; normal sentinel: maybe write out stderr and return 285 ;; normal sentinel: maybe write out stderr and return
288 ;; status. 286 ;; status.
289 #'(lambda (proc status) 287 #'(lambda (proc status)