From: Matt Birkholz Date: Thu, 6 Oct 2011 22:25:58 +0000 (-0700) Subject: Fixed the demo so the spinner thread will end. X-Git-Tag: mit-scheme-pucked-9.2.12~600 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=dc786f36ac412dbaddeb94b2e34317cc4730e551;p=mit-scheme.git Fixed the demo so the spinner thread will end. Destroyed widgets now remove themselves from a drawing's list of widgets, but NULL was assumed to mean "haven't had any viewers yet", not "all viewers gone". --- diff --git a/src/gtk/fix-demo.scm b/src/gtk/fix-demo.scm index 5943a78f2..956663a8d 100644 --- a/src/gtk/fix-demo.scm +++ b/src/gtk/fix-demo.scm @@ -59,6 +59,10 @@ USA. (fix-drawing-add-ink! drawing cursor2 'bottom) (set-demo-drawing-cursor-inks! drawing (list (list cursor1 layout1) (list cursor2 layout2)))) + + (set-fix-layout-drawing! layout1 drawing 175 150) + (set-fix-layout-drawing! layout2 drawing 175 150) + ;; Attach widgets to drawing BEFORE starting blink/spin threads. (if blink? (let ((thread (start-blinking drawing))) (%trace ";cursor blinker: "thread"\n")) @@ -66,9 +70,7 @@ USA. (if spin? (let ((thread (start-spinning drawing))) (%trace ";ring spinner: "thread"\n")) - (%trace ";ring spinning disabled\n")) - (set-fix-layout-drawing! layout1 drawing 175 150) - (set-fix-layout-drawing! layout2 drawing 175 150)) + (%trace ";ring spinning disabled\n"))) (gtk-widget-grab-focus layout1) (%trace ";created "layout1" and "layout2"\n")) unspecific) @@ -215,8 +217,7 @@ USA. (%trace2 ";spinning to "width"\n") (set-arc-ink! arc x y width height))) (let ((widgets (fix-drawing-widgets drawing))) - (if (and (not (null? widgets)) - (for-all? widgets gtk-object-destroyed?)) + (if (null? widgets) (%trace ";spinning ended\n") (loop (modulo (fix:1+ frame) frames)))))))))