ui: better handling of cascading errors

The second update-ui is wrapped in a recover so that if it fails
again, the UI system is stopped. That should fix the cascade problem
in #1827.

basis/ui/backend/backend.factor

@@ -35,4 +35,9 @@ HOOK: ui-backend-available? ui-backend ( -- ? )
 M: object ui-backend-available?
     f ;
 
+HOOK: stop-event-loop ui-backend ( -- )
+
+M: object stop-event-loop
+    ;
+
 [ ui-backend-available? "ui.tools" "listener" ? ] main-vocab-hook set-global

basis/ui/backend/gtk/gtk.factor

@@ -513,6 +513,9 @@ M: gtk-ui-backend (with-ui)
         ] with-destructors
     ] ui-running ;
 
+M: gtk-ui-backend stop-event-loop
+    gtk_main_quit ;
+
 os linux? [
     gtk-ui-backend ui-backend set-global
 ] when

basis/ui/gadgets/worlds/worlds.factor

@@ -217,7 +217,7 @@ ui-error-hook [ [ rethrow ] ] initialize
                 dup [ draw-world* ] with-gl-context
                 flush-layout-cache-hook get call( -- )
             ] [
-                swap f >>active? <world-error> ui-error
+                swap f >>active? <world-error> throw
             ] recover
         ] with-variable
     ] [ drop ] if ;

basis/ui/ui.factor

@@ -76,8 +76,7 @@ SYMBOL: ui-windows
 M: world graft*
     [ (open-window) ]
     [
-        [ set-up-window ]
+        [ set-up-window ] [ ] [ clean-up-broken-window ] cleanup
-        [ [ clean-up-broken-window ] [ ui-error ] bi* ] recover
     ] bi ;
 
 : dispose-window-resources ( world -- )
@@ -152,14 +151,18 @@ PRIVATE>
 <PRIVATE
 
 : update-ui-loop ( -- )
-    ! Note the logic: if update-ui fails, we open an error window
+    ! Note the logic: if update-ui fails, we open an error window and
-    ! and run one iteration of update-ui. If that also fails, well,
+    ! run one iteration of update-ui. If that also fails, well, the
-    ! the whole UI subsystem is broken so we exit out of the
+    ! whole UI subsystem is broken so we throw the error to terminate
-    ! update-ui-loop.
+    ! 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
+        [ update-ui ] [
+            [ ui-error update-ui ] [
+                stop-event-loop nip rethrow
+            ] recover
+        ] recover
     ] while ;
 
 : start-ui-thread ( -- )