From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 23 Dec 1993 06:58:54 +0000 (+0000)
Subject: Add option to allow RESTART-THREAD to prompt the user regarding
X-Git-Tag: 20090517-FFI~7343
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c8a6f2d911600fa9beac75fe442b35e446c72730;p=mit-scheme.git

Add option to allow RESTART-THREAD to prompt the user regarding
whether events in the thread's queue should be discarded.
---

diff --git a/v7/src/runtime/thread.scm b/v7/src/runtime/thread.scm
index 3ffae18c3..dc12807fb 100644
--- a/v7/src/runtime/thread.scm
+++ b/v7/src/runtime/thread.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: thread.scm,v 1.20 1993/09/10 19:15:44 cph Exp $
+$Id: thread.scm,v 1.21 1993/12/23 06:58:54 cph Exp $
 
 Copyright (c) 1991-1993 Massachusetts Institute of Technology
 
@@ -261,13 +261,18 @@ MIT in each case. |#
 
 (define (restart-thread thread discard-events? event)
   (guarantee-thread thread restart-thread)
-  (without-interrupts
-   (lambda ()
-     (if (not (eq? 'STOPPED (thread/execution-state thread)))
-	 (error:bad-range-argument thread restart-thread))
-     (if discard-events? (ring/discard-all (thread/pending-events thread)))
-     (if event (%signal-thread-event thread event))
-     (thread-running thread))))
+  (let ((discard-events?
+	 (if (eq? discard-events? 'ASK)
+	     (prompt-for-confirmation
+	      "Restarting other thread; discard events in its queue")
+	     discard-events?)))
+    (without-interrupts
+     (lambda ()
+       (if (not (eq? 'STOPPED (thread/execution-state thread)))
+	   (error:bad-range-argument thread restart-thread))
+       (if discard-events? (ring/discard-all (thread/pending-events thread)))
+       (if event (%signal-thread-event thread event))
+       (thread-running thread)))))
 
 (define (disallow-preempt-current-thread)
   (set-thread/execution-state! (current-thread) 'RUNNING-WITHOUT-PREEMPTION))