Moved maybe-yield-gtk to main.scm.

diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg
index 0bd83275f161cf1ed9370535c8361f3239e48503..4b617433cb03eaadbd820ebde9111a4b8b27540e 100644 (file)
--- 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 7870c0aaec7a3da1c53e10602019b26f0557e062..1535a9bb80c7aa466f9dbca1c80f841c66eb2cab 100644 (file)
--- 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 d241f12a21c4bc861250b51b9c12fdac03497210..88b27d04f5d04bc1c012161abd348882f5260e2e 100644 (file)
--- 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)