xemacs-beta: lisp/process.el comparison

comparison 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

comparison

equal deleted inserted replaced

-:2c12fe2da451
+:84762348c6f9
 	    ;; end of buffer).
 	    (if buffer
 		(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
+	    ;; bind a function to set the point(s) in buffer and
-	    ;; to clear out the sentinel, since it does a `throw', which would
+	    ;; stderr-buffer.  this is because the documentation says to
-	    ;; have no catch (or writes to a file -- we only want this on
+	    ;; insert *BEFORE* point, but we end up inserting after because
-	    ;; normal exit)
+	    ;; only the process mark moves forward, not point.  we
-	    (unwind-protect
+	    ;; synchronize after every place output might happen, in
-		;; if not NO-WAIT, set a sentinel to return the exit
+	    ;; sentinels, and in an unwind-protect, to make *SURE* that
-		;; status.  it will throw to this catch so we can exit
+	    ;; point is correct. (We could do this more easily and perhaps
-		;; properly.
+	    ;; more safely using a process filter, but that would create a
-		(catch 'call-process-done
+	    ;; LOT of garbage since all the data would get sent in
-		  (set-process-sentinel
+	    ;; strings.)
-		   proc
+	    (flet ((synchronize-point (proc)
-		   (if no-wait
+		     (let ((pb (process-buffer proc))
-		       ;; we're trying really really hard to emulate
+			   (pm (process-mark proc)))
-		       ;; the old call-process, which would save the
+		       (if (and pb (buffer-live-p pb) (marker-buffer pm))
-		       ;; stderr to a file even if discarding output.  so
+			   (goto-char pm pb))
-		       ;; we set a sentinel to save the output when
+		       (if (process-has-separate-stderr-p proc)
-		       ;; we finish.
+			   (let ((pseb (process-stderr-buffer proc))
-		       ;;
+				 (psem (process-stderr-mark proc)))
-		       ;; #### not clear if we should be doing this.
+			     (if (and pseb (not (eq pb pseb))
-		       ;;
+				      (buffer-live-p pseb)
-		       ;; NOTE NOTE NOTE: Due to the total bogosity of
+				      (marker-buffer psem))
-		       ;; dynamic scoping, and the lack of closures, we
+				 (goto-char psem pseb)))))))
-		       ;; have to be careful how we write the first
+	      ;; now do I/O, very carefully!  the unwind-protect makes sure
-		       ;; sentinel below since it may be executed after
+	      ;; to clear out the sentinel, since it does a `throw', which
-		       ;; this function has returned -- thus we fake a
+	      ;; would have no catch (or writes to a file -- we only want
-		       ;; closure. (This doesn't apply to the second one,
+	      ;; this on normal exit)
-		       ;; which only gets executed within the
+	      (unwind-protect
-		       ;; unwind-protect.)
+		  ;; if not NO-WAIT, set a sentinel to return the exit
-		       (if (and errbuf stderr)
+		  ;; status.  it will throw to this catch so we can exit
-			   (set-process-sentinel
+		  ;; properly.
-			    proc
+		  (catch 'call-process-done
-			    `(lambda (proc status)
+		    (set-process-sentinel
-			       (set-process-sentinel proc nil)
+		     proc
-			       (with-current-buffer ,errbuf
+		     (if no-wait
-				 (write-region-internal
+			 ;; we're trying really really hard to emulate
-				  1 (1+ (buffer-size))
+			 ;; the old call-process, which would save the
-				  ,stderr
+			 ;; stderr to a file even if discarding output.  so
-				  nil 'major-rms-kludge-city nil
+			 ;; we set a sentinel to save the output when
-				  coding-system-for-write))
+			 ;; we finish.
-			       (kill-buffer ,errbuf))))
+			 ;;
-		     ;; normal sentinel: maybe write out stderr and return
+			 ;; #### not clear if we should be doing this.
-		     ;; status.
+			 ;;
-		     #'(lambda (proc status)
+			 ;; NOTE NOTE NOTE: Due to the total bogosity of
-			 (when (and errbuf stderr)
+			 ;; dynamic scoping, and the lack of closures, we
-			   (with-current-buffer errbuf
+			 ;; have to be careful how we write the first
-			     (write-region-internal
+			 ;; sentinel below since it may be executed after
-			      1 (1+ (buffer-size)) stderr
+			 ;; this function has returned -- thus we fake a
-			      nil 'major-rms-kludge-city nil
+			 ;; closure. (This doesn't apply to the second one,
-			      coding-system-for-write)))
+			 ;; which only gets executed within the
-			 (cond ((eq 'exit (process-status proc))
+			 ;; unwind-protect.)
-				(set-process-sentinel proc nil)
+			 (if (and errbuf stderr)
-				(throw 'call-process-done
+			     (set-process-sentinel
-				       (process-exit-status proc)))
+			      proc
-			       ((eq 'signal (process-status proc))
+			      `(lambda (proc status)
-				(set-process-sentinel proc nil)
+				 (set-process-sentinel proc nil)
-				(throw 'call-process-done status))))))
+				 (synchronize-point proc)
-		  (if (not no-wait)
+				 (with-current-buffer ,errbuf
-		      ;; we're waiting.  send the input and loop forever,
+				   (write-region-internal
-		      ;; handling process output and maybe redisplaying.
+				    1 (1+ (buffer-size))
-		      ;; exit happens through the sentinel or C-g.  if
+				    ,stderr
-		      ;; C-g, send SIGINT the first time, EOF if not
+				    nil 'major-rms-kludge-city nil
-		      ;; already done so (might make the process exit),
+				    coding-system-for-write))
-		      ;; and keep waiting.  Another C-g will exit the
+				 (kill-buffer ,errbuf))))
-		      ;; whole function, and the unwind-protect will
+		       ;; normal sentinel: maybe write out stderr and return
-		      ;; kill the process. (Hence the documented semantics
+		       ;; status.
-		      ;; of SIGINT/SIGKILL.)
+		       #'(lambda (proc status)
-		      (let (eof-sent)
+			   (synchronize-point proc)
-			(condition-case nil
+			   (when (and errbuf stderr)
-			    (progn
+			     (with-current-buffer errbuf
-			      (when inbuf
+			       (write-region-internal
-				(process-send-region proc start end inbuf))
+				1 (1+ (buffer-size)) stderr
-			      (process-send-eof proc)
+				nil 'major-rms-kludge-city nil
-			      (setq eof-sent t)
+				coding-system-for-write)))
-			      (while t
+			   (cond ((eq 'exit (process-status proc))
-				(accept-process-output proc)
+				  (set-process-sentinel proc nil)
-				(if display (sit-for 0))))
+				  (throw 'call-process-done
-			  (quit
+					 (process-exit-status proc)))
-			   (process-send-signal 'SIGINT proc)
+				 ((eq 'signal (process-status proc))
-			   (unless eof-sent
+				  (set-process-sentinel proc nil)
-			     (process-send-eof proc))
+				  (throw 'call-process-done status))))))
-			   (while t
+		    (if (not no-wait)
-			     (accept-process-output proc)
+			;; we're waiting.  send the input and loop forever,
-			     (if display (sit-for 0))))))
+			;; handling process output and maybe redisplaying.
-		    ;; discard and no wait: send the input, set PROC
+			;; exit happens through the sentinel or C-g.  if
-		    ;; and ERRBUF to nil so that the unwind-protect
+			;; C-g, send SIGINT the first time, EOF if not
-		    ;; forms don't erase the sentinel, kill the process,
+			;; already done so (might make the process exit),
-		    ;; or kill ERRBUF (the sentinel does that), and exit.
+			;; and keep waiting.  Another C-g will exit the
-		    (when inbuf
+			;; whole function, and the unwind-protect will
-		      (process-send-region proc start end inbuf))
+			;; kill the process. (Hence the documented semantics
-		    (process-send-eof proc)
+			;; of SIGINT/SIGKILL.)
-		    (setq errbuf nil)
+			(let (eof-sent)
-		    (setq proc nil)))
+			  (condition-case nil
-	      (if proc (set-process-sentinel proc nil)))))
+			      (progn
-;; unwind-protect forms.
+				(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
 	  (if (and proc (process-live-p proc)) (kill-process proc))
 	(error nil)))))

Mercurial > hg > xemacs-beta

comparison lisp/process.el @ 859:84762348c6f9