From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Wed, 20 Jul 2011 17:26:11 +0000 (-0700)
Subject: Moved maybe-yield-gtk to main.scm.
X-Git-Tag: mit-scheme-pucked-9.2.12~675
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b313b35ff7d8d9ea57ed5d2212aaef310b5bd230;p=mit-scheme.git

Moved maybe-yield-gtk to main.scm.
---

diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg
index 0bd83275f..4b617433c 100644
--- a/src/gtk/gtk.pkg
+++ b/src/gtk/gtk.pkg
@@ -67,7 +67,7 @@ USA.
 	  make-gsource
 	  make-gsink
 	  allocate-buffer-bytes)
-  (import (gtk thread)
+  (import (gtk main)
 	  maybe-yield-gtk)
   (export (gtk)
 	  open-input-gfile
@@ -290,8 +290,7 @@ USA.
   (import (gtk gobject)
 	  run-gc-cleanups)
   (import (gtk main)
-	  run-gtk
-	  yield-gtk)
+	  run-gtk)
   (import (runtime primitive-io)
 	  select-registry-handle))
 
diff --git a/src/gtk/main.scm b/src/gtk/main.scm
index 7870c0aae..1535a9bb8 100644
--- a/src/gtk/main.scm
+++ b/src/gtk/main.scm
@@ -84,8 +84,10 @@ USA.
 (define-integrable (run-gtk select-registry-handle time)
   (C-call "run_gtk" select-registry-handle time))
 
-(define-integrable (yield-gtk)
-  (C-call "yield_gtk"))
+(define (maybe-yield-gtk)
+  ;; Used by callbacks that may have made threads runnable.
+  (if (other-running-threads?)
+      (C-call "yield_gtk")))
 
 (define (stop-gtk)
   ;; Sortof does the opposite of gtk-start.
diff --git a/src/gtk/thread.scm b/src/gtk/thread.scm
index d241f12a2..88b27d04f 100644
--- a/src/gtk/thread.scm
+++ b/src/gtk/thread.scm
@@ -80,12 +80,6 @@ USA.
     (%trace ";no-thread-nor-timers: wake up for no reason at "t"\n")
     t))
 
-(define (maybe-yield-gtk)
-  ;; Used by callbacks that may have made threads runnable.
-  (%trace ";maybe-yield-gtk "(thread/next (current-thread)))
-  (if (thread/next (current-thread))
-      (yield-gtk)))
-
 (define (exit-gtk-thread)
   (let ((thread gtk-thread))
     (set! gtk-thread #f)