Mercurial > hg > xemacs-beta

changeset 862:278c743f1578

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-06-03 12:23:49 by ben] process fixes process.el: Create new process-synchronize-point to avoid dynamic binding problems. Fix editing bogosity in setting process sentinels. process.c: Don't invalidate the process marker after the process has died to make point synchronization in `call-process-internal' possible.
author ben
date Mon, 03 Jun 2002 12:24:14 +0000
parents 9a116d92c011
children 42375619fa45
files lisp/ChangeLog lisp/process.el src/ChangeLog src/process.c
diffstat 4 files changed, 135 insertions(+), 120 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Mon Jun 03 10:10:12 2002 +0000
+++ b/lisp/ChangeLog	Mon Jun 03 12:24:14 2002 +0000
@@ -1,3 +1,12 @@
+2002-06-03  Ben Wing  <ben@xemacs.org> and
+            Michael Sperber [Mr. Preprocessor]  <sperber@informatik.uni-tuebingen.de>
+
+	* process.el:
+	* process.el (process-synchronize-point): New.
+	* process.el (call-process-internal):
+	Create new process-synchronize-point to avoid dynamic binding
+	problems.  Fix editing bogosity in setting process sentinels.
+
 2002-05-28  Katsumi Yamaoka  <yamaoka@jpl.org>
 
 	* obsolete.el (find-non-ascii-charset-region): Revert the function
--- a/lisp/process.el	Mon Jun 03 10:10:12 2002 +0000
+++ b/lisp/process.el	Mon Jun 03 12:24:14 2002 +0000
@@ -75,6 +75,29 @@
   (start-process name buffer shell-file-name shell-command-switch
 		 (mapconcat #'identity args " ")))
 
+(defun process-synchronize-point (proc)
+  "Set the point(s) in buffer and stderr-buffer according to the process mark."
+  ;; We need this 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.) We make this a separate
+  ;; function, not an flet, due to dynamic binding problems -- the flet may
+  ;; not still be in scope when the sentinel is called.
+  (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))))))
+
 (defun call-process-internal (program &optional infile buffer display
 				      &rest args)
   "Internal function to call PROGRAM synchronously in separate process.
@@ -186,128 +209,106 @@
 		(set-marker (process-mark proc) (point buffer) buffer))
 	    (if errbuf
 		(set-marker (process-stderr-mark proc) (point errbuf) errbuf))
-	    ;; 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))))))
+	    (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
+		   (cond
+		    ((and no-wait errbuf stderr)
+		     ;; 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.)
+		     `(lambda (proc status)
+			(set-process-sentinel proc nil)
+			(process-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)))
+		    (no-wait nil)
+		    (t
+		     ;; normal sentinel: maybe write out stderr and return
+		     ;; status.
+		     #'(lambda (proc status)
+			 (process-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)
+				(process-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)
+			     (process-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)
+		(process-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))
--- a/src/ChangeLog	Mon Jun 03 10:10:12 2002 +0000
+++ b/src/ChangeLog	Mon Jun 03 12:24:14 2002 +0000
@@ -1,3 +1,9 @@
+2002-06-02  Michael Sperber [Mr. Preprocessor]  <sperber@informatik.uni-tuebingen.de>
+
+	* process.c (remove_process): Don't invalidate the process marker
+	after the process has died to make point synchronization in
+	`call-process-internal' possible.
+
 2002-06-01  Ben Wing  <ben@xemacs.org>
 
 	* buffer.c (init_initial_directory):
--- a/src/process.c	Mon Jun 03 10:10:12 2002 +0000
+++ b/src/process.c	Mon Jun 03 12:24:14 2002 +0000
@@ -2161,7 +2161,6 @@
 remove_process (Lisp_Object process)
 {
   Vprocess_list = delq_no_quit (process, Vprocess_list);
-  Fset_marker (XPROCESS (process)->mark, Qnil, Qnil);
 
   deactivate_process (process);
 }
@@ -2652,7 +2651,7 @@
 #ifdef PROCESS_IO_BLOCKING
   DEFVAR_LISP ("network-stream-blocking-port-list", &network_stream_blocking_port_list /*
 List of port numbers or port names to set a blocking I/O mode with connection.
-Nil value means to set a default(non-blocking) I/O mode.
+Nil value means to set a default (non-blocking) I/O mode.
 The value takes effect when `open-network-stream-internal' is called.
 */ );
   network_stream_blocking_port_list = Qnil;