Mercurial > hg > xemacs-beta
diff lisp/process.el @ 859:84762348c6f9
[xemacs-hg @ 2002-06-01 08:06:46 by ben]
fix process problems etc.
process.el: Insert before, not after, point.
buffer.c: Fix bug noted by someone.
console-tty.h, device.h, emacs.c, filelock.c, nt.c, process-nt.c, process-unix.c, process.c, redisplay-tty.c, sysdep.c, sysproc.h, win32.c: Redo problem with syssignal.h/sysproc.h dependence noted by Didier
-- rather than require one included before the other
(error-prone), just include syssignal.h from sysproc.h
where it's needed.
inline.c: Include sysfile.h due to inline funs in that header.
extents.c: Fix bug noted by Andrew Cohen <cohen@andy.bu.edu>.
process-unix.c: Fix other bug noted by Andrew Cohen <cohen@andy.bu.edu>.
process.c: Add process-has-separate-stderr-p, used by call-process-internal.
author | ben |
---|---|
date | Sat, 01 Jun 2002 08:06:55 +0000 |
parents | 2b6fa2618f76 |
children | 278c743f1578 |
line wrap: on
line diff
--- a/lisp/process.el Fri May 31 09:38:49 2002 +0000 +++ b/lisp/process.el Sat Jun 01 08:06:55 2002 +0000 @@ -186,100 +186,129 @@ (set-marker (process-mark proc) (point buffer) buffer)) (if errbuf (set-marker (process-stderr-mark proc) (point errbuf) errbuf)) - ;; now do I/O, very carefully! the unwind-protect makes sure - ;; to clear out the sentinel, since it does a `throw', which would - ;; have no catch (or writes to a file -- we only want this on - ;; normal exit) - (unwind-protect - ;; if not NO-WAIT, set a sentinel to return the exit - ;; status. it will throw to this catch so we can exit - ;; properly. - (catch 'call-process-done - (set-process-sentinel - proc - (if no-wait - ;; we're trying really really hard to emulate - ;; the old call-process, which would save the - ;; stderr to a file even if discarding output. so - ;; we set a sentinel to save the output when - ;; we finish. - ;; - ;; #### not clear if we should be doing this. - ;; - ;; NOTE NOTE NOTE: Due to the total bogosity of - ;; dynamic scoping, and the lack of closures, we - ;; have to be careful how we write the first - ;; sentinel below since it may be executed after - ;; this function has returned -- thus we fake a - ;; closure. (This doesn't apply to the second one, - ;; which only gets executed within the - ;; unwind-protect.) - (if (and errbuf stderr) - (set-process-sentinel - proc - `(lambda (proc status) - (set-process-sentinel proc nil) - (with-current-buffer ,errbuf - (write-region-internal - 1 (1+ (buffer-size)) - ,stderr - nil 'major-rms-kludge-city nil - coding-system-for-write)) - (kill-buffer ,errbuf)))) - ;; normal sentinel: maybe write out stderr and return - ;; status. - #'(lambda (proc status) - (when (and errbuf stderr) - (with-current-buffer errbuf - (write-region-internal - 1 (1+ (buffer-size)) stderr - nil 'major-rms-kludge-city nil - coding-system-for-write))) - (cond ((eq 'exit (process-status proc)) - (set-process-sentinel proc nil) - (throw 'call-process-done - (process-exit-status proc))) - ((eq 'signal (process-status proc)) - (set-process-sentinel proc nil) - (throw 'call-process-done status)))))) - (if (not no-wait) - ;; we're waiting. send the input and loop forever, - ;; handling process output and maybe redisplaying. - ;; exit happens through the sentinel or C-g. if - ;; C-g, send SIGINT the first time, EOF if not - ;; already done so (might make the process exit), - ;; and keep waiting. Another C-g will exit the - ;; whole function, and the unwind-protect will - ;; kill the process. (Hence the documented semantics - ;; of SIGINT/SIGKILL.) - (let (eof-sent) - (condition-case nil - (progn - (when inbuf - (process-send-region proc start end inbuf)) - (process-send-eof proc) - (setq eof-sent t) - (while t - (accept-process-output proc) - (if display (sit-for 0)))) - (quit - (process-send-signal 'SIGINT proc) - (unless eof-sent - (process-send-eof proc)) - (while t - (accept-process-output proc) - (if display (sit-for 0)))))) - ;; discard and no wait: send the input, set PROC - ;; and ERRBUF to nil so that the unwind-protect - ;; forms don't erase the sentinel, kill the process, - ;; or kill ERRBUF (the sentinel does that), and exit. - (when inbuf - (process-send-region proc start end inbuf)) - (process-send-eof proc) - (setq errbuf nil) - (setq proc nil))) - (if proc (set-process-sentinel proc nil))))) - ;; unwind-protect forms. + ;; bind a function to set the point(s) in buffer and + ;; stderr-buffer. this is because the documentation says to + ;; insert *BEFORE* point, but we end up inserting after because + ;; only the process mark moves forward, not point. we + ;; synchronize after every place output might happen, in + ;; sentinels, and in an unwind-protect, to make *SURE* that + ;; point is correct. (We could do this more easily and perhaps + ;; more safely using a process filter, but that would create a + ;; LOT of garbage since all the data would get sent in + ;; strings.) + (flet ((synchronize-point (proc) + (let ((pb (process-buffer proc)) + (pm (process-mark proc))) + (if (and pb (buffer-live-p pb) (marker-buffer pm)) + (goto-char pm pb)) + (if (process-has-separate-stderr-p proc) + (let ((pseb (process-stderr-buffer proc)) + (psem (process-stderr-mark proc))) + (if (and pseb (not (eq pb pseb)) + (buffer-live-p pseb) + (marker-buffer psem)) + (goto-char psem pseb))))))) + ;; now do I/O, very carefully! the unwind-protect makes sure + ;; to clear out the sentinel, since it does a `throw', which + ;; would have no catch (or writes to a file -- we only want + ;; this on normal exit) + (unwind-protect + ;; if not NO-WAIT, set a sentinel to return the exit + ;; status. it will throw to this catch so we can exit + ;; properly. + (catch 'call-process-done + (set-process-sentinel + proc + (if no-wait + ;; we're trying really really hard to emulate + ;; the old call-process, which would save the + ;; stderr to a file even if discarding output. so + ;; we set a sentinel to save the output when + ;; we finish. + ;; + ;; #### not clear if we should be doing this. + ;; + ;; NOTE NOTE NOTE: Due to the total bogosity of + ;; dynamic scoping, and the lack of closures, we + ;; have to be careful how we write the first + ;; sentinel below since it may be executed after + ;; this function has returned -- thus we fake a + ;; closure. (This doesn't apply to the second one, + ;; which only gets executed within the + ;; unwind-protect.) + (if (and errbuf stderr) + (set-process-sentinel + proc + `(lambda (proc status) + (set-process-sentinel proc nil) + (synchronize-point proc) + (with-current-buffer ,errbuf + (write-region-internal + 1 (1+ (buffer-size)) + ,stderr + nil 'major-rms-kludge-city nil + coding-system-for-write)) + (kill-buffer ,errbuf)))) + ;; normal sentinel: maybe write out stderr and return + ;; status. + #'(lambda (proc status) + (synchronize-point proc) + (when (and errbuf stderr) + (with-current-buffer errbuf + (write-region-internal + 1 (1+ (buffer-size)) stderr + nil 'major-rms-kludge-city nil + coding-system-for-write))) + (cond ((eq 'exit (process-status proc)) + (set-process-sentinel proc nil) + (throw 'call-process-done + (process-exit-status proc))) + ((eq 'signal (process-status proc)) + (set-process-sentinel proc nil) + (throw 'call-process-done status)))))) + (if (not no-wait) + ;; we're waiting. send the input and loop forever, + ;; handling process output and maybe redisplaying. + ;; exit happens through the sentinel or C-g. if + ;; C-g, send SIGINT the first time, EOF if not + ;; already done so (might make the process exit), + ;; and keep waiting. Another C-g will exit the + ;; whole function, and the unwind-protect will + ;; kill the process. (Hence the documented semantics + ;; of SIGINT/SIGKILL.) + (let (eof-sent) + (condition-case nil + (progn + (when inbuf + (process-send-region proc start end inbuf)) + (process-send-eof proc) + (setq eof-sent t) + (while t + (accept-process-output proc) + (synchronize-point proc) + (if display (sit-for 0)))) + (quit + (process-send-signal 'SIGINT proc) + (unless eof-sent + (process-send-eof proc)) + (while t + (accept-process-output proc) + (synchronize-point proc) + (if display (sit-for 0)))))) + ;; discard and no wait: send the input, set PROC + ;; and ERRBUF to nil so that the unwind-protect + ;; forms don't erase the sentinel, kill the process, + ;; or kill ERRBUF (the sentinel does that), and exit. + (when inbuf + (process-send-region proc start end inbuf)) + (process-send-eof proc) + (setq errbuf nil) + (setq proc nil))) + ;; inner unwind-protect, once we're ready to do I/O. + (when proc + (set-process-sentinel proc nil) + (synchronize-point proc)))))) + ;; outer unwind-protect forms, to make sure we always clean up. (if (and inbuf kill-inbuf) (kill-buffer inbuf)) (if (and errbuf kill-errbuf) (kill-buffer errbuf)) (condition-case nil