From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 10 Feb 1993 16:24:39 +0000 (+0000)
Subject: Eliminate unfortunate loop that caused error to be signalled by C-x
X-Git-Tag: 20090517-FFI~8543
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=662342ccf0993118e04f7bcacb82c53266fdf5e8;p=mit-scheme.git

Eliminate unfortunate loop that caused error to be signalled by C-x
C-c when there were active processes.
---

diff --git a/v7/src/edwin/process.scm b/v7/src/edwin/process.scm
index f24479f2e..e7dec6425 100644
--- a/v7/src/edwin/process.scm
+++ b/v7/src/edwin/process.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: process.scm,v 1.27 1992/11/25 01:41:33 cph Exp $
+;;;	$Id: process.scm,v 1.28 1993/02/10 16:24:39 cph Exp $
 ;;;
-;;;	Copyright (c) 1991-1992 Massachusetts Institute of Technology
+;;;	Copyright (c) 1991-93 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -199,7 +199,7 @@ Initialized from the SHELL environment variable."
        (if (process-runnable? process)
 	   (begin
 	     (subprocess-kill subprocess)
-	     (perform-status-notification process 'SIGNALLED false)))
+	     (%perform-status-notification process 'SIGNALLED false)))
        (let ((channel (subprocess-input-channel subprocess)))
 	 (if (and channel (channel-open? channel))
 	     (channel-unregister channel)))
@@ -292,33 +292,35 @@ Initialized from the SHELL environment variable."
 				      (process-exit-reason process)))))
 
 (define (perform-status-notification process status reason)
-  (set-process-notification-tick! process (process-status-tick process))
-  (let ((value
-	 (cond ((process-sentinel process)
-		=>
-		(lambda (sentinel)
-		  (sentinel process (status->emacs-status status) reason)
-		  true))
-	       ((eq? status 'RUNNING)
-		false)
-	       (else
-		(let ((message
-		       (string-append "\nProcess "
-				      (process-name process)
-				      " "
-				      (process-status-message
-				       (status->emacs-status status)
-				       reason)
-				      "\n")))
-		  (output-substring process
-				    message
-				    (string-length message)))))))
+  (let ((value (%perform-status-notification process status reason)))
     (if (and (or (eq? 'EXITED status)
 		 (eq? 'SIGNALLED status))
 	     (ref-variable delete-exited-processes))
 	(delete-process process))
     value))
 
+(define (%perform-status-notification process status reason)
+  (set-process-notification-tick! process (process-status-tick process))
+  (cond ((process-sentinel process)
+	 =>
+	 (lambda (sentinel)
+	   (sentinel process (status->emacs-status status) reason)
+	   true))
+	((eq? status 'RUNNING)
+	 false)
+	(else
+	 (let ((message
+		(string-append "\nProcess "
+			       (process-name process)
+			       " "
+			       (process-status-message
+				(status->emacs-status status)
+				reason)
+			       "\n")))
+	   (output-substring process
+			     message
+			     (string-length message))))))
+
 (define (process-status-message status reason)
   (let ((message-with-reason
 	 (lambda (prefix connective)