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