From 6082a98c7c075dbfc03d9a3c720e0fcccfda4eb5 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 7 Apr 2009 22:30:13 -0500
Subject: [PATCH] If (open-window) or similar fails, don't enter an infinite
 loop of opening error windows, just try to open one and then give up

---
 basis/ui/ui.factor | 31 +++++++++++++++++--------------
 1 file changed, 17 insertions(+), 14 deletions(-)

diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index bf17e455f8..dff7726d08 100644
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -2,9 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs io kernel math models namespaces make dlists
 deques sequences threads sequences words continuations init
-combinators hashtables concurrency.flags sets accessors calendar fry
-destructors ui.gadgets ui.gadgets.private ui.gadgets.worlds
-ui.gadgets.tracks ui.gestures ui.backend ui.render ;
+combinators combinators.short-circuit hashtables concurrency.flags
+sets accessors calendar fry destructors ui.gadgets ui.gadgets.private
+ui.gadgets.worlds ui.gadgets.tracks ui.gestures ui.backend ui.render ;
 IN: ui
 
 <PRIVATE
@@ -117,12 +117,10 @@ M: world ungraft*
     gesture-queue [ send-queued-gesture notify-queued ] slurp-deque ;
 
 : update-ui ( -- )
-    [
-        notify-queued
-        layout-queued
-        redraw-worlds
-        send-queued-gestures
-    ] [ ui-error ] recover ;
+    notify-queued
+    layout-queued
+    redraw-worlds
+    send-queued-gestures ;
 
 SYMBOL: ui-thread
 
@@ -133,8 +131,7 @@ SYMBOL: ui-thread
 PRIVATE>
 
 : find-window ( quot -- world )
-    windows get values
-    [ gadget-child swap call ] with find-last nip ; inline
+    [ windows get values ] dip '[ gadget-child @ ] find-last nip ; inline
 
 : ui-running? ( -- ? )
     \ ui-running get-global ;
@@ -142,9 +139,15 @@ PRIVATE>
 <PRIVATE
 
 : update-ui-loop ( -- )
-    [ ui-running? ui-thread get-global self eq? and ]
-    [ ui-notify-flag get lower-flag update-ui ]
-    while ;
+    #! Note the logic: if update-ui fails, we open an error window
+    #! and run one iteration of update-ui. If that also fails, well,
+    #! the whole UI subsystem is broken so we exit out of the
+    #! update-ui-loop.
+    [ { [ ui-running? ] [ ui-thread get-global self eq? ] } 0&& ]
+    [
+        ui-notify-flag get lower-flag
+        [ update-ui ] [ ui-error update-ui ] recover
+    ] while ;
 
 : start-ui-thread ( -- )
     [ self ui-thread set-global update-ui-loop ]